home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / VCL / ICONSEL.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  4KB  |  142 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 1.0                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1997         }
  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.   private
  36.     { Private declarations }
  37.     Icons : TList;
  38.     FIndex : Integer;
  39.     procedure SearchFile(const filename: TFilename);
  40.   public
  41.     { Public declarations }
  42.     property Index : Integer read FIndex write FIndex;
  43.   end;
  44.  
  45. var
  46.   IconSelForm: TIconSelForm;
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. uses ShellAPI;
  53.  
  54. procedure TIconSelForm.SearchFile(const filename: TFilename);
  55. var
  56.   i : Integer;
  57.   h : THandle;
  58.   s : array[0..79] of Char;
  59. begin
  60.   FileEdit.Text := Lowercase(filename);
  61.   Update;
  62.  
  63.   h := ExtractIcon(HInstance, StrPCopy(s, filename), 0);
  64.  
  65.   if h <= 1 then begin
  66.     StrPCopy(s, Application.ExeName);
  67.     MessageDlg(Format('There are no icons in this file.  Please choose one ' +
  68.       'from %s', [ExtractFilename(Application.ExeName)]),
  69.       mtInformation, [mbOK], 0);
  70.     FileEdit.Text := Lowercase(Application.ExeName);
  71.   end
  72.   else DestroyIcon(h);
  73.  
  74.   Screen.Cursor := crHourGlass;
  75.   try
  76.     for i := 0 to Icons.Count-1 do DestroyIcon(Word(Icons[i]));
  77.     Icons.Clear;
  78.  
  79.     i := 0;
  80.     h := ExtractIcon(HInstance, s, i);
  81.     while h > 1 do begin
  82.       Icons.Add(Pointer(h));
  83.       Inc(i);
  84.       h := ExtractIcon(HInstance, s, i);
  85.     end;
  86.  
  87.     Grid.ColCount := Icons.Count;
  88.     if Index >= Icons.Count then Index := Icons.Count-1;
  89.     Grid.LeftCol := Index;
  90.     Grid.Col := Grid.LeftCol;
  91.     Index := 0;
  92.   finally
  93.     Screen.Cursor := crDefault;
  94.   end;
  95.   Grid.Invalidate;
  96. end;
  97.  
  98.  
  99. procedure TIconSelForm.FormCreate(Sender: TObject);
  100. begin
  101.   Icons := TList.Create;
  102.   Index := 0;
  103. end;
  104.  
  105. procedure TIconSelForm.FormDestroy(Sender: TObject);
  106. var i: Integer;
  107. begin
  108.   for i := 0 to Icons.Count-1 do DestroyIcon(Word(Icons[i]));
  109. end;
  110.  
  111. procedure TIconSelForm.GridDrawCell(Sender: TObject; Col, Row: Longint;
  112.   Rect: TRect; State: TGridDrawState);
  113. begin
  114.   if Col < Icons.Count then
  115.     DrawIcon(Grid.Canvas.Handle, Rect.Left + 4, Rect.Top + 4, HIcon(Icons[Col]));
  116. end;
  117.  
  118. procedure TIconSelForm.GridSelectCell(Sender: TObject; Col, Row: Longint;
  119.   var CanSelect: Boolean);
  120. begin
  121.   CanSelect := Col < Icons.Count;
  122. end;
  123.  
  124. procedure TIconSelForm.FormShow(Sender: TObject);
  125. begin
  126.   if FileEdit.Text = '' then begin
  127.     FileEdit.Text := Application.ExeName;
  128.     Index := 0;
  129.   end;
  130.   SearchFile(FileEdit.Text);
  131. end;
  132.  
  133. procedure TIconSelForm.BrowseBtnClick(Sender: TObject);
  134. begin
  135.   with OpenDialog do begin
  136.     Filename := FileEdit.Text;
  137.     if Execute then SearchFile(Filename);
  138.   end;
  139. end;
  140.  
  141. end.
  142.