home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmToolWin.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  28KB  |  945 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmToolWin
  5. Purpose  : This is a alternate form for all forms that use the bsSizableToolWin
  6.            borderstyle.  This window does not suffer from the M$ ALT-Tab bug. 
  7. Date     : 04-29-2001
  8. Author   : Ryan J. Mills
  9. Version  : 1.80
  10. ================================================================================}
  11.  
  12. unit rmToolWin;
  13.  
  14. interface
  15.  
  16. {$I CompilerDefines.INC}
  17.  
  18. uses windows, messages, classes, forms, Graphics;
  19.  
  20. type
  21.    TMoveSize = (msEntered, msMoving, msSizing, msExited) ;
  22.  
  23.    TWMSizing = packed record
  24.       Msg: Cardinal;
  25.       SizingSide: Longint;
  26.       WindowRect: PRect;
  27.       Result: Longint;
  28.    end;
  29.    TWMMoving = TWMSizing;
  30.  
  31.    TrmCustomToolWinForm = class(TCustomForm)
  32.    private
  33.     { Private }
  34.       fInNCPaint: boolean;
  35.       fActive: boolean;
  36.       fMoveSize: TMoveSize;
  37.       fFrameRect, fLastFrameRect, FPosRect: TRect;
  38.       fCloseBtnDown, fCloseBtnPressed: boolean;
  39.       fOnMove: TNotifyEvent;
  40.       fWindowBMP: TBitmap;
  41.       fStandardMoving: boolean;
  42.  
  43.       function AdjustFormFrameRect(wRect: TRect) : TRect;
  44.       procedure wmEnterSizeMove(var msg: TMessage) ; message WM_ENTERSIZEMOVE;
  45.       procedure wmExitSizeMove(var msg: TMessage) ; message WM_EXITSIZEMOVE;
  46.       procedure wmMoving(var msg: TWMMoving) ; message WM_MOVING;
  47.       procedure wmSizing(var msg: TWMSizing) ; message WM_SIZING;
  48.       procedure wmMove(Var msg: TWMMove) ; message wm_move;
  49.       procedure wmWindowPosChanging(var msg: TWMWindowPosChanging) ; message WM_WINDOWPOSCHANGING;
  50.       procedure WMNCActivate(var Message: TWMNCActivate) ; message WM_NCActivate;
  51.       procedure WMNCCalcSize(var Message: TWMNCCalcSize) ; message WM_NCCALCSIZE;
  52.       procedure WMNCHitTest(var Message: TWMNCHitTest) ; message WM_NCHITTEST;
  53.       procedure WMNCPaint(var Message: TMessage) ; message WM_NCPAINT;
  54.       procedure WMNCLButtonDown(var Message: TWMNCLButtonDown) ; message WM_NCLBUTTONDOWN;
  55.       procedure WMNCLButtonUp(var Message: TWMNCLButtonUp) ; message WM_NCLBUTTONUP;
  56.       procedure WMNCMouseMove(var Message: TWMNCMouseMove) ; message WM_NCMOUSEMOVE;
  57.       procedure WMLButtonUp(var Message: TWMLButtonUp) ; message WM_LBUTTONUP;
  58.       procedure WMMouseMove(var Message: TWMMouseMove) ; message WM_MOUSEMOVE;
  59.       procedure WMKillFocus(var msg: TWMKillFocus) ; message WM_KillFocus;
  60.       procedure SetInternalFrameRect(const Value: TRect) ;
  61.       procedure setncactive(const Value: boolean);
  62.    protected
  63.     { Protected }
  64.       function FormCaptionRect(Screen: boolean) : TRect;
  65.       function FormCaptionTextRect(Screen: boolean) : TRect;
  66.       function FormBtnRect(Screen: boolean) : TRect;
  67.       function FormFrameRect(Screen: boolean) : TRect;
  68.       function FormClientRect(screen: boolean) : TRect;
  69.       property InternalFrameRect: TRect read fFrameRect write SetInternalFrameRect;
  70.       property OnMove: TNotifyEvent read fonMove write fOnMove;
  71.       property StandardMoving: boolean read fStandardMoving write fStandardMoving default true;
  72.       property MoveSize : TMoveSize read fMoveSize;
  73.       property NCActive : boolean read factive write setncactive;
  74.    public
  75.     { Public }
  76.       constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0) ; override;
  77.       destructor destroy; override;
  78.    end;
  79.  
  80.    TrmToolWinForm = class(TrmCustomToolWinForm)
  81.    published
  82.     { Published }
  83.       property Action;
  84.       property ActiveControl;
  85.       property Align;
  86.       property BiDiMode;
  87.       property BorderWidth;
  88.       property Caption;
  89.       property ClientHeight;
  90.       property ClientWidth;
  91.       property Color;
  92.       property Ctl3D;
  93.       property DefaultMonitor;
  94.       property Enabled;
  95.       property ParentFont default False;
  96.       property Font;
  97.       property Height;
  98.       property HelpFile;
  99.       property KeyPreview;
  100.       property Menu;
  101.       property OldCreateOrder;
  102.       property ParentBiDiMode;
  103.       property PixelsPerInch;
  104.       property PopupMenu;
  105.       property Position;
  106.       property PrintScale;
  107.       property Scaled;
  108.       property ShowHint;
  109.       property Visible;
  110.       property Width;
  111.       property OnActivate;
  112.       property OnCanResize;
  113.       property OnClick;
  114.       property OnClose;
  115.       property OnCloseQuery;
  116.       property OnContextPopup;
  117.       property OnCreate;
  118.       property OnDblClick;
  119.       property OnDestroy;
  120.       property OnDeactivate;
  121.       property OnDragDrop;
  122.       property OnDragOver;
  123.       property OnHide;
  124.       property OnHelp;
  125.       property OnKeyDown;
  126.       property OnKeyPress;
  127.       property OnKeyUp;
  128.       property OnMouseDown;
  129.       property OnMouseMove;
  130.       property OnMouseUp;
  131.       property OnMouseWheel;
  132.       property OnMouseWheelDown;
  133.       property OnMouseWheelUp;
  134.       property OnMove;
  135.       property OnPaint;
  136.       property OnResize;
  137.       property OnShortCut;
  138.       property OnShow;
  139.    end;
  140.  
  141. function WindowCaptionHeight: integer;
  142. function WindowButtonHeight: integer;
  143. function WindowButtonWidth: integer;
  144. function WindowBorderWidth: integer;
  145. function WindowBorderHeight: integer;
  146. function WindowUseGradientCaption: Boolean;
  147. function WindowCaptionFontName: string;
  148. function WindowCaptionFontSize: integer;
  149. function WindowCaptionFontStyle: TFontStyles;
  150.  
  151.  
  152. implementation
  153.  
  154. uses rmLibrary, ExtCtrls;
  155.  
  156. const
  157.    PenSize = 3;
  158.  
  159. var
  160.    NewBrush: TBrush;
  161.  
  162. function WindowCaptionHeight: integer;
  163. begin
  164.    result := GetSystemMetrics(SM_CYSMCAPTION) ; //Small Caption Height
  165. end;
  166.  
  167. function WindowButtonHeight: integer;
  168. begin
  169.    result := WindowCaptionHeight - 5;
  170. end;
  171.  
  172. function WindowButtonWidth: integer;
  173. begin
  174.    result := WindowButtonHeight + 2;
  175. end;
  176.  
  177. function WindowBorderWidth: integer;
  178. begin
  179.    result := GetSystemMetrics(SM_CXSIZEFRAME); //Sizeable Frame Width
  180. end;
  181.  
  182. function WindowBorderHeight: integer;
  183. begin
  184.    result := GetSystemMetrics(SM_CYSIZEFRAME); //Sizeable Frame Height
  185. end;
  186.  
  187. function WindowUseGradientCaption: Boolean;
  188. begin
  189.    SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, 0, @Result, 0) ;
  190. end;
  191.  
  192. function WindowCaptionFontName: string;
  193. var
  194.    wMetrics: TNONCLIENTMETRICS;
  195. begin
  196.    wMetrics.cbSize := sizeof(TNONCLIENTMETRICS) ;
  197.    SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(TNONCLIENTMETRICS) , @wMetrics, 0) ;
  198.    result := wMetrics.lfSmCaptionFont.lfFaceName;
  199. end;
  200.  
  201. function WindowCaptionFontSize: integer;
  202. var
  203.    wMetrics: TNONCLIENTMETRICS;
  204. begin
  205.    wMetrics.cbSize := sizeof(TNONCLIENTMETRICS) ;
  206.    SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(TNONCLIENTMETRICS) , @wMetrics, 0) ;
  207.    result := wMetrics.lfSmCaptionFont.lfHeight;
  208. end;
  209.  
  210. function WindowCaptionFontStyle: TFontStyles;
  211. var
  212.    wMetrics: TNONCLIENTMETRICS;
  213. begin
  214.    wMetrics.cbSize := sizeof(TNONCLIENTMETRICS) ;
  215.    SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(TNONCLIENTMETRICS) , @wMetrics, 0) ;
  216.  
  217.    result := [];
  218.  
  219.    if wMetrics.lfSmCaptionFont.lfWeight = fw_bold then
  220.       result := result + [fsbold];
  221.  
  222.    if wMetrics.lfSmCaptionFont.lfItalic > 0 then
  223.       result := result + [fsItalic];
  224.  
  225.    if wMetrics.lfSmCaptionFont.lfUnderline > 0 then
  226.       result := result + [fsUnderLine];
  227.  
  228.    if wMetrics.lfSmCaptionFont.lfStrikeOut > 0 then
  229.       result := result + [fsStrikeOut];
  230. end;
  231.  
  232. procedure DrawFrameRect(FrameRect: TRect) ;
  233. var
  234.    DC: hDC; { device context for the window       }
  235.    DesktopWindow: THandle;
  236.    OldHBrush: HBrush;
  237. begin
  238.    DesktopWindow := GetDesktopWindow;
  239.    DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE) ;
  240.    try
  241.       if NewBrush = nil then
  242.       begin
  243.          NewBrush := TBrush.Create;
  244.          NewBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite) ;
  245.       end;
  246.       OldHBrush := SelectObject(DC, NewBrush.Handle) ;
  247.  
  248.       with FrameRect do
  249.       begin
  250.          PatBlt(DC, Left + PenSize, Top, Right - Left - PenSize, PenSize, PATINVERT) ;
  251.          PatBlt(DC, Right - PenSize, Top + PenSize, PenSize, Bottom - Top - PenSize, PATINVERT) ;
  252.          PatBlt(DC, Left, Bottom - PenSize, Right - Left - PenSize, PenSize, PATINVERT) ;
  253.          PatBlt(DC, Left, Top, PenSize, Bottom - Top - PenSize, PATINVERT) ;
  254.       end;
  255.  
  256.       SelectObject(DC, OldHBrush) ;
  257.    finally
  258.       ReleaseDC(DesktopWindow, DC) ;
  259.    end;
  260. end;
  261.  
  262. { TrmToolWinForm }
  263.  
  264. constructor TrmCustomToolWinForm.CreateNew(AOwner: TComponent; Dummy: Integer) ;
  265. begin
  266.    inherited CreateNew(AOwner, Dummy) ;
  267.    if csDesigning in componentstate then exit;
  268.    fStandardMoving := true;
  269.    fWindowBMP := tbitmap.create;
  270.    AutoScroll := false;
  271.    VertScrollBar.Visible := false;
  272.    HorzScrollBar.Visible := false;
  273.    fActive := false;
  274.    fInNCPaint := false;
  275.    KeyPreview := true;
  276.    BorderStyle := bsNone;
  277.    fCloseBtnDown := false;
  278.    fCloseBtnPressed := false;
  279. end;
  280.  
  281. procedure TrmCustomToolWinForm.wmEnterSizeMove(var msg: tmessage) ;
  282. begin
  283.    if csDesigning in ComponentState then
  284.    begin
  285.       inherited;
  286.       exit;
  287.    end;
  288.  
  289.    inherited;
  290.    FPosRect := BoundsRect;
  291.    fMoveSize := msEntered;
  292. end;
  293.  
  294. procedure TrmCustomToolWinForm.wmExitSizeMove(var msg: tmessage) ;
  295. begin
  296.    if csDesigning in ComponentState then
  297.    begin
  298.       inherited;
  299.       exit;
  300.    end;
  301.  
  302.    if (fMoveSize = msMoving) then
  303.    begin
  304.       fMoveSize := msExited;
  305.       if not (fStandardMoving) then
  306.       begin
  307.          DrawFrameRect(fLastFrameRect) ;
  308.          SetBounds(fLastFrameRect.left, fLastFrameRect.top, width, height) ;
  309.          msg.Result := integer(true) ;
  310.          fLastFrameRect := Rect(0, 0, 0, 0) ;
  311.       end
  312.       else
  313.          inherited;
  314.    end
  315.    else
  316.    begin
  317.       fMoveSize := msExited;
  318.       inherited;
  319.    end;
  320.  
  321.    Invalidate;
  322. end;
  323.  
  324. procedure TrmCustomToolWinForm.wmMoving(var msg: TWMMoving) ;
  325. begin
  326.    if csDesigning in ComponentState then
  327.    begin
  328.       inherited;
  329.       exit;
  330.    end;
  331.  
  332.    inherited;
  333.  
  334.    if fMoveSize = msEntered then
  335.       fMoveSize := msMoving;
  336.  
  337.    if (fMoveSize = msMoving) then
  338.    begin
  339.       if not (fStandardMoving) then
  340.       begin
  341.          if not IsRectEmpty(fLastFrameRect) then
  342.             DrawFrameRect(fLastFrameRect) ;
  343.  
  344.          fFrameRect := msg.WindowRect^;
  345.  
  346.          try
  347.             DrawFrameRect(fFrameRect) ;
  348.          finally
  349.             fLastFrameRect := fFrameRect;
  350.          end;
  351.       end
  352.       else
  353.          fLastFrameRect := rect(0, 0, 0, 0) ;
  354.    end;
  355. end;
  356.  
  357. procedure TrmCustomToolWinForm.wmSizing(var msg: TWMSizing) ;
  358. var
  359.    xofs, yofs: integer;
  360.    wRect: TRect;
  361. begin
  362.    if csDesigning in ComponentState then
  363.    begin
  364.       inherited;
  365.       exit;
  366.    end;
  367.  
  368.    inherited;
  369.  
  370.    if fMoveSize = msEntered then
  371.       fMoveSize := msSizing;
  372.  
  373.    if (fMoveSize = msSizing) then
  374.    begin
  375.       wRect := msg.WindowRect^;
  376.  
  377.       if not (((wRect.left <> 0) and (wRect.top <> 0) ) and
  378.          (((wrect.top <> top) and (wRect.bottom = height) ) or
  379.          ((wrect.Left <> Left) and (wRect.right = width) ) ) ) then
  380.       begin
  381.          xofs := wRect.Left;
  382.          yofs := wRect.Top;
  383.          offsetrect(wRect, -xofs, -yofs) ;
  384.          try
  385.             wRect := AdjustFormFrameRect(wRect) ;
  386.          finally
  387.             offsetrect(wRect, xofs, yofs) ;
  388.          end;
  389.       end
  390.       else
  391.       begin
  392.          wRect := rect(left, top, width, height) ;
  393.       end;
  394.       InternalFrameRect := wRect;
  395.    end;
  396. end;
  397.  
  398. procedure TrmCustomToolWinForm.wmWindowPosChanging(var msg: TWMWindowPosChanging) ;
  399. var
  400.    wRect: trect;
  401. begin
  402.    if csDesigning in ComponentState then
  403.    begin
  404.       inherited;
  405.       exit;
  406.    end;
  407.  
  408.    if fMoveSize = msMoving then
  409.    begin
  410.       if fStandardMoving then
  411.          inherited
  412.       else
  413.       begin
  414.          msg.WindowPos.x := left;
  415.          msg.WindowPos.y := top;
  416.          Msg.Result := 0
  417.       end;
  418.    end
  419.    else if (fMoveSize = msSizing) then
  420.    begin
  421.       inherited;
  422.  
  423.       wrect := AdjustFormFrameRect(rect(msg.windowpos.x, msg.windowpos.y, msg.windowpos.cx, msg.windowpos.cy) ) ;
  424.  
  425.       msg.windowpos.x := wrect.left;
  426.       msg.windowpos.y := wrect.top;
  427.       msg.windowpos.cx := wrect.right;
  428.       msg.windowpos.cy := wrect.bottom;
  429.    end;
  430. end;
  431.  
  432. procedure TrmCustomToolWinForm.WMNCCalcSize(var Message: TWMNCCalcSize) ;
  433. begin
  434.    if csDesigning in ComponentState then
  435.    begin
  436.       inherited;
  437.       exit;
  438.    end;
  439.  
  440.   //Adjust the size of the clientwidth rect for the drawing of the
  441.   //Borders
  442.    inherited;
  443.  
  444.    with Message.CalcSize_Params^ do
  445.    begin
  446.       InflateRect(rgrc[0], -WindowBorderWidth, -WindowBorderHeight);
  447.       rgrc[0].top := rgrc[0].top + WindowCaptionHeight;
  448.    end;
  449. end;
  450.  
  451. procedure TrmCustomToolWinForm.WMNCHitTest(var Message: TWMNCHitTest) ;
  452. var
  453.    wpt: TPoint;
  454.    wRect: TRect;
  455.  
  456.    BorderWidth, BorderHeight: integer;
  457. begin
  458.    if csDesigning in ComponentState then
  459.    begin
  460.       inherited;
  461.       exit;
  462.    end;
  463.  
  464.    inherited;
  465.  
  466.   //Figure out where the hell the mouse is in relation to
  467.   //what's on the window....
  468.  
  469.    BorderWidth := WindowBorderWidth;
  470.    BorderHeight := WindowBorderHeight;
  471.  
  472.    wpt := Point(Message.XPos, Message.YPos) ;
  473.    wRect := FormFrameRect(true) ;
  474.  
  475.    if (PtInRect(Rect(wRect.left, wRect.top, wRect.Left + 10 + borderwidth, wRect.top + borderheight) , wpt) or
  476.       PtInRect(Rect(wRect.Left, wRect.top, wRect.Left + BorderWidth, wRect.top + 10 + borderheight) , wpt) ) then //TopLeft
  477.    begin
  478.       Message.Result := htTopLeft;
  479.    end
  480.    else if (PtInRect(Rect(wRect.right - (10 + borderwidth) , wRect.bottom - borderheight, wRect.right, wRect.bottom) , wpt) or
  481.       PtInRect(Rect(wRect.right - BorderWidth, wRect.bottom - (10 + borderheight) , wRect.right, wRect.bottom) , wpt) ) then //BottomRight
  482.    begin
  483.       Message.Result := htBottomRight;
  484.    end
  485.    else if (PtInRect(Rect(wRect.right - (10 + borderwidth) , wRect.top, wRect.right, wRect.top + borderheight) , wpt) or
  486.       PtInRect(Rect(wRect.right - BorderWidth, wRect.top, wRect.right, wRect.top + (10 + borderheight) ) , wpt) ) then //TopRight
  487.    begin
  488.       Message.Result := htTopRight;
  489.    end
  490.    else if (PtInRect(Rect(wRect.Left, wRect.bottom - (10 + borderheight) , wRect.left + BorderWidth, wRect.bottom) , wpt) or
  491.       PtInRect(Rect(wRect.Left, wRect.bottom - borderheight, wRect.left + (10 + borderwidth) , wRect.bottom) , wpt) ) then //BottomRight
  492.    begin
  493.       Message.Result := htBottomLeft;
  494.    end
  495.    else if PtInRect(Rect(wRect.left + 10 + borderWidth, wRect.top, wRect.right - (10 + borderWidth) , wRect.top + borderheight) , wpt) then //Top
  496.    begin
  497.       Message.Result := htTop;
  498.    end
  499.    else if PtInRect(Rect(wRect.Left, wRect.top + 10 + borderheight, wRect.Left + BorderWidth, wRect.bottom - (10 + borderheight) ) , wpt) then //Left
  500.    begin
  501.       Message.Result := htLeft;
  502.    end
  503.    else if PtInRect(Rect(wRect.left + 10 + borderWidth, wRect.Bottom - borderheight, wRect.right - (10 + borderWidth) , wRect.Bottom) , wpt) then //bottom
  504.    begin
  505.       Message.Result := htBottom;
  506.    end
  507.    else if PtInRect(Rect(wRect.right - BorderWidth, wRect.top + 10 + borderheight, wRect.right, wRect.bottom - (10 + borderheight) ) , wpt) then //Right
  508.    begin
  509.       Message.Result := htRight;
  510.    end
  511.    else if PtInRect(FormBtnRect(true) , wpt) then //CloseButton
  512.    begin
  513.       Message.Result := htClose;
  514.    end
  515.    else if PtInRect(FormCaptionRect(true) , wpt) then //Caption
  516.    begin
  517.       Message.Result := htCaption;
  518.    end
  519.    else if PtInRect(FormClientRect(true) , wpt) then //Client
  520.    begin
  521.       Message.Result := htclient;
  522.    end
  523.    else
  524.       Message.result := HTNOWHERE;
  525. end;
  526.  
  527. procedure TrmCustomToolWinForm.WMNCPaint(var Message: TMessage) ;
  528. var
  529.    DC: HDC;
  530.    wRect: TRect;
  531.    Rgn1, Rgn2, Rgn3: HRGN;
  532.    cLeft, cRight: TColor;
  533.    wFrameRect, wCaptionRect, wBtnRect, wCaptionTextRect, wClientRect: TRect;
  534.  
  535. begin
  536.    if csDesigning in ComponentState then
  537.    begin
  538.       inherited;
  539.       exit;
  540.    end;
  541.  
  542.   //This is where the magic of the whole thing comes into play....
  543.  
  544.    wFrameRect := FormFrameRect(false) ;
  545.    wCaptionRect := FormCaptionRect(false) ;
  546.    wBtnRect := FormBtnRect(false) ;
  547.    wCaptionTextRect := FormCaptionTextRect(false) ;
  548.    wClientRect := FormClientRect(false) ;
  549.  
  550.    fInNCPaint := true;
  551.    try
  552.       fWindowBMP.Width := wFrameRect.right - wFrameRect.left;
  553.       fWindowBMP.height := wFrameRect.bottom - wFrameRect.Top;
  554.       fWindowBMP.canvas.Brush.Color := Color;
  555.       fWindowBMP.Canvas.FillRect(wFrameRect) ;
  556.  
  557.       if WinOSVersion in [wosWin98, wosWinNT2k] then
  558.       begin
  559.          if WindowUseGradientCaption then
  560.          begin
  561.             if fActive or Self.Focused then
  562.             begin
  563.                cLeft := clActiveCaption;
  564.                cRight := clGradientActiveCaption;
  565.                fWindowBMP.Canvas.font.Color := clCaptionText;
  566.             end
  567.             else
  568.             begin
  569.                cLeft := clInActiveCaption;
  570.                cRight := clGradientInactiveCaption;
  571.                fWindowBMP.Canvas.font.Color := clInactiveCaptionText;
  572.             end;
  573.             GradientFill(fWindowBMP.canvas, cLeft, cRight, wCaptionRect) ;
  574.          end
  575.          else
  576.          begin
  577.             if fActive or Self.Focused then
  578.             begin
  579.                fWindowBMP.Canvas.brush.color := clActiveCaption;
  580.                fWindowBMP.Canvas.font.Color := clCaptionText;
  581.             end
  582.             else
  583.             begin
  584.                fWindowBMP.Canvas.brush.color := clInActiveCaption;
  585.                fWindowBMP.Canvas.font.Color := clInactiveCaptionText;
  586.             end;
  587.             fWindowBMP.Canvas.fillrect(wCaptionRect) ;
  588.          end;
  589.       end
  590.       else
  591.       begin
  592.          if fActive or Self.Focused then
  593.          begin
  594.             fWindowBMP.Canvas.brush.color := clActiveCaption;
  595.             fWindowBMP.Canvas.font.Color := clCaptionText;
  596.          end
  597.          else
  598.          begin
  599.             fWindowBMP.Canvas.brush.color := clInActiveCaption;
  600.             fWindowBMP.Canvas.font.Color := clInactiveCaptionText;
  601.          end;
  602.          fWindowBMP.Canvas.fillrect(wCaptionRect) ;
  603.       end;
  604.       fWindowBMP.Canvas.Pen.Color := clBtnFace;
  605.       fWindowBMP.Canvas.MoveTo(wCaptionRect.Left, wCaptionRect.Bottom - 1) ;
  606.       fWindowBMP.Canvas.LineTo(wCaptionRect.Right, wCaptionRect.Bottom - 1) ;
  607.  
  608.       fWindowBMP.Canvas.font.name := WindowCaptionFontName;
  609.       fWindowBMP.Canvas.font.height := WindowCaptionFontSize;
  610.       fWindowBMP.Canvas.Brush.Style := bsClear;
  611.       fWindowBMP.Canvas.Font.Style := WindowCaptionFontStyle;
  612.  
  613.       wRect := wCaptionTextRect;
  614.       DrawText(fWindowBMP.Canvas.handle, pchar(caption) , length(caption) , wRect, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS) ;
  615.       DrawFrameControl(fWindowBMP.canvas.handle, wBtnRect, DFC_Caption, DFCS_CAPTIONCLOSE) ;
  616.  
  617.       wRect := wFrameRect;
  618.       if Parent = nil then
  619.       begin
  620.          Frame3D(fWindowBMP.Canvas, wRect, cl3DLight, cl3DDkShadow, 1) ;
  621.          Frame3D(fWindowBMP.Canvas, wRect, clBtnHighlight, clBtnShadow, 1) ;
  622.       end
  623.       else
  624.       begin
  625.          Frame3D(fWindowBMP.Canvas, wRect, clBtnface, clBtnface, 2) ;
  626.       end;
  627.       Frame3D(fWindowBMP.Canvas, wRect, clBtnface, clBtnface, 2) ;
  628.  
  629.       Rgn1 := CreateRectRgn(wFrameRect.Left, wFrameRect.Top, wFrameRect.Right, wFrameRect.Bottom) ;
  630.  
  631.       GetWindowRgn(handle, Rgn1) ;
  632.  
  633.       Rgn2 := CreateRectRgn(wClientRect.Left, wClientRect.Top, wClientRect.Right, wClientRect.Bottom) ;
  634.       Rgn3 := CreateRectRgn(0, 0, width, height) ;
  635.       CombineRgn(Rgn3, Rgn1, Rgn2, Rgn_XOR) ;
  636.       try
  637.          if Rgn3 <> 0 then
  638.             SetWindowRgn(handle, Rgn3, false) ;
  639.  
  640.          DC := GetWindowDC(Handle) ;
  641.          try
  642.             BitBlt(DC, 0, 0, fWindowBMP.width, fWindowBMP.height, fWindowBMP.Canvas.Handle, 0, 0, SRCCOPY) ;
  643.          finally
  644.             ReleaseDC(Handle, DC) ;
  645.          end;
  646.  
  647.       finally
  648.          SetWindowRgn(handle, 0, false) ;
  649.          DeleteObject(Rgn1) ;
  650.          DeleteObject(Rgn2) ;
  651.          DeleteObject(Rgn3) ;
  652.       end;
  653.    finally
  654.       fInNCPaint := false;
  655.    end;
  656.    Message.result := 0;
  657. end;
  658.  
  659. function TrmCustomToolWinForm.FormFrameRect(Screen: boolean) : TRect;
  660. begin
  661.    if Screen then
  662.       result := BoundsRect
  663.    else
  664.    begin
  665.       if fMoveSize = msSizing then
  666.       begin
  667.          result := InternalFrameRect;
  668.          offsetrect(result, -result.left, -result.Top) ;
  669.       end
  670.       else
  671.          result := rect(0, 0, width, height) ;
  672.    end;
  673. end;
  674.  
  675. function TrmCustomToolWinForm.FormCaptionRect(screen: boolean) : TRect;
  676. begin
  677.    result := FormFrameRect(screen) ;
  678.    InflateRect(result, -WindowBorderWidth, -WindowBorderHeight) ;
  679.    Result.Bottom := Result.top + WindowCaptionHeight;
  680. end;
  681.  
  682. function TrmCustomToolWinForm.FormCaptionTextRect(Screen: boolean) : TRect;
  683. begin
  684.    result := FormCaptionRect(screen) ;
  685.    Result.left := Result.Left + 2;
  686.    Result.right := Result.right - WindowButtonWidth - 2;
  687. end;
  688.  
  689. function TrmCustomToolWinForm.FormBtnRect(screen: boolean) : TRect;
  690. begin
  691.    Result := FormCaptionRect(screen) ;
  692.    Result.Right := Result.Right - 2;
  693.    Result.Left := Result.Right - WindowButtonWidth;
  694.    Result.top := Result.top + 2;
  695.    Result.bottom := Result.top + WindowButtonHeight;
  696. end;
  697.  
  698. function TrmCustomToolWinForm.FormClientRect(screen: boolean) : TRect;
  699. var
  700.    wRect: TRect;
  701. begin
  702.    if screen then
  703.       wRect := rect(ClientOrigin.x, ClientOrigin.y, ClientOrigin.x + clientwidth, ClientOrigin.y + clientheight)
  704.    else
  705.    begin
  706.       wRect := ClientRect;
  707.       OffsetRect(wRect, WindowBorderWidth, WindowBorderheight + WindowCaptionHeight) ;
  708.    end;
  709.    result := wRect;
  710. end;
  711.  
  712. procedure TrmCustomToolWinForm.WMNCLButtonDown(var Message: TWMNCLButtonDown) ;
  713. var
  714.    DC: HDC;
  715. begin
  716.    if csDesigning in ComponentState then
  717.    begin
  718.       inherited;
  719.       exit;
  720.    end;
  721.  
  722.    DC := GetWindowDC(handle) ;
  723.    try
  724.       if Message.HitTest = htClose then
  725.       begin
  726.          SendCancelMode(Self) ;
  727.          MouseCapture := true;
  728.          DrawFrameControl(DC, FormBtnRect(false) , DFC_Caption, DFCS_CAPTIONCLOSE or DFCS_PUSHED) ;
  729.          fCloseBtnPressed := true;
  730.          Message.Result := 0;
  731.       end
  732.       else
  733.          inherited;
  734.    finally
  735.       if DC <> 0 then
  736.          ReleaseDC(handle, DC) ;
  737.    end;
  738. end;
  739.  
  740. procedure TrmCustomToolWinForm.WMNCLButtonUp(var Message: TWMNCLButtonUp) ;
  741. var
  742.    DC: HDC;
  743. begin
  744.    if csDesigning in ComponentState then
  745.    begin
  746.       inherited;
  747.       exit;
  748.    end;
  749.  
  750.    DC := GetWindowDC(handle) ;
  751.    try
  752.       DrawFrameControl(DC, FormBtnRect(false) , DFC_Caption, DFCS_CAPTIONCLOSE) ;
  753.       if fCloseBtnPressed and (Message.HitTest = htClose) then
  754.       begin
  755.          Message.Result := 0;
  756.          close;
  757.       end
  758.       else
  759.          inherited;
  760.    finally
  761.       fCloseBtnPressed := false;
  762.       if DC <> 0 then
  763.          ReleaseDC(handle, DC) ;
  764.    end;
  765. end;
  766.  
  767. procedure TrmCustomToolWinForm.WMNCMouseMove(var Message: TWMNCMouseMove) ;
  768. var
  769.    DC: HDC;
  770. begin
  771.    if csDesigning in ComponentState then
  772.    begin
  773.       inherited;
  774.       exit;
  775.    end;
  776.  
  777.    try
  778.       DC := GetWindowDC(handle) ;
  779.  
  780.       try
  781.          if fCloseBtnPressed then
  782.          begin
  783.             if Message.HitTest = htClose then
  784.                DrawFrameControl(DC, FormBtnRect(false) , DFC_Caption, DFCS_PUSHED or DFCS_CAPTIONCLOSE)
  785.             else
  786.                DrawFrameControl(DC, FormBtnRect(false) , DFC_Caption, DFCS_CAPTIONCLOSE) ;
  787.             message.result := 0;
  788.          end
  789.          else
  790.             inherited;
  791.       finally
  792.          if DC <> 0 then
  793.             ReleaseDC(handle, DC) ;
  794.       end;
  795.    except
  796.       //for some reason we occasionally get a Range Checking error here.
  797.    end;
  798.  
  799. end;
  800.  
  801. procedure TrmCustomToolWinForm.WMLButtonUp(var Message: TWMLButtonUp) ;
  802. var
  803.    DC: HDC;
  804.    pt: TPoint;
  805.    WasBtnPressed: boolean;
  806. begin
  807.    if csDesigning in ComponentState then
  808.    begin
  809.       inherited;
  810.       exit;
  811.    end;
  812.  
  813.    WasBtnPressed := fCloseBtnPressed;
  814.    fCloseBtnPressed := false;
  815.    MouseCapture := false;
  816.    DC := GetWindowDC(handle) ;
  817.    try
  818.       DrawFrameControl(DC, FormBtnRect(false) , DFC_Caption, DFCS_CAPTIONCLOSE) ;
  819.       pt := clienttoscreen(point(message.XPos, Message.YPos) ) ;
  820.       if WasBtnPressed and ptInRect(FormBtnRect(true) , pt) then
  821.       begin
  822.          Message.Result := 0;
  823.          close;
  824.       end
  825.       else
  826.          inherited;
  827.    finally
  828.       if DC <> 0 then
  829.          ReleaseDC(handle, DC) ;
  830.    end;
  831. end;
  832.  
  833. procedure TrmCustomToolWinForm.WMMouseMove(var Message: TWMMouseMove) ;
  834. var
  835.    DC: HDC;
  836.    pt: TPoint;
  837. begin
  838.    if csDesigning in ComponentState then
  839.    begin
  840.       inherited;
  841.       exit;
  842.    end;
  843.  
  844.    DC := GetWindowDC(handle) ;
  845.    try
  846.       if fCloseBtnPressed then
  847.       begin
  848.          pt := clienttoscreen(point(message.XPos, Message.YPos) ) ;
  849.          if ptInRect(FormBtnRect(true) , pt) then
  850.             DrawFrameControl(DC, FormBtnRect(false) , DFC_Caption, DFCS_PUSHED or DFCS_CAPTIONCLOSE)
  851.          else
  852.             DrawFrameControl(DC, FormBtnRect(false) , DFC_Caption, DFCS_CAPTIONCLOSE) ;
  853.          message.result := 0;
  854.       end
  855.       else
  856.          inherited;
  857.    finally
  858.       if DC <> 0 then
  859.          ReleaseDC(handle, DC) ;
  860.    end;
  861. end;
  862.  
  863. procedure TrmCustomToolWinForm.WMNCActivate(var Message: TWMNCActivate) ;
  864. begin
  865.    inherited;
  866.    //Your supposed to pass the handle of the region to paint according to the Win32 API
  867.    //But because I'm handling the NCPainting myself, I figure that I can skip passing the
  868.    //handle of the rgn.  Mostly because I'm not paying attention to it in the first place.
  869.    fActive := Message.active;
  870.    SendMessage(self.handle, wm_ncPaint, 0, 0) ;
  871. end;
  872.  
  873. procedure TrmCustomToolWinForm.WMKillFocus(var msg: TWMKillFocus) ;
  874. begin
  875.    inherited;
  876.    fActive := false;
  877.    SendMessage(self.handle, wm_ncPaint, 0, 0) ;
  878. end;
  879.  
  880. function TrmCustomToolWinForm.AdjustFormFrameRect(wRect: TRect) : TRect;
  881. var
  882.    fixed: boolean;
  883.    wPosRect: TRect;
  884. begin
  885.    wPosRect := fPosRect;
  886.  
  887.    fixed := false;
  888.  
  889.    if wRect.right <= 40 + (WindowButtonWidth + (WindowBorderWidth * 2) + 6) then
  890.    begin
  891.       wRect.right := 40 + (WindowButtonWidth + (WindowBorderWidth * 2) + 6) ;
  892.       fixed := true;
  893.    end;
  894.  
  895.    if wRect.bottom <= (WindowCaptionHeight + (WindowBorderWidth * 2) ) then
  896.    begin
  897.       wRect.bottom := (WindowCaptionHeight + (WindowBorderWidth * 2) ) ;
  898.       fixed := true;
  899.    end;
  900.  
  901.    if fixed then
  902.    begin
  903.       if wRect.left > wPosRect.left then
  904.          wRect.left := wPosRect.right - wRect.right;
  905.  
  906.       if wRect.top > wPosRect.Top then
  907.          wRect.top := wPosRect.bottom - wRect.bottom;
  908.    end;
  909.    result := wRect;
  910. end;
  911.  
  912. procedure TrmCustomToolWinForm.SetInternalFrameRect(const Value: TRect) ;
  913. begin
  914.    fFrameRect := Value;
  915. end;
  916.  
  917. procedure TrmCustomToolWinForm.wmMove(var msg: TwmMove) ;
  918. begin
  919.    inherited;
  920.    if assigned(fonMove) then
  921.       fOnMove(self) ;
  922. end;
  923.  
  924. destructor TrmCustomToolWinForm.destroy;
  925. begin
  926.    fWindowBMP.free;
  927.    inherited;
  928. end;
  929.  
  930. procedure TrmCustomToolWinForm.setncactive(const Value: boolean);
  931. begin
  932.   factive := Value;
  933.   SendMessage(self.handle, wm_ncPaint, 0, 0) ;
  934. end;
  935.  
  936. initialization
  937.    NewBrush := TBrush.Create;
  938.    NewBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite) ;
  939.  
  940. finalization
  941.    if assigned(NewBrush) then
  942.       NewBrush.free;
  943. end.
  944.  
  945.