Photos in Thumbnail-Komponente [Delphi]

[Guenzesson]

Hi zusammen,

ich möchte in ein Formular n Photos einbetten, sinnvollerweise als Thumbnails.

Hat jemand vielleicht Erfahrungen mit Delphi-Thumbnailkomponenten aus dem Netz und könnte mir eine empfehlen...?

Würde mich über eine Antwort freuen...

Schönen Dank,

Mischa

[geloescht_JesterDay]

Erfahrung mit einer Thumbnailkomponente aus dem Netz? Nein, da kann ich dir nicht helfen.

Ich hab sowas aber mal selber gemacht. Ich wurde nie ganz fertig, aber soweit funktioniert sie (ich wollte noch ein paar mehr Dinge tun).

Hier erstmal die Thumbnail Unit:

unit JPGThumbUNT;


interface


uses types, classes, controls, ExtCtrls, Graphics, StdCtrls, jpeg,

     frmViewUNT;


type


  TJPGThumb = class(TPanel)

  private

    FPic : tjpegimage;

    FPath: String;

    FlblName: TLabel;

    procedure SetPic(APic: TJPEGImage);

    procedure SetPath(APath: String);

    procedure Enter(Sender: TObject);

    procedure Exit(Sender: TObject);

    procedure Click(Sender: TObject);

    procedure DblClick(Sender: TObject);

  public

    procedure paint; override;

    constructor create(AOwner: TComponent); override;

    destructor destroy; override;

    property Pic: TJPEGImage write Setpic;

    property Path: String read FPath write SetPath;

  end;


  TThumbArray = Array of TJPGThumb;


  TJPGBuffer = class

  private

    FBufferImg: TJPEGImage;

    FThumbs: TThumbArray;


    procedure SetPath(APath: String);


  public

    constructor create;

    destructor destroy; override;

    procedure DrawTo(AParent: TWinControl);

    property Path: string write SetPath;

  end;


const

  cThumbWidth = 120;

  cThumbHeight =120;

  cBorderLeft = 5;

  cBorderRight = 5;

  cBorderTop = 5;

  cBorderBottom = 20;


var

  JPGBuffer: TJPGBuffer;



implementation


uses SysUtils;


{TJPGBuffer}


constructor TJPGBuffer.create;

begin

  inherited;

  FBufferImg:= TJPEGImage.create;

  FBufferImg.Performance:= jpBestSpeed;

end;


destructor TJPGBuffer.destroy;

begin

  FBufferImg.free;

  inherited;

end;


procedure TJPGBuffer.SetPath(APath: String);

begin

  // First load the image

  FBufferImg.LoadFromFile(APath);

  // Add a new thumb

  SetLength(FThumbs, Length(FThumbs)+1);

  FThumbs[High(FThumbs)]:= TJPGThumb.create(nil);

  With FThumbs[High(FThumbs)] do

  begin

    Path:= APath;

    Pic:= FBufferImg;

  end;

end;


procedure TJPGBuffer.DrawTo(AParent: TWinControl);

var i, X, Y, AWidth: Integer;

begin

  X:= 10;

  Y:= 10;

  aWidth:= Aparent.Width;

  for i:= 0 to High(FThumbs) do

  begin

    with FThumbs[i] do

    begin

      Left:= X;

      Top:= Y;

      Width:= cThumbWidth;

      Height:= cThumbHeight;

      Parent:= AParent;

    end;

    Inc(X, cThumbWidth+5);

    if (X+cThumbWidth) > aWidth then

    begin

      x:= 10;

      Inc(Y, cThumbHeight+5);

    end;

  end;

end;


{TJPGThumb}


constructor TJPGThumb.create(AOwner: TComponent);

begin

  inherited;

  FPic:= TJPEGImage.create;

  BevelOuter:= bvRaised;

  FLblName:= TLabel.create(self);

  flblName.Parent:= self;

  FlblName.Height:= cBorderBottom;

  FlblName.Align:= alBottom;

  FlblName.Layout:= tlTop;

  FlblName.Alignment:= taCenter;

  OnEnter:= Enter;

  OnExit:= Exit;

  OnClick:= Click;

  OnDblClick:= DblClick;

  TabStop:= True;

end;


destructor TJPGThumb.destroy;

begin

  FPic.free;

  FlblName.free;

  inherited;

end;


procedure TJPGThumb.SetPic(APic: TJPEGImage);

begin

  FPic.scale:=jshalf;

  FPic.assign(APic);

  FPic.dibneeded;

end;


procedure TJPGThumb.paint;

var ARect : trect;

begin

  inherited;

  ARect.left:=ClientRect.Left+cBorderLeft;

  ARect.Top:= ClientRect.Top+cBorderTop;

  ARect.Right:= ClientRect.Right-cBorderRight;

  ARect.Bottom:= ClientRect.Bottom-cBorderBottom;

  canvas.stretchdraw(arect,FPic);

  frame3d(canvas,ARect,clblack,clwhite,2);

end;


procedure TJPGThumb.SetPath(APath: String);

begin

  FPath:= APath;

  FlblName.Caption:= ExtractFileName(APath);

end;


procedure TJPGThumb.Enter(Sender: TObject);

begin

  self.Color:= clSkyBlue;

end;


procedure TJPGThumb.Exit(Sender: TObject);

begin

  self.Color:= clBtnFace;

end;


procedure TJPGThumb.Click(Sender: TObject);

begin

  self.SetFocus;

end;


procedure TJPGThumb.DblClick(Sender: TObject);

begin

  if Assigned(frmView) then

    if frmView.Visible then

      frmView.close;

  frmView.free;

  frmView:= TfrmView.create(nil);

  frmView.FileName:= self.Path;

end;


initialization

  JPGBuffer:= TJPGBuffer.create;


finalization

  JPGBuffer.Free;


end.

und hier der Aufruf aus dem Formular:

// alle JPEG-Bilder aus dem Verz. der Anwendung laden

procedure TfrmBrowse.amiPicsExecute(Sender: TObject);

var sr: TSearchRec;

    DirPath: String;

begin

  DirPath:= ExtractFilePath(Application.ExeName);

  if FindFirst(DirPath+'\*.jpg', faAnyFile, sr) = 0 then

  begin

    JPGBuffer.Path:= sr.name;

    while FindNext(sr) = 0 do

      JPGBuffer.Path:= sr.name;

    FindClose(sr);

 end;

 Refresh;

end;


// Thumbnails anzeigen

procedure TfrmBrowse.FormPaint(Sender: TObject);

begin

  JPGBuffer.DrawTo(scbMain);

end;

ist nicht kommentiert (die beiden Kommentare habe ich gerade eingefügt), war aber auch nur ein kleines Projekt für mich privat und ist IMHO nicht so schwer zu verstehen.

Der Code ist hiermit Freeware... macht damit was ihr wollt

Hoffe es hilft dir, ist zwar nur für JPGs, eine Anpassung für andere sollte aber nicht soo schwer sein.

Anmerkung: scbMain ist eine TScrollBox, in der die Thumbnails angezeigt werden.

Nochwas, ist mit Delphi7 gemacht, sollte aber auch so (also bei anderen Versionen) gehen (kleinere Anpassungen vielleicht nötig, wüsste jetzt auf den ersten blick aber nichts...)

[Guenzesson]

He Jesterday - vielen Dank für Deine Mühe!!

Ich werde es die kommende Woche mal einbetten und schauen...

Vielen Dank!!!!

Mischa

:) :)