source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/fImagePickExisting.pas@ 1531

unit fImagePickExisting;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, fImages, StdCtrls, Buttons, ExtCtrls;

type
  TfrmImagePickExisting = class(TForm)
    pnlButtons: TPanel;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    ScrollBox: TScrollBox;
    Image1: TImage;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ImageClick(Sender: TObject);
    procedure ImageDblClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure ScrollBoxClick(Sender: TObject);
  private
    { Private declarations }
    ShownImagesList : TList; //owns objects
    Row, Col : integer;
    NextInsert : TPoint;
    CurRowHeight : integer;
    SelectedIndex : integer;
    function GetImageFName : string;
    function GetSelectedImageInfo : TImageInfo;
    procedure InitImagePlacement;
    procedure BoxImage(Index: integer; Selected : boolean);
    procedure ImagesListClear;
    procedure ShowImages;
    procedure ShowSelected;
  public
    { Public declarations }
    property SelectedImageInfo : TImageInfo read GetSelectedImageInfo;
    property SelectedImageFName : string read GetImageFName;
  end;

const
  IMAGE_SPACING = 5;
  COLS_PER_ROW = 3;

var
  frmImagePickExisting: TfrmImagePickExisting;

implementation

{$R *.dfm}

procedure TfrmImagePickExisting.FormShow(Sender: TObject);
begin
   ShowImages;
end;

procedure TfrmImagePickExisting.FormCreate(Sender: TObject);
begin
  ShownImagesList := TList.Create; //owns objects
  InitImagePlacement;
end;

procedure TfrmImagePickExisting.FormDestroy(Sender: TObject);
begin
  ImagesListClear;
  ShownImagesList.Free;
end;

//------------------------------------------------------------
//Event handlers
//------------------------------------------------------------
procedure TfrmImagePickExisting.ImageClick(Sender: TObject);
begin
  SelectedIndex := TImage(Sender).Tag;
  ShowSelected;
end;

procedure TfrmImagePickExisting.ImageDblClick(Sender: TObject);
begin
  SelectedIndex := TImage(Sender).Tag;
  ShowSelected;
  btnOK.Click;
end;

procedure TfrmImagePickExisting.btnOKClick(Sender: TObject);
begin
  //kt
end;

procedure TfrmImagePickExisting.ScrollBoxClick(Sender: TObject);
begin
  SelectedIndex := -1;
  ShowSelected;
end;

//------------------------------------------------------------
//-----------------------------------------------------------

procedure TfrmImagePickExisting.ShowSelected;
var i : integer;
begin
  for i := 0 to ShownImagesList.Count-1 do begin
    BoxImage(i, (i=SelectedIndex));
  end;
end;

procedure TfrmImagePickExisting.ImagesListClear;
var i : integer;
    Image : TImage;
begin
  for i := 0 to ShownImagesList.Count-1 do begin
    Image := TImage(ShownImagesList.Items[i]);
    Image.Free;
  end;
  InitImagePlacement;
end;

procedure TfrmImagePickExisting.InitImagePlacement;
begin
  Row := 0;
  Col := 0;
  NextInsert.X := IMAGE_SPACING;
  NextInsert.Y := IMAGE_SPACING;
  CurRowHeight := 0;
  SelectedIndex := -1;
end;


procedure TfrmImagePickExisting.ShowImages;
var i : integer;
    Image : TImage;
    Rec  : TImageInfo;

begin
  frmImages.EnsureALLImagesDownloaded;
  ImagesListClear;
  for i := 0 to frmImages.ImagesCount - 1 do begin
    Rec := frmImages.ImageInfo[i];
    Image := TImage.Create(Self);
    ShownImagesList.Add(Image);  //index will match Image.Tag below
    Image.Visible := false;
    Image.Parent := ScrollBox;
    if FileExists(Rec.CacheThumbFName) then begin
      Image.Picture.Bitmap.LoadFromFile(Rec.CacheThumbFName);
    end else begin
      frmImages.GetThumbnailBitmapForFName(Rec.CacheFName,
                                           Image.Picture.Bitmap);
    end;
    Image.Top := NextInsert.Y;
    Image.Left := NextInsert.X;
    Image.Tag := i;
    Image.OnClick := ImageClick;
    Image.OnDblclick := ImageDblClick;
    Image.Visible := true;
    If Image.Picture.Bitmap.Height > CurRowHeight then begin
      CurRowHeight := Image.Picture.Bitmap.Height;
    end;
    Inc (Col);
    if Col > COLS_PER_ROW then begin
      Col := 0;
      Inc (Row);
      NextInsert.X := IMAGE_SPACING;
      NextInsert.Y := NextInsert.Y + CurRowHeight + IMAGE_SPACING;
    end else begin
      NextInsert.X := NextInsert.X + Image.Picture.Bitmap.Width + IMAGE_SPACING;
    end;
  end;
end;

function TfrmImagePickExisting.GetSelectedImageInfo : TImageInfo;
//Returns nil if not selcted.
begin
  if SelectedIndex> -1 then begin
    Result := frmImages.ImageInfo[SelectedIndex];
  end else begin
    Result := nil;
  end;
end;

function TfrmImagePickExisting.GetImageFName : string;
var
  Rec  : TImageInfo;
begin
  Rec := GetSelectedImageInfo;
  if Assigned(Rec) then begin
    Result := Rec.CacheFName;
  end else begin
    Result := '';
  end;
end;

procedure TfrmImagePickExisting.BoxImage(Index: integer; Selected : boolean);
var
  Image : TImage;
  Rect : TRect;
begin
  if (Index < 0) or (Index >= ShownImagesList.Count) then exit;
  Image := TImage(ShownImagesList.Items[Index]);
  if Image = nil then exit;
  Rect.Top := 0; Rect.Left := 0;
  Rect.Right := Image.Picture.Bitmap.Width-1;
  Rect.Bottom := Image.Picture.Bitmap.Height-1;
  if Selected then begin
    Image.Canvas.Pen.Color := clRed;
  end else begin
    Image.Canvas.Pen.Color := clBtnFace;
  end;
  Image.Canvas.PenPos := Rect.TopLeft;
  Image.Canvas.LineTo(Rect.Left,Rect.Bottom);
  Image.Canvas.LineTo(Rect.Right,Rect.Bottom);
  Image.Canvas.LineTo(Rect.Right,Rect.Top);
  Image.Canvas.LineTo(Rect.Left,Rect.Top);
  //Image.Canvas.Rectangle(Rect); //This fills in center with brush.
end;


end.