home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / glyfview / unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  3.4 KB  |  137 lines
  1. unit Unit1;
  2.  
  3. (*
  4. Just a quick ditty for diplaying a directory of bitmaps that may be
  5. used as glyphs. Still needs a Print button. Excuse the style - not
  6. originally intended for anyone else. Ought to be fixed up for
  7. use on Tools palette, with automatic redraw as choices are changed.
  8.  
  9. Enjoy.
  10.  
  11. Jay Baker
  12. CIS 73530,3146
  13.  
  14. *)
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  20.   Forms, Dialogs, FileCtrl, StdCtrls, ExtCtrls, Buttons;
  21.  
  22. type
  23.   TForm1 = class(TForm)
  24.     Panel1: TPanel;
  25.     DirectoryListBox1: TDirectoryListBox;
  26.     FileListBox1: TFileListBox;
  27.     rg1: TRadioGroup;
  28.     BitBtn1: TBitBtn;
  29.     BitBtn2: TBitBtn;
  30.     rg2: TRadioGroup;
  31.     procedure Button1Click(Sender: TObject);
  32.     procedure Button2Click(Sender: TObject);
  33.     procedure FileListBox1Change(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.DFM}
  46.  
  47. const
  48.   MaxBmpHeight=20;
  49.  
  50. procedure TForm1.Button1Click(Sender: TObject);
  51.  
  52.   procedure disp(Canvas:TCanvas);
  53.   var
  54.     i:integer;
  55.     b:TBitMap;
  56.     drect,srect:TRect;
  57.     z,x,y:integer;
  58.     s:string;
  59.     yText:integer;
  60.     dx,dy:integer;
  61.     ncols:integer;
  62.     nrows:integer;
  63.     i1,i2:integer;
  64.     bs:integer;
  65.   begin
  66.     with Canvas do begin Brush.Color:=clSilver; FillRect(ClipRect) end;
  67.     yText:=abs(Canvas.Font.Height)+2;
  68.     dx:=MaxBmpHeight+36;
  69.     dy:=MaxBmpHeight+yText+8;
  70.     with ClientRect do ncols:=(Right-Left) div dx;
  71.     nrows:=(Panel1.Top-8) div dy;
  72.     bs:=rg1.ItemIndex;
  73.     b:=TBitmap.Create; try
  74.     i1:=rg2.ItemIndex*(nrows*ncols);
  75.     i2:=i1+(nrows*ncols);
  76.     with FileListBox1.Items do if i2>Count then i2:=Count;
  77.     for i:=i1 to i2-1 do begin
  78.       Application.ProcessMessages;
  79.       x:=4+dx*((i-i1) mod ncols);
  80.       y:=4+dy*((i-i1) div ncols);
  81.       Canvas.Rectangle(x,y,x+dx+1,y+dy+1);
  82.       s:=FileListBox1.Items[i];
  83.       b.LoadFromFile(s);
  84.   (*
  85.       if i in [1..3] then with b do
  86.         if Width <> (Width div Height) * Height then
  87.           MessageDlg('w='+IntToStr(Width)+',h='+IntToStr(Height),
  88.                      mtInformation,[mbOK],0);
  89.   *)
  90.       system.Delete(s,length(s)-3,4);
  91.       Canvas.TextOut(x+4,y+2,s);
  92.       case bs of
  93.         0..3:begin
  94.              drect:=Rect(x+4,y+4+yText,x+4+b.Height,y+4+yText+b.Height);
  95.              srect:=Rect(bs*b.Height,0,(bs+1)*b.Height,b.Height);
  96.              end;
  97.         4   :begin
  98.              drect:=Rect(x+4,y+4+yText,x+4+b.Width,y+4+yText+b.Height);
  99.              srect:=Rect(0,0,b.Width,b.Height);
  100.              end;
  101.         end;
  102.       Canvas.BrushCopy(drect,b,srect,b.TransparentColor);
  103.       end;
  104.     finally b.Free end;
  105.     end;
  106.  
  107. begin
  108.   disp(Canvas);
  109. end;
  110.  
  111. procedure TForm1.Button2Click(Sender: TObject);
  112. begin
  113.   Close
  114. end;
  115.  
  116. procedure TForm1.FileListBox1Change(Sender: TObject);
  117. var
  118.   yText,dx,dy,ncols:integer;
  119.   nrows:integer;
  120.   i:integer;
  121. begin
  122.   rg2.Items.Clear;
  123.   rg2.Enabled:=false;
  124.   if FileListBox1.Items.Count=0 then exit;
  125.   yText:=abs(Canvas.Font.Height)+2;
  126.   dx:=MaxBmpHeight+36;
  127.   dy:=MaxBmpHeight+yText+8;
  128.   with ClientRect do ncols:=(Right-Left) div dx;
  129.   nrows:=(Panel1.Top-8) div dy;
  130.   for i:=1 to (FileListBox1.Items.Count+(ncols*nrows)-1) div (ncols*nrows) do
  131.     rg2.Items.Add(IntToStr(i));
  132.   rg2.ItemIndex:=0;
  133.   rg2.Enabled:=rg2.Items.Count>1;
  134. end;
  135.  
  136. end.
  137.