home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / CompositeComponentsPack / SOURCE / Boxes.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-12  |  14.8 KB  |  617 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 Boxes;
  24.  
  25. {$C PRELOAD}
  26.  
  27. interface
  28.  
  29. uses
  30.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  31.   Forms, Dialogs, ExtCtrls, StdCtrls, ComCtrls, ToolWin;
  32.  
  33. type
  34.   TBox = class(TCustomPanel)
  35.   private
  36.     FOnCreate: TNotifyEvent;
  37.     FOnDestroy: TNotifyEvent;
  38.   protected
  39.     procedure Paint; override;
  40.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  41.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  42.     property Align;
  43.     property Caption;
  44.   public
  45.     constructor Create(AOwner:TComponent); override;
  46.     destructor Destroy; override;
  47.     {$IFDEF VER_VCL4}
  48.     property DockManager;
  49.     {$ENDIF}
  50.   published
  51.     property Alignment;
  52.     {$IFDEF VER_VCL4}
  53.     property Anchors;
  54.     {$ENDIF}
  55.     property BevelInner;
  56.     property BevelOuter;
  57.     property BevelWidth;
  58.     {$IFDEF VER_VCL4}
  59.     property BiDiMode;
  60.     {$ENDIF}
  61.     property BorderWidth;
  62.     property BorderStyle;
  63.     {$IFDEF VER_VCL4}
  64.     property DockSite;
  65.     {$ENDIF}
  66.     property DragCursor;
  67.     {$IFDEF VER_VCL4}
  68.     property DragKind;
  69.     {$ENDIF}
  70.     property DragMode;
  71.     property Enabled;
  72.     property FullRepaint;
  73.     property Color;
  74.     {$IFDEF VER_VCL4}
  75.     property Constraints;
  76.     {$ENDIF}
  77.     property Ctl3D;
  78.     {$IFDEF VER_VCL4}
  79.     property UseDockManager default True;
  80.     {$ENDIF}
  81.     property Font;
  82.     property Locked;
  83.     {$IFDEF VER_VCL4}
  84.     property ParentBiDiMode;
  85.     {$ENDIF}
  86.     property ParentColor;
  87.     property ParentCtl3D;
  88.     property ParentFont;
  89.     property ParentShowHint;
  90.     property PopupMenu;
  91.     property ShowHint;
  92.     property TabOrder;
  93.     property TabStop;
  94.     property Visible;
  95.     property OnClick;
  96.     {$IFDEF VER_VCL4}
  97.     property OnConstrainedResize;
  98.     property OnDockDrop;
  99.     property OnDockOver;
  100.     {$ENDIF}
  101.     property OnDblClick;
  102.     property OnDragDrop;
  103.     property OnDragOver;
  104.     {$IFDEF VER_VCL4}
  105.     property OnEndDock;
  106.     {$ENDIF}
  107.     property OnEndDrag;
  108.     property OnEnter;
  109.     property OnExit;
  110.     {$IFDEF VER_VCL4}
  111.     property OnGetSiteInfo;
  112.     {$ENDIF}
  113.     property OnMouseDown;
  114.     property OnMouseMove;
  115.     property OnMouseUp;
  116.     property OnResize;
  117.     {$IFDEF VER_VCL4}
  118.     property OnStartDock;
  119.     {$ENDIF}
  120.     property OnStartDrag;
  121.     {$IFDEF VER_VCL4}
  122.     property OnUnDock;
  123.     {$ENDIF}
  124.     property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
  125.     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  126.   end;
  127.  
  128.   TControlGroupBox = class(TCustomGroupBox)
  129.   private
  130.     FOnCreate: TNotifyEvent;
  131.     FOnDestroy: TNotifyEvent;
  132.   protected
  133.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  134.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  135.     property Align;
  136.   public
  137.     constructor Create(AOwner:TComponent); override;
  138.     destructor Destroy; override;
  139.   published
  140.     {$IFDEF VER_VCL4}
  141.     property Anchors;
  142.     property BiDiMode;
  143.     {$ENDIF}
  144.     property Caption;
  145.     property Color;
  146.     {$IFDEF VER_VCL4}
  147.     property Constraints;
  148.     {$ENDIF}
  149.     property Ctl3D;
  150.     {$IFDEF VER_VCL4}
  151.     property DockSite;
  152.     {$ENDIF}
  153.     property DragCursor;
  154.     {$IFDEF VER_VCL4}
  155.     property DragKind;
  156.     {$ENDIF}
  157.     property DragMode;
  158.     property Enabled;
  159.     property Font;
  160.     {$IFDEF VER_VCL4}
  161.     property ParentBiDiMode;
  162.     {$ENDIF}
  163.     property ParentColor;
  164.     property ParentCtl3D;
  165.     property ParentFont;
  166.     property ParentShowHint;
  167.     property PopupMenu;
  168.     property ShowHint;
  169.     property TabOrder;
  170.     property TabStop;
  171.     property Visible;
  172.     property OnClick;
  173.     property OnDblClick;
  174.     property OnDragDrop;
  175.     {$IFDEF VER_VCL4}
  176.     property OnDockDrop;
  177.     property OnDockOver;
  178.     {$ENDIF}
  179.     property OnDragOver;
  180.     {$IFDEF VER_VCL4}
  181.     property OnEndDock;
  182.     {$ENDIF}
  183.     property OnEndDrag;
  184.     property OnEnter;
  185.     property OnExit;
  186.     {$IFDEF VER_VCL4}
  187.     property OnGetSiteInfo;
  188.     {$ENDIF}
  189.     property OnMouseDown;
  190.     property OnMouseMove;
  191.     property OnMouseUp;
  192.     {$IFDEF VER_VCL4}
  193.     property OnResize;
  194.     property OnStartDock;
  195.     {$ENDIF}
  196.     property OnStartDrag;
  197.     {$IFDEF VER_VCL4}
  198.     property OnUnDock;
  199.     {$ENDIF}
  200.     property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
  201.     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  202.   end;
  203.  
  204.   TControlScrollBox = class(TScrollBox)
  205.   private
  206.     FOnCreate: TNotifyEvent;
  207.     FOnDestroy: TNotifyEvent;
  208.   protected
  209.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  210.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  211.   public
  212.     constructor Create(AOwner:TComponent); override;
  213.     destructor Destroy; override;
  214.   published
  215.     property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
  216.     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  217.   end;
  218.  
  219.   TToolBarBox = class(TToolBar)
  220.   private
  221.     FOnCreate: TNotifyEvent;
  222.     FOnDestroy: TNotifyEvent;
  223.   protected
  224.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  225.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  226.   public
  227.     constructor Create(AOwner:TComponent); override;
  228.     destructor Destroy; override;
  229.   published
  230.     property EdgeBorders default [];
  231.     property Wrapable default False;
  232.     property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
  233.     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  234.   end;
  235.  
  236.  
  237. function IsCompositeDesign(const AControl: TControl): boolean;
  238.  
  239. implementation
  240.  
  241. resourcestring
  242.   sResNotFound = 'Resource for %s is not found.';
  243.   sCompositeDesignWindow = 'TWinControlForm';
  244.  
  245. function IsCompositeDesign(const AControl: TControl): boolean;
  246. begin
  247.   Result:=(AControl.Owner.ClassName=sCompositeDesignWindow);
  248. end;
  249.  
  250. { TBox }
  251.  
  252. constructor TBox.Create(AOwner:TComponent);
  253. begin
  254.   {$IFDEF VER_VCL4}
  255.   GlobalNameSpace.BeginWrite;
  256.   try
  257.   {$ENDIF}
  258.     inherited Create(AOwner);
  259.     if AOwner is TWinControl then
  260.       Parent:=AOwner as TWinControl;
  261.     if (ClassType<>TBox) then
  262.     begin
  263.       if not InitInheritedComponent(Self, TBox) then
  264.         raise EResNotFound.CreateFmt(sResNotFound, [ClassName]);
  265.       if Assigned(FOnCreate) then
  266.       try
  267.         FOnCreate(Self);
  268.       except
  269.         Application.HandleException(Self);
  270.       end;
  271.     end;
  272.   {$IFDEF VER_VCL4}
  273.   finally
  274.     GlobalNameSpace.EndWrite;
  275.   end;
  276.   {$ENDIF}
  277. end;
  278.  
  279. destructor TBox.Destroy;
  280. begin
  281.   if Assigned(FOnDestroy) then
  282.   try
  283.     FOnDestroy(Self);
  284.   except
  285.     Application.HandleException(Self);
  286.   end;
  287.   inherited Destroy;
  288. end;
  289.  
  290. procedure TBox.Paint;
  291. var
  292.   Rect: TRect;
  293.   TopColor, BottomColor: TColor;
  294. const
  295.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  296.  
  297.   procedure AdjustColors(Bevel: TPanelBevel);
  298.   begin
  299.     TopColor := clBtnHighlight;
  300.     if Bevel = bvLowered then TopColor := clBtnShadow;
  301.     BottomColor := clBtnShadow;
  302.     if Bevel = bvLowered then BottomColor := clBtnHighlight;
  303.   end;
  304.  
  305. begin
  306.   Rect := GetClientRect;
  307.   if BevelOuter <> bvNone then
  308.   begin
  309.     AdjustColors(BevelOuter);
  310.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  311.   end;
  312.   Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  313.   if BevelInner <> bvNone then
  314.   begin
  315.     AdjustColors(BevelInner);
  316.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  317.   end;
  318.   with Canvas do
  319.   begin
  320.     Brush.Color := Color;
  321.     FillRect(Rect);
  322.     Brush.Style := bsClear;
  323.     Font := Self.Font;
  324.   end;
  325. end;
  326.  
  327. procedure TBox.GetChildren(Proc: TGetChildProc; Root: TComponent);
  328. var
  329.   I: Integer;
  330.   OwnedComponent: TComponent;
  331. begin
  332.   inherited GetChildren(Proc, Root);
  333.   if Root = Self then
  334.   begin
  335.     for I := 0 to ComponentCount - 1 do
  336.     begin
  337.       OwnedComponent := Components[I];
  338.       if not OwnedComponent.HasParent then Proc(OwnedComponent);
  339.     end;
  340.   end;
  341. end;
  342.  
  343. procedure TBox.SetChildOrder(Child: TComponent; Order: Integer);
  344. var
  345.   I, J: Integer;
  346. begin
  347.   if Child is TControl then
  348.     inherited SetChildOrder(Child, Order)
  349.   else
  350.   begin
  351.     Dec(Order, ControlCount);
  352.     J := -1;
  353.     for I := 0 to ComponentCount - 1 do
  354.       if not Components[I].HasParent then
  355.       begin
  356.         Inc(J);
  357.         if J = Order then
  358.         begin
  359.           Child.ComponentIndex := I;
  360.           Exit;
  361.         end;
  362.       end;
  363.   end;
  364. end;
  365.  
  366. { TControlGroupBox }
  367.  
  368. constructor TControlGroupBox.Create(AOwner:TComponent);
  369. begin
  370.   {$IFDEF VER_VCL4}
  371.   GlobalNameSpace.BeginWrite;
  372.   try
  373.   {$ENDIF}
  374.     inherited Create(AOwner);
  375.     if AOwner is TWinControl then
  376.       Parent:=AOwner as TWinControl;
  377.     if (ClassType<>TControlGroupBox) then
  378.     begin
  379.       if not InitInheritedComponent(Self, TControlGroupBox) then
  380.         raise EResNotFound.CreateFmt(sResNotFound, [ClassName]);
  381.       if Assigned(FOnCreate) then
  382.       try
  383.         FOnCreate(Self);
  384.       except
  385.         Application.HandleException(Self);
  386.       end;
  387.     end;
  388.   {$IFDEF VER_VCL4}
  389.   finally
  390.     GlobalNameSpace.EndWrite;
  391.   end;
  392.   {$ENDIF}
  393. end;
  394.  
  395. destructor TControlGroupBox.Destroy;
  396. begin
  397.   if Assigned(FOnDestroy) then
  398.   try
  399.     FOnDestroy(Self);
  400.   except
  401.     Application.HandleException(Self);
  402.   end;
  403.   inherited Destroy;
  404. end;
  405.  
  406. procedure TControlGroupBox.GetChildren(Proc: TGetChildProc; Root: TComponent);
  407. var
  408.   I: Integer;
  409.   OwnedComponent: TComponent;
  410. begin
  411.   inherited GetChildren(Proc, Root);
  412.   if Root = Self then
  413.   begin
  414.     for I := 0 to ComponentCount - 1 do
  415.     begin
  416.       OwnedComponent := Components[I];
  417.       if not OwnedComponent.HasParent then Proc(OwnedComponent);
  418.     end;
  419.   end;
  420. end;
  421.  
  422. procedure TControlGroupBox.SetChildOrder(Child: TComponent; Order: Integer);
  423. var
  424.   I, J: Integer;
  425. begin
  426.   if Child is TControl then
  427.     inherited SetChildOrder(Child, Order)
  428.   else
  429.   begin
  430.     Dec(Order, ControlCount);
  431.     J := -1;
  432.     for I := 0 to ComponentCount - 1 do
  433.       if not Components[I].HasParent then
  434.       begin
  435.         Inc(J);
  436.         if J = Order then
  437.         begin
  438.           Child.ComponentIndex := I;
  439.           Exit;
  440.         end;
  441.       end;
  442.   end;
  443. end;
  444.  
  445. { TControlScrollBox }
  446.  
  447. constructor TControlScrollBox.Create(AOwner:TComponent);
  448. begin
  449.   {$IFDEF VER_VCL4}
  450.   GlobalNameSpace.BeginWrite;
  451.   try
  452.   {$ENDIF}
  453.     inherited Create(AOwner);
  454.     if AOwner is TWinControl then
  455.       Parent:=AOwner as TWinControl;
  456.     if (ClassType<>TControlScrollBox) then
  457.     begin
  458.       if not InitInheritedComponent(Self, TControlScrollBox) then
  459.         raise EResNotFound.CreateFmt(sResNotFound, [ClassName]);
  460.       if Assigned(FOnCreate) then
  461.       try
  462.         FOnCreate(Self);
  463.       except
  464.         Application.HandleException(Self);
  465.       end;
  466.     end;
  467.   {$IFDEF VER_VCL4}
  468.   finally
  469.     GlobalNameSpace.EndWrite;
  470.   end;
  471.   {$ENDIF}
  472. end;
  473.  
  474. destructor TControlScrollBox.Destroy;
  475. begin
  476.   if Assigned(FOnDestroy) then
  477.   try
  478.     FOnDestroy(Self);
  479.   except
  480.     Application.HandleException(Self);
  481.   end;
  482.   inherited Destroy;
  483. end;
  484.  
  485. procedure TControlScrollBox.GetChildren(Proc: TGetChildProc; Root: TComponent);
  486. var
  487.   I: Integer;
  488.   OwnedComponent: TComponent;
  489. begin
  490.   inherited GetChildren(Proc, Root);
  491.   if Root = Self then
  492.   begin
  493.     for I := 0 to ComponentCount - 1 do
  494.     begin
  495.       OwnedComponent := Components[I];
  496.       if not OwnedComponent.HasParent then Proc(OwnedComponent);
  497.     end;
  498.   end;
  499. end;
  500.  
  501. procedure TControlScrollBox.SetChildOrder(Child: TComponent; Order: Integer);
  502. var
  503.   I, J: Integer;
  504. begin
  505.   if Child is TControl then
  506.     inherited SetChildOrder(Child, Order)
  507.   else
  508.   begin
  509.     Dec(Order, ControlCount);
  510.     J := -1;
  511.     for I := 0 to ComponentCount - 1 do
  512.       if not Components[I].HasParent then
  513.       begin
  514.         Inc(J);
  515.         if J = Order then
  516.         begin
  517.           Child.ComponentIndex := I;
  518.           Exit;
  519.         end;
  520.       end;
  521.   end;
  522. end;
  523.  
  524. { TToolBarBox }
  525.  
  526. constructor TToolBarBox.Create(AOwner:TComponent);
  527. begin
  528.   {$IFDEF VER_VCL4}
  529.   GlobalNameSpace.BeginWrite;
  530.   try
  531.   {$ENDIF}
  532.     inherited Create(AOwner);
  533.     if AOwner is TWinControl then
  534.       Parent:=AOwner as TWinControl;
  535.     EdgeBorders:=[];
  536.     Wrapable:=False;
  537.     if (ClassType<>TToolBarBox) then
  538.     begin
  539.       if not InitInheritedComponent(Self, TToolBarBox) then
  540.         raise EResNotFound.CreateFmt(sResNotFound, [ClassName]);
  541.       if Assigned(FOnCreate) then
  542.       try
  543.         FOnCreate(Self);
  544.       except
  545.         Application.HandleException(Self);
  546.       end;
  547.     end;
  548.   {$IFDEF VER_VCL4}
  549.   finally
  550.     GlobalNameSpace.EndWrite;
  551.   end;
  552.   {$ENDIF}
  553. end;
  554.  
  555. destructor TToolBarBox.Destroy;
  556. begin
  557.   if Assigned(FOnDestroy) then
  558.   try
  559.     FOnDestroy(Self);
  560.   except
  561.     Application.HandleException(Self);
  562.   end;
  563.   inherited Destroy;
  564. end;
  565.  
  566. procedure TToolBarBox.GetChildren(Proc: TGetChildProc; Root: TComponent);
  567. var
  568.   I: Integer;
  569.   OwnedComponent: TComponent;
  570.   Control: TControl;
  571. begin
  572.   if Root = Self then
  573.     begin
  574.       for I := 0 to ComponentCount - 1 do
  575.       begin
  576.         OwnedComponent := Components[I];
  577.         if not OwnedComponent.HasParent then Proc(OwnedComponent);
  578.       end;
  579.       inherited GetChildren(Proc, Root);
  580.     end
  581.   else
  582.     for I := 0 to ControlCount - 1 do
  583.     begin
  584.       Control := Controls[I];
  585.       if (Control.Owner = Root) then Proc(Control);
  586.     end;
  587. end;
  588.  
  589. procedure TToolBarBox.SetChildOrder(Child: TComponent; Order: Integer);
  590. var
  591.   I, J: Integer;
  592. begin
  593.   if Child is TControl then
  594.     inherited SetChildOrder(Child, Order)
  595.   else
  596.   begin
  597.     Dec(Order, ControlCount);
  598.     J := -1;
  599.     for I := 0 to ComponentCount - 1 do
  600.       if not Components[I].HasParent then
  601.       begin
  602.         Inc(J);
  603.         if J = Order then
  604.         begin
  605.           Child.ComponentIndex := I;
  606.           Exit;
  607.         end;
  608.       end;
  609.   end;
  610. end;
  611.  
  612. end.
  613.  
  614.  
  615.  
  616.  
  617.