home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / CompositeComponentsPack / SOURCE / BoxDsgn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-12  |  5.3 KB  |  176 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {       Composite Components Pack (CCPack)              }
  5. {                                                       }
  6. {       Copyright (c) 1997-99 Sergey Orlik              }
  7. {                                                       }
  8. {     Written by:                                       }
  9. {       Sergey Orlik                                    }
  10. {       product manager                                 }
  11. {       Russia, C.I.S. and Baltic States (former USSR)  }
  12. {       Inprise Moscow office                           }
  13. {       Internet:  sorlik@inprise.ru                    }
  14. {       www.geocities.com/SiliconValley/Way/9006/       }
  15. {                                                       }
  16. {*******************************************************}
  17. {$I BOXDEF.INC}
  18.  
  19. {$IFDEF VER_CB}
  20.   {$ObjExportAll On}
  21. {$ENDIF}
  22.  
  23. unit BoxDsgn;
  24.  
  25. interface
  26. uses
  27.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus,
  28.   ComCtrls, DsgnIntf, {$IFDEF VER_VCL4} {DsnConst, ColnEdit,} {$ENDIF} Boxes;
  29.  
  30. type
  31.   TBoxCustomModule = class(TCustomModule)
  32.   public
  33. {$IFDEF VER_VCL4}
  34.     procedure ValidateComponent(Component:IComponent); override;
  35. {$ELSE}
  36.     procedure ValidateComponent(Component:TComponent); override;
  37. {$ENDIF}
  38.   end;
  39.  
  40.   TToolBarBoxCustomModule = class(TBoxCustomModule)
  41.   public
  42.     procedure ExecuteVerb(Index:integer); override;
  43.     function getVerb(Index:integer):string; override;
  44.     function getVerbCount:integer; override;
  45.   end;
  46.  
  47. procedure Register;
  48.  
  49. resourcestring
  50.   sErrorCreateComponent = 'Component can not be added to a box';
  51.   SNewBtn = 'New &Button';
  52.   SNewSpr = 'New Se¶tor';
  53.   SNewDiv = 'New &Divider';
  54.   SNewBtnName = 'TBoxToolButton';
  55.  
  56. const
  57.   ToolBarBoxVerbs: array[0..2] of string = (SNewBtn, SNewSpr, SNewDiv);
  58.  
  59. implementation
  60.  
  61. { TBoxCustomModule }
  62.  
  63. {$IFDEF VER_VCL4}
  64. procedure TBoxCustomModule.ValidateComponent(Component:IComponent);
  65. {$ELSE}
  66. procedure TBoxCustomModule.ValidateComponent(Component:TComponent);
  67. {$ENDIF}
  68. begin
  69. {$IFDEF VER_VCL4}
  70.   if ExtractComponent(Component) is TMainMenu then
  71. {$ELSE}
  72.   if Component is TMainMenu then
  73. {$ENDIF}
  74.     raise Exception.Create(sErrorCreateComponent)
  75. end;
  76.  
  77. { TToolBarBoxCustomModule }
  78.  
  79. procedure TToolBarBoxCustomModule.ExecuteVerb(Index:integer);
  80. var
  81.   ToolBar: TToolBar;
  82.   Button: TToolButton;
  83.   LastButton: TToolButton;
  84.   {$IFNDEF VER_VCL4}
  85.   Designer: TFormDesigner;
  86.   {$ELSE}
  87.   Designer: IFormDesigner;
  88.   {$ENDIF}
  89.   i: integer;
  90. begin
  91.   {$IFNDEF VER_VCL4}
  92.   if Root is TToolButton then
  93.     ToolBar := TToolBar(TToolButton(Root).Parent) else
  94.     ToolBar := TToolBar(Root);
  95.   {$ELSE}
  96.   if ExtractComponent(Root) is TToolButton then
  97.     ToolBar := TToolBar(TToolButton(ExtractComponent(Root)).Parent) else
  98.     ToolBar := TToolBar(ExtractComponent(Root));
  99.   {$ENDIF}
  100.   if ToolBar <> nil then
  101.   begin
  102.     {$IFNDEF VER_VCL4}
  103.     Designer := TFormDesigner(TCustomForm(ToolBar.Parent).Designer);
  104.     {$ELSE}
  105.     Designer := IFormDesigner(TCustomForm(ToolBar.Parent).Designer);
  106.    {$ENDIF}
  107.     LastButton := nil;
  108.     for i := ToolBar.ButtonCount - 1 downto 0 do
  109.       if TControl(ToolBar.Buttons[I]) is TToolButton then
  110.       begin
  111.         LastButton := TToolButton(ToolBar.Buttons[I]);
  112.         Break;
  113.       end;
  114.     Button := TToolButton.Create(ToolBar);
  115.     try
  116.       Button.Name := Designer.UniqueName(TToolButton.ClassName);
  117.       case Index of
  118.         0 : begin
  119.               Button.Style:=tbsButton;
  120.               Button.Hint := Button.Caption;
  121.               if Assigned(LastButton) then
  122.                 if LastButton.Style = tbsSeparator then
  123.                   Button.ImageIndex := LastButton.ImageIndex
  124.                 else
  125.                   Button.ImageIndex := LastButton.ImageIndex + 1;
  126.             end;
  127.         1 : begin
  128.               Button.Style:=tbsSeparator;
  129.               Button.Width:=8;
  130.               if Assigned(LastButton) then
  131.                 Button.ImageIndex := LastButton.ImageIndex + 1;
  132.             end;
  133.         2 : begin
  134.               Button.Style:=tbsDivider;
  135.               Button.Width:=16;
  136.               if Assigned(LastButton) then
  137.                 if LastButton.Style = tbsSeparator then
  138.                   Button.ImageIndex := LastButton.ImageIndex
  139.                 else
  140.                   Button.ImageIndex := LastButton.ImageIndex + 1;
  141.             end;
  142.       end;
  143.       if Assigned(LastButton) then
  144.         Button.Left := LastButton.Left+LastButton.Width+1;
  145.       Button.Parent := ToolBar;
  146.     except
  147.       Button.Free;
  148.       raise;
  149.     end;
  150.     Designer.SelectComponent(Button);
  151.     Designer.Modified;
  152.   end;
  153. end;
  154.  
  155. function TToolBarBoxCustomModule.getVerb(Index:integer):string;
  156. begin
  157.   Result := ToolBarBoxVerbs[Index];
  158. end;
  159.  
  160. function TToolBarBoxCustomModule.getVerbCount:integer;
  161. begin
  162.   Result := High(ToolBarBoxVerbs) + 1;
  163. end;
  164.  
  165. { Register }
  166.  
  167. procedure Register;
  168. begin
  169.   RegisterCustomModule(TBox, TBoxCustomModule);
  170.   RegisterCustomModule(TControlGroupBox, TBoxCustomModule);
  171.   RegisterCustomModule(TControlScrollBox, TBoxCustomModule);
  172.   RegisterCustomModule(TToolBarBox, TToolBarBoxCustomModule);
  173. end;
  174.  
  175. end.
  176.