home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / VCL / TOOLWIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  4.4 KB  |  153 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit ToolWin;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Windows, Messages, Classes, Controls, Forms;
  17.  
  18. type
  19.  
  20. { TToolWindow }
  21.  
  22.   TEdgeBorder = (ebLeft, ebTop, ebRight, ebBottom);
  23.   TEdgeBorders = set of TEdgeBorder;
  24.  
  25.   TEdgeStyle = (esNone, esRaised, esLowered);
  26.  
  27.   TToolWindow = class(TWinControl)
  28.   private
  29.     FBorderWidth: Integer;
  30.     FEdgeBorders: TEdgeBorders;
  31.     FEdgeInner: TEdgeStyle;
  32.     FEdgeOuter: TEdgeStyle;
  33.     procedure SetBorderWidth(Value: Integer);
  34.     procedure SetEdgeBorders(Value: TEdgeBorders);
  35.     procedure SetEdgeInner(Value: TEdgeStyle);
  36.     procedure SetEdgeOuter(Value: TEdgeStyle);
  37.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  38.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  39.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  40.   public
  41.     constructor Create(AOwner: TComponent); override;
  42.     property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 0;
  43.     property EdgeBorders: TEdgeBorders read FEdgeBorders write SetEdgeBorders default [ebLeft, ebTop, ebRight, ebBottom];
  44.     property EdgeInner: TEdgeStyle read FEdgeInner write SetEdgeInner default esRaised;
  45.     property EdgeOuter: TEdgeStyle read FEdgeOuter write SetEdgeOuter default esLowered;
  46.   end;
  47.  
  48. implementation
  49.  
  50. { TToolWindow }
  51.  
  52. constructor TToolWindow.Create(AOwner: TComponent);
  53. begin
  54.   inherited Create(AOwner);
  55.   FEdgeBorders := [ebLeft, ebTop, ebRight, ebBottom];
  56.   FEdgeInner := esRaised;
  57.   FEdgeOuter := esLowered;
  58. end;
  59.  
  60. procedure TToolWindow.SetBorderWidth(Value: Integer);
  61. begin
  62.   if FBorderWidth <> Value then
  63.   begin
  64.     FBorderWidth := Value;
  65.     RecreateWnd;
  66.   end;
  67. end;
  68.  
  69. procedure TToolWindow.SetEdgeBorders(Value: TEdgeBorders);
  70. begin
  71.   if FEdgeBorders <> Value then
  72.   begin
  73.     FEdgeBorders := Value;
  74.     RecreateWnd;
  75.   end;
  76. end;
  77.  
  78. procedure TToolWindow.SetEdgeInner(Value: TEdgeStyle);
  79. begin
  80.   if FEdgeInner <> Value then
  81.   begin
  82.     FEdgeInner := Value;
  83.     RecreateWnd;
  84.   end;
  85. end;
  86.  
  87. procedure TToolWindow.SetEdgeOuter(Value: TEdgeStyle);
  88. begin
  89.   if FEdgeOuter <> Value then
  90.   begin
  91.     FEdgeOuter := Value;
  92.     RecreateWnd;
  93.   end;
  94. end;
  95.  
  96. procedure TToolWindow.WMNCCalcSize(var Message: TWMNCCalcSize);
  97. var
  98.   EdgeSize: Integer;
  99. begin
  100.   with Message.CalcSize_Params^ do
  101.   begin
  102.     InflateRect(rgrc[0], -BorderWidth, -BorderWidth);
  103.     EdgeSize := 0;
  104.     if EdgeInner <> esNone then Inc(EdgeSize, 1);
  105.     if EdgeOuter <> esNone then Inc(EdgeSize, 1);
  106.     with rgrc[0] do
  107.     begin
  108.       if ebLeft in FEdgeBorders then Inc(Left, EdgeSize);
  109.       if ebTop in FEdgeBorders then Inc(Top, EdgeSize);
  110.       if ebRight in FEdgeBorders then Dec(Right, EdgeSize);
  111.       if ebBottom in FEdgeBorders then Dec(Bottom, EdgeSize);
  112.     end;
  113.   end;
  114.   inherited;
  115. end;
  116.  
  117. procedure TToolWindow.WMNCPaint(var Message: TMessage);
  118. const
  119.   InnerStyles: array[TEdgeStyle] of Integer = (0, BDR_RAISEDINNER, BDR_SUNKENINNER);
  120.   OuterStyles: array[TEdgeStyle] of Integer = (0, BDR_RAISEDOUTER, BDR_SUNKENOUTER);
  121.   Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);
  122. var
  123.   DC: HDC;
  124.   RC, RW: TRect;
  125. begin
  126.   { Get window DC that is clipped to the non-client area }
  127.   DC := GetWindowDC(Handle);
  128.   try
  129.     Windows.GetClientRect(Handle, RC);
  130.     GetWindowRect(Handle, RW);
  131.     MapWindowPoints(0, Handle, RW, 2);
  132.     OffsetRect(RC, -RW.Left, -RW.Top);
  133.     ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
  134.     { Draw borders in non-client area }
  135.     OffsetRect(RW, -RW.Left, -RW.Top);
  136.     DrawEdge(DC, RW, InnerStyles[FEdgeInner] or OuterStyles[FEdgeOuter],
  137.       Byte(FEdgeBorders) or Ctl3DStyles[Ctl3D] or BF_ADJUST);
  138.     { Erase parts not drawn }
  139.     IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
  140.     Windows.FillRect(DC, RW, Brush.Handle);
  141.   finally
  142.     ReleaseDC(Handle, DC);
  143.   end;
  144. end;
  145.  
  146. procedure TToolWindow.CMCtl3DChanged(var Message: TMessage);
  147. begin
  148.   inherited;
  149.   if FEdgeBorders <> [] then RecreateWnd;
  150. end;
  151.  
  152. end.
  153.