home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / VCL / ICONSEL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  4.1 KB  |  160 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 2.1                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1998         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit Iconsel;
  10.  
  11. interface
  12.  
  13. uses
  14.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  15.   Forms, Dialogs, StdCtrls, Buttons, Grids, StylSped;
  16.  
  17. type
  18.   TIconSelForm = class(TForm)
  19.     Grid: TDrawGrid;
  20.     CancelBtn: TBitBtn;
  21.     Label1: TLabel;
  22.     Label2: TLabel;
  23.     OpenDialog: TOpenDialog;
  24.     OKBtn: TBitBtn;
  25.     BrowseBtn: TStyleSpeed;
  26.     FileEdit: TEdit;
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure FormDestroy(Sender: TObject);
  29.     procedure GridDrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect;
  30.       State: TGridDrawState);
  31.     procedure GridSelectCell(Sender: TObject; Col, Row: Longint;
  32.       var CanSelect: Boolean);
  33.     procedure FormShow(Sender: TObject);
  34.     procedure BrowseBtnClick(Sender: TObject);
  35.     procedure GridDblClick(Sender: TObject);
  36.     procedure FileEditKeyDown(Sender: TObject; var Key: Word;
  37.       Shift: TShiftState);
  38.   private
  39.     { Private declarations }
  40.     Icons : TList;
  41.     FIndex : Integer;
  42.     procedure SearchFile(const filename: TFilename);
  43.   public
  44.     { Public declarations }
  45.     property Index : Integer read FIndex write FIndex;
  46.   end;
  47.  
  48. const
  49.   NotifyNoIcons : Boolean = False;
  50.  
  51. var
  52.   IconSelForm: TIconSelForm;
  53.  
  54. implementation
  55.  
  56. {$R *.DFM}
  57.  
  58. uses ShellAPI, Environs;
  59.  
  60. procedure TIconSelForm.SearchFile(const filename: TFilename);
  61. var
  62.   i : Integer;
  63.   h : THandle;
  64.   s : array[0..79] of Char;
  65. begin
  66.   FileEdit.Text := Lowercase(filename);
  67.   Update;
  68.  
  69.   h := ExtractIcon(HInstance, StrPCopy(s, EnvironSubst(filename)), 0);
  70.  
  71.   if h <= 1 then begin
  72.     StrPCopy(s, Application.ExeName);
  73.     if NotifyNoIcons then
  74.       MessageDlg(Format('There are no icons in this file.  Please choose one ' +
  75.         'from %s', [ExtractFilename(Application.ExeName)]),
  76.         mtInformation, [mbOK], 0);
  77.     FileEdit.Text := Lowercase(Application.ExeName);
  78.   end
  79.   else DestroyIcon(h);
  80.  
  81.   Screen.Cursor := crHourGlass;
  82.   try
  83.     for i := 0 to Icons.Count-1 do DestroyIcon(Word(Icons[i]));
  84.     Icons.Clear;
  85.  
  86.     i := 0;
  87.     h := ExtractIcon(HInstance, s, i);
  88.     while h > 1 do begin
  89.       Icons.Add(Pointer(h));
  90.       Inc(i);
  91.       h := ExtractIcon(HInstance, s, i);
  92.     end;
  93.  
  94.     Grid.ColCount := Icons.Count;
  95.     if Index >= Icons.Count then Index := Icons.Count-1;
  96.     Grid.LeftCol := Index;
  97.     Grid.Col := Grid.LeftCol;
  98.     Index := 0;
  99.   finally
  100.     Screen.Cursor := crDefault;
  101.   end;
  102.   Grid.Invalidate;
  103. end;
  104.  
  105.  
  106. procedure TIconSelForm.FormCreate(Sender: TObject);
  107. begin
  108.   Icons := TList.Create;
  109.   Index := 0;
  110. end;
  111.  
  112. procedure TIconSelForm.FormDestroy(Sender: TObject);
  113. var i: Integer;
  114. begin
  115.   for i := 0 to Icons.Count-1 do DestroyIcon(Word(Icons[i]));
  116. end;
  117.  
  118. procedure TIconSelForm.GridDrawCell(Sender: TObject; Col, Row: Longint;
  119.   Rect: TRect; State: TGridDrawState);
  120. begin
  121.   if Col < Icons.Count then
  122.     DrawIcon(Grid.Canvas.Handle, Rect.Left + 4, Rect.Top + 4, HIcon(Icons[Col]));
  123. end;
  124.  
  125. procedure TIconSelForm.GridSelectCell(Sender: TObject; Col, Row: Longint;
  126.   var CanSelect: Boolean);
  127. begin
  128.   CanSelect := Col < Icons.Count;
  129. end;
  130.  
  131. procedure TIconSelForm.FormShow(Sender: TObject);
  132. begin
  133.   if FileEdit.Text = '' then begin
  134.     FileEdit.Text := Application.ExeName;
  135.     Index := 0;
  136.   end;
  137.   SearchFile(FileEdit.Text);
  138. end;
  139.  
  140. procedure TIconSelForm.BrowseBtnClick(Sender: TObject);
  141. begin
  142.   with OpenDialog do begin
  143.     Filename := FileEdit.Text;
  144.     if Execute then SearchFile(Filename);
  145.   end;
  146. end;
  147.  
  148. procedure TIconSelForm.GridDblClick(Sender: TObject);
  149. begin
  150.   OKBtn.Click;
  151. end;
  152.  
  153. procedure TIconSelForm.FileEditKeyDown(Sender: TObject; var Key: Word;
  154.   Shift: TShiftState);
  155. begin
  156.   if Key = VK_RETURN then SearchFile(FileEdit.Text);
  157. end;
  158.  
  159. end.
  160.