home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / CompositeComponentsPack / SOURCE / BoxFixEd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-12  |  7.6 KB  |  254 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. {$WARNINGS OFF}
  18. {$I BOXDEF.INC}
  19.  
  20. {$IFDEF VER_CB}
  21.   {$ObjExportAll On}
  22. {$ENDIF}
  23.  
  24. unit BoxFixEd;
  25.  
  26. interface
  27. uses
  28.   DsgnIntf, Classes, Boxes, BoxDsgn;
  29.  
  30. procedure Register;
  31.  
  32. implementation
  33.  
  34. uses
  35.   SysUtils, Graphics, Menus, Forms, Controls, Dialogs, Buttons, StdCtrls,
  36.   ComCtrls;
  37.  
  38. { TNewActivePageProperty }
  39. type
  40.   TNewActivePageProperty = class(TComponentProperty)
  41.   public
  42.     function GetAttributes: TPropertyAttributes; override;
  43.     procedure GetValues(Proc: TGetStrProc); override;
  44.   end;
  45.  
  46. function TNewActivePageProperty.GetAttributes: TPropertyAttributes;
  47. begin
  48.   Result := [paValueList];
  49. end;
  50.  
  51. procedure TNewActivePageProperty.GetValues(Proc: TGetStrProc);
  52. var
  53.   I: Integer;
  54.   Component: TComponent;
  55. begin
  56.   for I := 0 to {*** bug: Designer.Form}TControl(GetComponent(0)).Owner.ComponentCount - 1 do //*** fixed
  57.   begin
  58.     Component := {*** bug: Designer.Form}TControl(GetComponent(0)).Owner.Components[I]; //*** fixed
  59.     if (Component.Name <> '') and (Component is TTabSheet) and
  60.       (TTabSheet(Component).PageControl = GetComponent(0)) then
  61.       Proc(Component.Name);
  62.   end;
  63. end;
  64.  
  65. { TNewPageControlEditor }
  66. type
  67.   TNewPageControlEditor = class(TDefaultEditor)
  68.     procedure ExecuteVerb(Index: Integer); override;
  69.     function GetVerb(Index: Integer): string; override;
  70.     function GetVerbCount: Integer; override;
  71.   end;
  72.  
  73. resourcestring
  74.   SNewPage = 'Ne&w Page';
  75.   SNextPage = 'Ne&xt Page';
  76.   SPrevPage = '&Previous Page';
  77.  
  78. const
  79.   PageControlVerbs: array[0..2] of string = (SNewPage, SNextPage, SPrevPage);
  80.  
  81. procedure TNewPageControlEditor.ExecuteVerb(Index: Integer);
  82. var
  83.   PageControl: TPageControl;
  84.   Page: TTabSheet;
  85.   {$IFDEF VER_VCL4}
  86.   Designer: IFormDesigner;
  87.   {$ELSE}
  88.   Designer: TFormDesigner;
  89.   {$ENDIF}
  90. begin
  91.   if Component is TTabSheet then
  92.     PageControl := TTabSheet(Component).PageControl else
  93.     PageControl := TPageControl(Component);
  94.   if PageControl <> nil then
  95.   begin
  96.     Designer := Self.Designer;
  97.     if Index = 0 then
  98.     begin
  99.       Page := TTabSheet.Create(Component.Owner); //*** fixed
  100.       try
  101.         Page.Name := Designer.UniqueName(TTabSheet.ClassName);
  102.         Page.Parent := PageControl;
  103.         Page.PageControl := PageControl;
  104.       except
  105.         Page.Free;
  106.         raise;
  107.       end;
  108.       PageControl.ActivePage := Page;
  109.       Designer.SelectComponent(Page);
  110.       Designer.Modified;
  111.     end else
  112.     begin
  113.       Page := PageControl.FindNextPage(PageControl.ActivePage,
  114.         Index = 1, False);
  115.       if (Page <> nil) and (Page <> PageControl.ActivePage) then
  116.       begin
  117.         PageControl.ActivePage := Page;
  118.         if Component is TTabSheet then Designer.SelectComponent(Page);
  119.         Designer.Modified;
  120.       end;
  121.     end;
  122.   end;
  123. end;
  124.  
  125. function TNewPageControlEditor.GetVerb(Index: Integer): string;
  126. begin
  127.   Result := PageControlVerbs[Index];
  128. end;
  129.  
  130. function TNewPageControlEditor.GetVerbCount: Integer;
  131. begin
  132.   Result := High(PageControlVerbs) + 1;
  133. end;
  134.  
  135. { TNewToolBarEditor }
  136. type
  137.   TNewToolBarEditor = class(TDefaultEditor)
  138.     procedure ExecuteVerb(Index: Integer); override;
  139.     function GetVerb(Index: Integer): string; override;
  140.     function GetVerbCount: Integer; override;
  141.   end;
  142.  
  143. procedure TNewToolBarEditor.ExecuteVerb(Index: Integer);
  144. var
  145.   ToolBar: TToolBar;
  146.   Button: TToolButton;
  147.   LastButton: TToolButton;
  148.   {$IFDEF VER_VCL4}
  149.   Designer: IFormDesigner;
  150.   {$ELSE}
  151.   Designer: TFormDesigner;
  152.   {$ENDIF}
  153.   i : integer;
  154. begin
  155.   if Component is TToolButton then
  156.     ToolBar := TToolBar(TToolButton(Component).Parent) else
  157.     ToolBar := TToolBar(Component);
  158.   if ToolBar <> nil then
  159.   begin
  160.     Designer := Self.Designer;
  161.     LastButton := nil;
  162.     for i := ToolBar.ButtonCount - 1 downto 0 do
  163.       if TControl(ToolBar.Buttons[I]) is TToolButton then
  164.       begin
  165.         LastButton := TToolButton(ToolBar.Buttons[I]);
  166.         Break;
  167.       end;
  168.     Button := TToolButton.Create(Component.Owner); //*** fixed
  169.     try
  170.       Button.Name := Designer.UniqueName(TToolButton.ClassName);
  171.       case Index of
  172.         0 : begin
  173.               Button.Style:=tbsButton;
  174.               Button.Hint := Button.Caption;
  175.               if Assigned(LastButton) then
  176.                 if LastButton.Style = tbsSeparator then
  177.                   Button.ImageIndex := LastButton.ImageIndex
  178.                 else
  179.                   Button.ImageIndex := LastButton.ImageIndex + 1;
  180.             end;
  181.         1 : begin
  182.               Button.Style:=tbsSeparator;
  183.               Button.Width:=8;
  184.               if Assigned(LastButton) then
  185.                 Button.ImageIndex := LastButton.ImageIndex + 1;
  186.             end;
  187.         2 : begin
  188.               Button.Style:=tbsDivider;
  189.               Button.Width:=16;              
  190.               if Assigned(LastButton) then
  191.                 if LastButton.Style = tbsSeparator then
  192.                   Button.ImageIndex := LastButton.ImageIndex
  193.                 else
  194.                   Button.ImageIndex := LastButton.ImageIndex + 1;
  195.             end;
  196.       end;
  197.       if Assigned(LastButton) then
  198.         Button.Left := LastButton.Left+LastButton.Width+1;
  199.       Button.Parent := ToolBar;
  200.     except
  201.       Button.Free;
  202.       raise;
  203.     end;
  204.     Designer.SelectComponent(Button);
  205.     Designer.Modified;
  206.   end;
  207. end;
  208.  
  209. function TNewToolBarEditor.GetVerb(Index: Integer): string;
  210. begin
  211.   Result := ToolBarBoxVerbs[Index];
  212. end;
  213.  
  214. function TNewToolBarEditor.GetVerbCount: Integer;
  215. begin
  216.   if (Component is TToolButton) and (TToolButton(Component).Parent is TToolBarBox) then
  217.     Result:=0
  218.   else
  219.     Result := High(ToolBarBoxVerbs) + 1;
  220. end;
  221.  
  222. { TDesignAlignProperty }
  223. type
  224.   TDesignAlignProperty = class(TEnumProperty)
  225.   public
  226.     function GetAttributes: TPropertyAttributes; override;
  227.     procedure GetValues(Proc: TGetStrProc); override;
  228.   end;
  229.  
  230. function TDesignAlignProperty.GetAttributes: TPropertyAttributes;
  231. begin
  232.   Result := [paValueList];
  233. end;
  234.  
  235. procedure TDesignAlignProperty.GetValues(Proc: TGetStrProc);
  236. begin
  237.   if (TControl(GetComponent(0)).Parent<>nil) and (TControl(GetComponent(0)).Parent.ClassName='TWinControlForm') then
  238.     Proc('alTop')  //*** fix for the design window behaviour for the WinControl's custom modules with Align<>alTop 
  239.   else
  240.     inherited GetValues(Proc);
  241. end;
  242.  
  243. procedure Register;
  244. begin
  245.   RegisterComponentEditor(TPageControl, TNewPageControlEditor);
  246.   RegisterComponentEditor(TTabSheet, TNewPageControlEditor);
  247.   RegisterPropertyEditor(TypeInfo(TTabSheet), TPageControl, 'ActivePage', TNewActivePageProperty);
  248.   RegisterComponentEditor(TToolBar, TNewToolBarEditor);
  249.   RegisterComponentEditor(TToolButton, TNewToolBarEditor);
  250.   RegisterPropertyEditor(TypeInfo(TAlign), TToolBarBox, 'Align', TDesignAlignProperty);
  251. end;
  252.  
  253. end.
  254.