{-------------------------------------------------------------------------------
   Purpose: A panel showing thumb-size pictures
   Unit:    ThumbsPanel
   Author:  vesal
   Date:    8.7.2003
   Changed:

   Usage:
   ======
    Create component and set BasicThumbsDir.  Then set Names property
    for list of pictures to load.  Rows propererty decides in how many rows
    the pictures are shown.  0 = automatic rowcount.


   Methods:
   ========
    procedure LoadThumbs; virtual;
      - force new load for pictures

    procedure SetActive; virtual;
      - set component active and find current picture to screen


   Properties:
   ===========
    property Picture[i:integer] : TZoomPicture read GetPicture;
      - returns ZoomPicture in index i.  Return nil if no picture in index i

  published
    property Names : TStrings read FNames write SetNames;
      - set Names property for list of filenes to load thumbs

    property BasicThumbsDir : string read FBasicThumbsDir write SetBasicThumbsDir;
      - from which directory the thumb size pictures are searched

    property ThumbSize : integer read FThumbSize write SetThumbSize;
      - size in pixel for one thumb

    property Rows : integer read FRows write SetRows;
      - how many rows to show.  If 0 then rowcount is as much as needed

    property ItemIndex : integer read FItemIndex write SetItemIndex;
      - index for currently active picture

    property Count : integer read GetCount;
      - how many pciture is in component

    property Row : integer read GetRow write SetRow;
      - Row index for currently active picture

    property Col : integer read GetCol write SetCol;
      - Columns index for currently active picture

   Events:
   =======
    OnClick(Sender:TObject)
      - occurs when picture is clicked with mouse or Enter or Space is
        pressed on selected picture.  Sender is the clicked picture.

   Implementation:
   ===============
     There is one dummememo unde the pictures to get Focus for this component.
     Then this memo takes all pressed keys and so the current picture can be
     changed also by keyboard.

     When changing the Names property the old pictures are just deleted.
     In new Paint method the pictures are really loaded if not allready loaded.


-------------------------------------------------------------------------------}

unit ThumbsPanel;

interface
uses Windows, ExtCtrls,Classes,ZoomPicture, IdGlobal, Forms, Controls,StdCtrls;

type
  TThumbsPanel = class(TPanel)
  private
    columns : integer;
    dummymemo : TMemo;
    FNames: TStrings;
    FBasicThumbsDir: string;
    FThumbSize: integer;
    FRows: integer;
    FItemIndex: integer;
    procedure SetThumbSize(const Value: integer);
    procedure SetRows(const Value: integer);
    procedure SetItemIndex(const Value: integer);
    function GetPicture(i: integer): TZoomPicture;
    function GetCount: integer;
    function GetRow: integer;
    procedure SetRow(const Value: integer);
    function GetCol: integer;
    procedure SetCol(const Value: integer);
  protected
    PanelThumbsPanel : TPanel;
    SBThumbs : TScrollBox;
    Thumbs : array of TZoomPicture;
    procedure SetNames(const Value: TStrings); virtual;
    procedure SetBasicThumbsDir(const Value: string); virtual;
    procedure ThumbClicked(Sender: TObject); virtual;
    procedure OnMemoEnter(Sender: TObject); virtual;
    procedure OnCtrlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure PanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Paint; override;
    procedure ReOrderThumbs; virtual;
    procedure ClearThumbs; virtual;
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner : TComponent); override;
    procedure LoadThumbs; virtual;
    procedure SetActive; virtual;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property Picture[i:integer] : TZoomPicture read GetPicture;
  published
    property Names : TStrings read FNames write SetNames;
    property BasicThumbsDir : string read FBasicThumbsDir write SetBasicThumbsDir;
    property ThumbSize : integer read FThumbSize write SetThumbSize;
    property Rows : integer read FRows write SetRows;
    property ItemIndex : integer read FItemIndex write SetItemIndex;
    property Count : integer read GetCount;
    property Row : integer read GetRow write SetRow;
    property Col : integer read GetCol write SetCol;
  end;

implementation
uses Dialogs,Graphics;
{ TThumbsPanel }

procedure TThumbsPanel.ClearThumbs;
begin
  FreeAndNil(PanelThumbsPanel);
  SetLength(Thumbs,0);
end;

constructor TThumbsPanel.Create(AOwner: TComponent);
begin
  inherited;
  SBThumbs := TScrollBox.Create(self);
  SBThumbs.Parent := self;
  SBThumbs.Align := alClient;
  FItemIndex := -1;
  OnKeyDown := OnCtrlKeyDown;

  dummymemo := TMemo.Create(self);
  dummymemo.OnKeyDown := OnCtrlKeyDown;
  dummymemo.Parent := SBThumbs;
  dummymemo.Left := 0; dummymemo.Top := 0;
  dummymemo.Width := 2; dummymemo.Height := 2;
  dummymemo.SendToBack;
  dummymemo.OnEnter := OnMemoEnter;
