Zurück zu JPG-Verkleinern.
 

Eine Komponente abgeleitet von FileListBox von TFileListBox

Die erweiterungen sind bessere Icon Anzeige und die Größe der Dateinen in der erweiteren FileListBox Komponente. Vieleicht Hilft es den ein oder anderen und bring ihn etwas weiter. Der Code darf frei verwendet werden und geändert. Bei Gewerblicher Nutzung hat man mich zu Fragen.

Wer Fehler findet kann die behalten!

wenn die Datei-Größen Angabe stört kann einfach den entsprechenden Bereich entfernen. //--------------------------------------------------------------------------------------------- { Ich über nehme keine Verantwortung alles auf eigenes Risiko. Der Code darf frei benutzt werden und verbessert und geändert. Bei Commercialer Nutzung hat man mich zu fragen. wenn die Datei-Größen Angabe stört kann einfach den entsprechenden Bereich entfernen. } unit FileSiceListBox; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtrl, ImgList; type TFileSiceListBox = class(TFileListBox) private ImageList: TImageList; protected { Protected-Deklarationen } procedure ReadFileNames; override; procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; public { Public-Deklarationen } published { Published-Deklarationen } end; procedure Register; implementation uses ShellApi; procedure TFileSiceListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); var Bitmap: TBitmap; offset: Integer; aIcon: TIcon; begin aIcon:= TIcon.Create; with Canvas do begin FillRect(Rect); offset := 2; if ShowGlyphs then begin Bitmap:= TBitmap.Create; // Bilder aus Image list aus lesen ImageList.GetBitmap(Index, Bitmap); //// Bitmap := TBitmap(Items.Objects[Index]); if Assigned(Bitmap) then begin BrushCopy(Bounds(Rect.Left + 2, (Rect.Top + Rect.Bottom - Bitmap.Height) div 2, Bitmap.Width, Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap.Canvas.Pixels[0, Bitmap.Height -1]); offset := Bitmap.width + 4; end; end; TextOut(Rect.Left + offset, Rect.Top, Items[Index]) end; FreeAndNil(aIcon); FreeAndNil(Bitmap); end; procedure TFileSiceListBox.ReadFileNames; var AttrIndex: TFileAttr; I: Integer; FileExt, DatGroes: string; MaskPtr: PChar; Ptr: PChar; AttrWord: Word; FileInfo: TSearchRec; SaveCursor: TCursor; Glyph: TBitmap; Bitmap, Bitmap2 : TBitmap; FileInfo2: TSHFileInfo; ImageListHandle: THandle; aIcon: TIcon; w, h, My_i: Integer; /// ImageList: TImageList; const Attributes: array[TFileAttr] of Word = (faReadOnly, faHidden, faSysFile, faVolumeID, faDirectory, faArchive, 0); begin My_i := 0; Glyph := Tbitmap.Create; //<<<<<<<<<<<<<<<<<<<<<< ImageList := TImageList.Create(self); ImageList.ImageType := itImage; ImageList.Masked := True; ImageList.BkColor := clNone; ImageList.BlendColor := clNone; ImageList.Width :=17; ImageList.Height := 17; { if no handle allocated yet, this call will force one to be allocated incorrectly (i.e. at the wrong time. In due time, one will be allocated appropriately. } AttrWord := DDL_READWRITE; if HandleAllocated then begin { Set attribute flags based on values in FileType } for AttrIndex := ftReadOnly to ftArchive do if AttrIndex in FileType then AttrWord := AttrWord or Attributes[AttrIndex]; ChDir(FDirectory); { go to the directory we want } Clear; { clear the list } I := 0; SaveCursor := Screen.Cursor; try MaskPtr := PChar(FMask); while MaskPtr <> nil do begin Ptr := StrScan (MaskPtr, ';'); if Ptr <> nil then Ptr^ := #0; if FindFirst(MaskPtr, AttrWord, FileInfo) = 0 then begin repeat { exclude normal files if ftNormal not set } if (ftNormal in FileType) or (FileInfo.Attr and AttrWord <> 0) then // Keine VerzeichnisseAnzeigen if FileInfo.Attr and faDirectory <> 0 then begin end // end if else begin FileExt := AnsiLowerCase(ExtractFileExt(FileInfo.Name)); ///// Glyph := UnknownBMP; DatGroes := IntToSTR(FileInfo.Size); //----------------------------Neu---------------------------------------- // Speicher löschen FillChar(FileInfo2, SizeOf(FileInfo2), #0); // Das Icon von jeder Datei holen . Handle der Image Liste der ausgewählten Datei ermitteln, ImageListHandle := SHGetFileInfo(PChar(FDirectory+ '\'+FileInfo.Name), 0, FileInfo2, SizeOf(FileInfo2), // Kleines Icon verlangen SHGFI_ICON or SHGFI_LARGEICON); // SHGFI_SMALLICON try // TIcon Objekt erstellen aIcon := TIcon.Create; Bitmap:= Tbitmap.Create; Bitmap2:= Tbitmap.Create; try // Icon Handle zuweisen aIcon.Handle := FileInfo2.hIcon; // Icon übergeben zur weiteren verarbeitung // Transparent darstellen aIcon.Transparent := True; // Größe übergeben an Bitmap Bitmap.Width := aIcon.Width; Bitmap.Height := aIcon.Height; Bitmap.Canvas.Draw(0, 0, aIcon); Bitmap2.Width := 17; // Größe fest legen Bitmap2.Height := 17; // Bild Größe von 32 auf 17 verkleinern if aIcon.Width > 16 then begin SetStretchBltMode(Bitmap2.Canvas.Handle, HALFTONE); StretchBlt(Bitmap2.Canvas.Handle, 0, 0, 17,17, Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, SRCCOPY); End; // If aIcon BrushCopy CopyRect // Bitmap in Imagelist speichern für späteres auslesen ImageList.add(Bitmap2, nil); // Name und Größe im Items speichern I := Items.Add(FileInfo.Name+':'+DatGroes); finally // TIcon Objekt freigeben FreeAndNil(aIcon); FreeAndNil(Bitmap); FreeAndNil(Bitmap2); end; finally // Icon der Shell wieder freigeben DestroyIcon(FileInfo2.hIcon); // Icon Liste der Shell wieder freigeben end; //-------------------------------------------------------------- end; // else if I = 100 then Screen.Cursor := crHourGlass; until FindNext(FileInfo) <> 0; // Schleifen Ende FindClose(FileInfo); end; if Ptr <> nil then begin Ptr^ := ';'; Inc (Ptr); end; MaskPtr := Ptr; end; finally Screen.Cursor := SaveCursor; end; Change; end; end; // Hier könnt Ihr natürlich den Namen selber wählen. procedure Register; begin RegisterComponents('MyKomponeten', [TFileSiceListBox]); end; end. //------------------------------------------------------------------------------------------------