home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Runimage / Delphi50 / Demos / ToolsAPI / INTAServices / iconaddu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  2.9 KB  |  106 lines
  1. unit IconAddU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, ToolWin, ComCtrls, ActnList, toolsapi;
  8.  
  9. procedure Register;
  10.  
  11. implementation
  12. uses DisplayU;
  13.  
  14. {This Procedure fire off a small modal dialog that allows the user to load a
  15.  bitmap and view the names of the IDE's Actions.}
  16. Procedure DisplayChoices(Var IconFileName, ActionName: string; IDE: INTAServices);
  17. var
  18.   i: integer;
  19.   Alist: TCustomActionList;
  20. begin
  21.   DisplayForm := TDisplayForm.Create(nil);
  22.   try
  23.     Alist := IDE.GetActionList;
  24.     for i := 0 to Alist.ActionCount -1 do
  25.     begin
  26.       DisplayForm.ComboBox1.items.add(TAction(Alist.Actions[i]).name);
  27.     end;
  28.  
  29.     DisplayForm.Showmodal;
  30.     IconFileName := DisplayForm.OpenPictureDialog1.filename;
  31.     ActionName := DisplayForm.ComboBox1.text;
  32.   finally
  33.     DisplayForm.free;
  34.   end;
  35. end;
  36.  
  37.  
  38. {This function just adds a given bitmap to the IDE's imagelist.  There are no
  39. safety features to make sure the image will work.  We it only checks to see if
  40. it worked.
  41.   Return value is the new index of the image.
  42. }
  43. function AddIconToImageList(IconFileName: string; IDE: INTAServices): integer;
  44. var
  45.   Image: TBitmap;
  46. begin
  47.   Image := TBitmap.Create;
  48.   try
  49.     Image.LoadFromFile(IconFileName);
  50.     Result := IDE.AddMasked(Image, Image.TransparentColor, 'New image');
  51.   finally
  52.     Image.free;
  53.   end;
  54.   if Result = -1 then
  55.     Exception.Create('Error loading image for ToolButton in a custom package');
  56. end;
  57.  
  58. {This procedure runs through the IDE's action list looking to match up two
  59.  action names.  Once found, it assigns the action a new image index.}
  60. Procedure SetImageToAction(ActionNAme: String; Index: integer; IDE: INTAServices);
  61. var
  62.   Alist: TCustomActionList;
  63.   i: integer;
  64. begin
  65.   Alist := IDE.GetActionList;
  66.       for i := 0 to Alist.ActionCount -1 do
  67.     begin
  68.       if ActionName = TAction(Alist.Actions[i]).name then   //Can use caption too
  69.       begin
  70.         if (Alist.actions[i]) is TAction then
  71.           (Alist.actions[i] as Taction).Imageindex := Index;
  72.         break
  73.       end;
  74.     end;
  75. end;
  76.  
  77.  
  78. {Opentools API packages use the register procedure to execute the code when
  79. the IDE is each time loaded. }
  80. procedure Register;
  81. var
  82.   IDE: INTAServices;
  83.   IconFileName: string;
  84.   ActionName: string;
  85.   Index: integer;
  86. begin
  87.   //All function use IDE interface, so grab it just once
  88.   IDE := (BorlandIDEServices as INTAServices);
  89.  
  90.   {This function should just be used to decide the icon names and action names
  91.    once.  Otherwise you'll have a dialog pop everything you load Delphi.  It is
  92.    left as an excerise to the user to store and load these names as needed}
  93.   DisplayChoices(IconFileName, ActionName, IDE);
  94.  
  95.  
  96.   if ( (ActionName <> '') and (IconFileName <> '') ) then //make sure of some input
  97.   begin
  98.     index := AddIconToImageList(IconFileName, IDE);
  99.     SetImageToAction(ActionName, Index, IDE);
  100.   end;
  101. end;
  102.  
  103.  
  104. end.
  105.  
  106.