end;

function TThumbsPanel.GetCount: integer;
begin
  Result := 0;
  if ( not Assigned(Names) ) then exit;
  Result := Names.Count;
end;

function TThumbsPanel.GetPicture(i: integer): TZoomPicture;
begin
  Result := nil;
  if ( not Assigned(Names) ) then exit;
  if ( i < 0 ) or ( i >= Length(Thumbs) ) then exit;
  Result := Thumbs[i];
end;

function TThumbsPanel.GetCol: integer;
begin
  Result := 0;
  if ( columns = 0 ) then exit;
  Result := ItemIndex mod columns;
end;

procedure TThumbsPanel.SetCol(const Value: integer);
var i : integer;
begin
  i := Row * columns + Value;
  if ( i >= Count ) then i := Count-1;
  ItemIndex := i;
end;


function TThumbsPanel.GetRow: integer;
begin
  Result := 0;
  if ( columns = 0 ) then exit;
  Result := ItemIndex div columns;
end;

procedure TThumbsPanel.SetRow(const Value: integer);
var col,old,r,i : integer;
begin
  if ( columns = 0 ) then exit;
  col := ItemIndex mod columns;
  old := Row;
  r := Count div columns;
  i := ItemIndex + ( Value - old)*columns;
  if ( i >= count ) then ItemIndex := col
  else if ( i >= 0 ) then ItemIndex := i
  else begin
    i := i + (r+1) * columns;
    if ( i >= count ) then i := i - columns;
    ItemIndex := i;
  end;
end;


procedure TThumbsPanel.LoadThumbs;
var x,y,i,dy:integer; zp : TZoomPicture; cs : TSize;
    panel : TPanel; firstmissing : boolean;
    maxx,n,nx : integer; //cb : TCheckBox;
begin
  firstmissing := true;
  ClearThumbs;
  if ( not assigned(Names) ) then exit;
  if not ( Visible ) then exit;

  panel := TPanel.Create(self);
  PanelThumbsPanel := panel;
  panel.Caption := ' ';
  panel.Parent := SBThumbs;
  panel.AutoSize := false;
  if ( Rows = 0 ) then panel.Align := alTop;
  panel.Height := 0;
  panel.Name := 'PanelThumbsPanel';
  panel.ShowHint := true;
  panel.BevelOuter := bvNone;
  panel.OnMouseDown := PanelMouseDown;

  x := 0; y := 0;
  cs.cx := ThumbSize; cs.cy := ThumbSize;
  SetLength(Thumbs,Names.Count);
  if ( Rows > 0 ) then n := Round((Names.Count)/Rows+0.5) else n := 0;
  nx := 0;  maxx := 0; columns := 0;


  for i:=0 to Names.Count-1 do begin
    zp := TZoomPicture.Create(panel);
    zp.AutoScroll := false;
    zp.Parent := panel;
    zp.BevelInner := bvLowered;
    if ( cs.cx > 0 ) then zp.SetBounds(x,y,cs.cx,cs.cy);
    try
      zp.FileName := BasicThumbsDir + '\' + Names[i];
    except
      zp.Free;
      Thumbs[i] := nil;
      if ( firstmissing ) then ShowMessage('Make thumbs first');
      firstmissing := false;
//      ShowMakeHtml := true;
      continue;
    end;
    if ( cs.cx <= 0 ) then begin
      cs := zp.ImageSize;
      if ( cs.cx > cs.cy ) then cs.cy := cs.cx else cs.cx := cs.cy;
      cs.cx := cs.cx + 10; cs.cy := cs.cy + 10;
      zp.SetBounds(x,y,cs.cx,cs.cy);
    end;
    Thumbs[i] := zp;
    zp.Tag := i;
    zp.Hint := Names[i];
    zp.OnClick := ThumbClicked;

    x := x + cs.cx;  inc(nx);
    maxx := max(x,maxx);
    columns := max(columns,nx);
    if ( ( x + cs.cx >= panel.ClientWidth ) and ( n = 0 ) ) or
       ( ( nx >= n ) and ( n > 0 ) ) then begin
      x := 0;
      y := y + cs.cy;
      nx := 0;
    end;
  end;
  dy := 0;  if ( x <> 0 ) then dy := cs.cy;
  panel.Height := y + dy;
  panel.Width := maxx;
  ItemIndex := ItemIndex;
end;

procedure TThumbsPanel.ReOrderThumbs;
var x,y,i,dy:integer; zp : TZoomPicture; cs : TSize;
    panel : TPanel;
    maxx,n,nx : integer;
