DBR Delphi-Ecke

// Dieser Routine zeigt das Grundprinzip, wie man Bilder eines Verzeichnisses
// als Thumbnails darstellen kann. Es wird ein Button, eine Progressbar
// und eine Scrollbox auf eine Form platziert. Die Thumbs werden in der
// Scrollbox angezeigt. Durch Zuhilfenahme von Codes, welche andere
// Bildformate unterstützen (z.B. TGifimage) kann man das Ganze erweitern.
// Wenn man mit der rechten Maustaste auf ein Bild klickt, werden Infos
// über das Bild angezeigt.

// Getestet mit D4 unter WinME
unit thumb; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Forms, Dialogs, 
  Controls, StdCtrls, ComCtrls; 
 
type 
  TForm1 = class(TForm) 
    ProgressBar1: TProgressBar; 
    Button1: TButton; 
    ScrollBox1: TScrollBox; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
  private 
{ Private-Deklarationen } 
  public 
    procedure MDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses jpeg, extctrls; 
 
var 
  sl, gr, ab: TStringlist; 
  im: array of TImage; 
  pct: TPicture; 
  bmp: TBitmap; 
 
procedure freigeben; 
var x: integer; 
begin 
  for x := 0 to length(im) - 1 do 
    im[x].free; 
  im := nil; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  pct := TPicture.create; 
  bmp := TBitmap.create; 
  sl := TStringlist.create; 
  gr := TStringlist.create; 
  ab := TStringlist.create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  freigeben; 
  ab.free; 
  gr.free; 
  sl.free; 
  pct.free; 
  bmp.free; 
end; 
 
procedure anpassen(datei: string; mass: integer; 
  Image: TImage; Hintergrund, rand: TColor); 
var 
  faktor: double; 
  fehler: boolean; 
const s = 'FEHLER'; 
begin 
  fehler := false; 
  try 
    pct.loadfromfile(datei); 
  except 
    fehler := true; 
  end; 
  ab.add(Inttostr(pct.width) + ' x ' + inttostr(pct.height)); 
  if pct.width > pct.Height then begin 
    faktor := pct.height / pct.width; 
    bmp.width := mass - 2; 
    bmp.height := trunc(mass * faktor) - 2; 
  end else begin 
    faktor := pct.width / pct.height; 
    bmp.height := mass - 2; 
    bmp.width := trunc(mass * faktor) - 2; 
  end; 
  bmp.canvas.brush.color := hintergrund; 
  bmp.canvas.fillrect(bmp.canvas.cliprect); 
  if not fehler then 
    bmp.canvas.stretchdraw(rect(0, 0, bmp.width, bmp.height), pct.graphic); 
  with image.picture.bitmap do begin 
    width := mass; 
    height := mass; 
    canvas.font.color := clred; 
    canvas.pen.color := rand; 
    canvas.brush.color := hintergrund; 
    canvas.rectangle(0, 0, image.width, image.height); 
    if fehler then 
      canvas.textout((mass - canvas.textwidth(s)) div 2, (mass - 
        canvas.textheight(s)) div 2, 'FEHLER') else 
      canvas.draw((width - bmp.width) div 2, (height - bmp.height) div 2, bmp); 
  end; 
end; 
 
procedure suchen(pfad, filter: string); 
var sr: TWin32FindData; 
  h: THandle; 
begin 
  sl.clear; 
  gr.clear; 
  ab.clear; 
  if ansilastchar(pfad) <> '\' then pfad := pfad + '\'; 
  h := FindFirstFile(PChar(pfad + '*.*'), sr); 
  if h <> INVALID_HANDLE_VALUE then repeat 
      if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0) 
        and (pos(lowercase(extractfileext(sr.cFileName)), filter) > 0) 
        then begin 
        sl.add(pfad + sr.cFileName); 
        gr.add(inttostr(round( 
          (sr.nFileSizeHigh * MAXDWORD + sr.nFileSizeLow) / 1024 + 0.49))) 
      end; 
    until Findnextfile(h, sr) = false; 
  windows.FindClose(h); 
end; 
 
procedure TForm1.MDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if button = mbright then 
    showmessage(extractfilename(sl[TImage(sender).tag]) + #13 
      + ab[TImage(sender).tag] + ' Pixel' + #13 + 
      gr[TImage(sender).tag] + 
      ' KB auf dem Datenträger'); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  abstand, groesse, nebeneinander, untereinander, x, y, z: integer; 
begin 
  screen.cursor := crHourglass; 
  groesse := 75; { Thumbnailgröße }
  abstand := 2; 
  freigeben; 
  suchen('d:\dbr', '.bmp.wmf'); { '.bmp.emf.wmf.jpg.jpeg' }
  if sl.count > 0 then begin 
    setlength(im, sl.count); 
    progressbar1.max := sl.count; 
    z := 0; 
    nebeneinander := (scrollbox1.clientwidth - abstand) div (groesse + 
      abstand);      { oder frei festlegen, z.B.: nebeneinander:=20; }
    if sl.count < nebeneinander then nebeneinander := sl.count; 
    untereinander := (sl.count div nebeneinander) + 
      ord(sl.count mod nebeneinander > 0); 
    for y := 0 to untereinander - 1 do 
      for x := 0 to nebeneinander - 1 do begin 
        if z < sl.count then begin 
          im[z] := TImage.create(scrollbox1); 
          im[z].tag := z; 
          im[z].width := groesse; 
          im[z].height := groesse; 
          im[z].parent := scrollbox1; 
          im[z].left := abstand + x * (groesse + abstand); 
          im[z].top := abstand + y * (groesse + abstand); 
          im[z].OnMouseDown := MDown; 
          anpassen(sl[z], groesse, im[z], scrollbox1.color, clBtnShadow); 
          inc(z); 
          progressbar1.position := z; 
        end; 
      end; 
    { falls "nebeneinander" nicht frei festgelegt wurde, dann z.B.: }
    scrollbox1.clientwidth := (groesse + abstand) * nebeneinander + abstand; 
  end; 
  progressbar1.position := 0; 
  screen.cursor := crDefault; 
end; 
 
end.