home *** CD-ROM | disk | FTP | other *** search
- unit Unit1;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, Grids, StdCtrls, FileCtrl, ExtCtrls, Menus, Spin;
-
- type
- TForm1 = class(TForm)
- MainMenu1: TMainMenu;
- File1: TMenuItem;
- Exit1: TMenuItem;
- Edit1: TMenuItem;
- Copy1: TMenuItem;
- Panel2: TPanel;
- DriveComboBox1: TDriveComboBox;
- DirectoryListBox1: TDirectoryListBox;
- MagFactor: TSpinEdit;
- Magnification: TLabel;
- DrawGrid1: TDrawGrid;
- procedure DriveComboBox1Change(Sender: TObject);
- procedure DirectoryListBox1Change(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure DrawGrid1DrawCell(Sender: TObject; Col, Row: Longint;
- Rect: TRect; State: TGridDrawState);
- procedure Exit1Click(Sender: TObject);
- procedure Copy1Click(Sender: TObject);
- procedure MagFactorChange(Sender: TObject);
- private
- { Private declarations }
- GFList : TStringList;
- procedure InitNewDir;
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- uses Clipbrd;
-
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- GFList := TStringList.Create;
- DrawGrid1.ColWidths[0] := 64;
- DrawGrid1.ColWidths[1] := 128;
- {irectoryListBox1.Directory := 'd:\delphi\images\buttons';}
- InitNewDir;
- end;
-
- procedure TForm1.DriveComboBox1Change(Sender: TObject);
- begin
- DirectoryListBox1.Drive := DriveComboBox1.Drive;
- end;
-
- procedure TForm1.InitNewDir;
- var
- Result : Integer;
- sr: TSearchRec;
- begin
- If GFList.Count > 0 then
- GFList.Clear;
- Result := FindFirst(DirectoryListBox1.Directory + '\*.bmp', faAnyFile, sr);
- while result = 0 do
- begin
- if sr.Attr > 0 then
- GFList.Add(sr.Name);
- Result := FindNext(sr);
- end;
- DrawGrid1.RowCount := GFList.Count+1;
- end;
-
- procedure TForm1.DirectoryListBox1Change(Sender: TObject);
- begin
- InitNewDir;
- end;
-
- procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Longint;
- Rect: TRect; State: TGridDrawState);
- var
- dg : TDrawGrid;
- bm : TBitmap;
- SRect, DRect : TRect;
- begin
- dg := (Sender as TDrawGrid);
- if row = 0 then
- else if Col = 0 then
- begin
- { Draw Bitmap }
- bm := TBitmap.Create;
- bm.LoadFromFile(GFList.Strings[Row-1]);
- SRect := classes.Rect(0, 0, bm.Width, bm.Height);
- DRect := classes.Rect(Rect.Left+2, Rect.Top + 1 ,
- Rect.Left + 3 + bm.Width * MagFactor.Value,
- Rect.Top + 1 + bm.Height * MagFactor.Value);
- dg.Canvas.BrushCopy(DRect, bm, SRect,
- bm.Canvas.Pixels[0,bm.Height-1]);
- bm.Free;
- end
- else
- { Print Filename }
- dg.Canvas.TextRect(Rect, Rect.Left + 2,
- Rect.Top + 1, GFList.Strings[Row-1]);
- end;
-
- procedure TForm1.Exit1Click(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TForm1.Copy1Click(Sender: TObject);
- var
- r : TGridRect;
- begin
- r := DrawGrid1.Selection;
- Clipboard.AsText := DirectoryListBox1.Directory
- + '\' + GFList.Strings[r.Top-1];
- end;
-
- procedure TForm1.MagFactorChange(Sender: TObject);
- begin
- DrawGrid1.DefaultRowHeight := 20 * MagFactor.Value;
- DrawGrid1.ColWidths[0] := 50 * MagFactor.Value;
- end;
-
- end.
-