begin
  if ( not Assigned(PanelThumbsPanel) ) then exit;
  panel := PanelThumbsPanel;
  if ( Rows = 0 ) then panel.Align := alTop else panel.Align := alNone;
  panel.Height := 0;
  x := 0; y := 0;
  panel := PanelThumbsPanel;
  cs.cx := ThumbSize; cs.cy := ThumbSize;
  if ( not assigned(Names) ) then exit;
  if ( Rows > 0 ) then n := Round((Names.Count)/Rows+0.5) else n := 0;
  maxx := 0; nx := 0; columns := 0;
  for i:=0 to Length(Thumbs)-1 do begin
    zp := Thumbs[i];
    if ( zp = nil ) then continue;
    if ( cs.cx > 0 ) then zp.SetBounds(x,y,cs.cx,cs.cy)
    else begin
      cs := zp.ImageSize;
      if ( cs.cx > cs.cy ) then cs.cy := cs.cx else cs.cx := cs.cy;
      cs.cx := cs.cx + 10; cs.cy := cs.cy + 10;
      zp.SetBounds(x,y,cs.cx,cs.cy);
    end;

    x := x + cs.cx;  inc(nx);
    maxx := max(x,maxx);
    columns := max(columns,nx);
    if ( ( x + cs.cx >= panel.ClientWidth ) and ( n = 0 ) ) or
       ( ( nx >= n ) and ( n > 0 ) ) then begin
      x := 0;
      y := y + cs.cy;
      nx := 0;
    end;
  end;
  dy := 0;  if ( x <> 0 ) then dy := cs.cy;
  panel.Height := y + dy;
  panel.Width := maxx;
  ItemIndex := ItemIndex;
end;

procedure TThumbsPanel.OnCtrlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if ( ItemIndex < 0 ) then begin ItemIndex := 0; exit; end;
  case ( Key ) of
    VK_DOWN:  if ( Rows = 1 ) then ItemIndex := ItemIndex + 1 else Row := Row + 1;
    VK_UP:    if ( Rows = 1 ) then ItemIndex := ItemIndex - 1 else Row := Row - 1;
    VK_LEFT:  ItemIndex := ItemIndex - 1;
    VK_RIGHT: ItemIndex := ItemIndex + 1;
    VK_HOME:  if ( columns = 1 ) or ( Rows = 1 ) then ItemIndex := 0 else Col := 0;
    VK_END:   if ( columns = 1 ) or ( Rows = 1 ) then ItemIndex := Count-1 else Col := columns-1;
    VK_SPACE:  if Assigned(OnClick) then OnClick(Picture[ItemIndex]);
    VK_RETURN: if Assigned(OnClick) then OnClick(Picture[ItemIndex]);
  end;
end;

procedure TThumbsPanel.Paint;
begin
  inherited;
  if ( Assigned(PanelThumbsPanel) ) then exit;
  LoadThumbs;
end;

procedure TThumbsPanel.PanelMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  SetActive;
end;


procedure TThumbsPanel.SetBasicThumbsDir(const Value: string);
begin
  FBasicThumbsDir := Value;
end;

procedure TThumbsPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var change : boolean;
begin
  change := ( AWidth <> Width ) or ( AHeight <> Height );
  inherited;
  if  not change then exit;
  ReOrderThumbs;
end;

procedure TThumbsPanel.SetItemIndex(const Value: integer);
var zp : TZoomPicture; old : integer;
begin
  old := ItemIndex;
  zp := Picture[ItemIndex];
  if ( zp <> nil ) then zp.Color := Color;
  if ( Value < Count ) then FItemIndex := Value else FItemIndex := Value - Count;
  if ( old >= 0 ) and ( Value < 0 ) then FItemIndex := Count+Value;
  zp := Picture[ItemIndex];
  if ( zp <> nil ) then begin
    zp.Color := clHighLight;
    SBThumbs.ScrollInView(zp);
  end;
end;

procedure TThumbsPanel.SetNames(const Value: TStrings);
begin
  FNames := Value;
  FItemIndex := -1;
  ClearThumbs;
  Invalidate;
end;

procedure TThumbsPanel.SetRows(const Value: integer);
begin
  if ( Value = Rows ) then exit;
  FRows := Value;
  ReOrderThumbs;
end;

procedure TThumbsPanel.SetThumbSize(const Value: integer);
begin
  if ( Value = ThumbSize ) then exit;
  FThumbSize := Value;
  ReOrderThumbs;
end;

procedure TThumbsPanel.ThumbClicked(Sender: TObject);
var zp : TZoomPicture;
begin
  if not ( Sender is TZoomPicture ) then exit;
  zp := TZoomPicture(Sender);
  ItemIndex := zp.Tag;
  SetActive;
  if ( Assigned(OnClick) ) then  OnClick(Sender);
end;


procedure TThumbsPanel.SetParent(AParent: TWinControl);
begin
  inherited;
end;

procedure TThumbsPanel.SetActive;
begin
  if ( Showing ) then dummymemo.SetFocus;
  ItemIndex := ItemIndex;
end;

procedure TThumbsPanel.OnMemoEnter(Sender: TObject);
begin
  SetActive;
end;

end.