home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / DFSToolBar.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  31KB  |  971 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. {------------------------------------------------------------------------------}
  4. { TdfsToolBar v1.13                                                            }
  5. {------------------------------------------------------------------------------}
  6. { A descendant of the TToolBar component (D3, C3, & D4) that adds a            }
  7. { "maximize - restore" button.  This mimics the behavior of the toolbar in     }
  8. { Netscape Communicator.  Clicking the button makes the toolbar small, hiding  }
  9. { its controls.  Clicking again returns it to normal.                          }
  10. {                                                                              }
  11. { Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
  12. {                                                                              }
  13. { Copyright:                                                                   }
  14. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  15. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  16. { property of the author.                                                      }
  17. {                                                                              }
  18. { Distribution Rights:                                                         }
  19. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  20. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  21. { the DFS source code unless specifically stated otherwise.                    }
  22. { You are further granted permission to redistribute any of the DFS source     }
  23. { code in source code form, provided that the original archive as found on the }
  24. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  25. { example, if you create a descendant of TdfsColorButton, you must include in  }
  26. { the distribution package the colorbtn.zip file in the exact form that you    }
  27. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  28. {                                                                              }
  29. { Restrictions:                                                                }
  30. { Without the express written consent of the author, you may not:              }
  31. {   * Distribute modified versions of any DFS source code by itself. You must  }
  32. {     include the original archive as you found it at the DFS site.            }
  33. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  34. {     to sell any of your own original code that works with, enhances, etc.    }
  35. {     DFS source code.                                                         }
  36. {   * Distribute DFS source code for profit.                                   }
  37. {                                                                              }
  38. { Warranty:                                                                    }
  39. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  40. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  41. { and all risks and losses associated with it's use are assumed by you. In no  }
  42. { event shall the author of the softare, Bradley D. Stowers, be held           }
  43. { accountable for any damages or losses that may occur from use or misuse of   }
  44. { the software.                                                                }
  45. {                                                                              }
  46. { Support:                                                                     }
  47. { Support is provided via the DFS Support Forum, which is a web-based message  }
  48. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  49. { All DFS source code is provided free of charge. As such, I can not guarantee }
  50. { any support whatsoever. While I do try to answer all questions that I        }
  51. { receive, and address all problems that are reported to me, you must          }
  52. { understand that I simply can not guarantee that this will always be so.      }
  53. {                                                                              }
  54. { Clarifications:                                                              }
  55. { If you need any further information, please feel free to contact me directly.}
  56. { This agreement can be found online at my site in the "Miscellaneous" section.}
  57. {------------------------------------------------------------------------------}
  58. { The lateset version of my components are always available on the web at:     }
  59. {   http://www.delphifreestuff.com/                                            }
  60. { See DFSToolBar.txt for notes, known issues, and revision history.            }
  61. {------------------------------------------------------------------------------}
  62. { Date last modified:  June 28, 2001                                           }
  63. {------------------------------------------------------------------------------}
  64.  
  65.  
  66. unit dfsToolBar;
  67.  
  68. interface
  69.  
  70. uses
  71.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  72.   ToolWin, ComCtrls;
  73.  
  74. const
  75.   { This shuts up C++Builder 3 about the redefiniton being different. There
  76.     seems to be no equivalent in C1.  Sorry. }
  77.   {$IFDEF DFS_CPPB_3_UP}
  78.   {$EXTERNALSYM DFS_COMPONENT_VERSION}
  79.   {$ENDIF}
  80.   DFS_COMPONENT_VERSION = 'TdfsToolBar v1.13';
  81.   DEF_BUTTON_HIGHLIGHT_COLOR = $00FFCFCF; // same as RGB(207,207,255)
  82.  
  83. type
  84.   TdfsOrientation = (oHorizontal, oVertical);
  85.  
  86.   TdfsToolBar = class(TToolBar)
  87.   private
  88.     FCaption: string;
  89.     FShowTab: boolean;
  90.     FTextureColor1: TColor;
  91.     FTabColor: TColor;
  92.     FArrowColor: TColor;
  93.     FTextureColor2: TColor;
  94.     FTabHighlightColor: TColor;
  95.     FOnRestore: TNotifyEvent;
  96.     FOnMaximize: TNotifyEvent;
  97.     FMaximized: boolean;
  98.     FRestoreVal: integer;
  99.     FRestoreAutosize: boolean;
  100.     FTabSizeMaximized: integer;
  101.     FTabSizeMinimized: integer;
  102.     FTabIndent: integer;
  103.     FGotMouseDown: boolean;
  104.     FIsHighlighted: boolean;
  105.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  106.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  107.     procedure WMNCLButtonDown(var Message: TWMNCLButtonDown);
  108.        message WM_NCLBUTTONDOWN;
  109.     procedure WMNCLButtonUp(var Message: TWMNCLButtonUp); message WM_NCLBUTTONUP;
  110.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  111.     procedure CMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;
  112.     function GetVersion: string;
  113.     procedure SetArrowColor(const Value: TColor);
  114.     procedure SetTabColor(const Value: TColor);
  115.     procedure SetTabHighlightColor(const Value: TColor);
  116.     procedure SetShowTab(const Value: boolean);
  117.     procedure SetTextureColor1(const Value: TColor);
  118.     procedure SetTextureColor2(const Value: TColor);
  119.     procedure SetVersion(const Value: string);
  120.     procedure SetMaximized(const Value: boolean);
  121.     function GetHeight: integer;
  122.     function GetWidth: integer;
  123.     function GetOrientation: TdfsOrientation;
  124.     procedure SetCaption(const Value: string);
  125.     procedure SetHeight(const Value: integer);
  126.     procedure SetWidth(const Value: integer);
  127.     procedure SetTabSizeMaximized(const Value: integer);
  128.     procedure SetTabSizeMinimized(const Value: integer);
  129.     procedure SetTabIndent(const Value: integer);
  130.     function GetTabRect: TRect;
  131.     function GetAutoSize: boolean;
  132.     procedure ReplacementSetAutoSize(Value: boolean);
  133.     function GetAlign: TAlign;
  134.     procedure SetAlign(const Value: TAlign);
  135.     procedure CMFontChanged(var TMessage); message CM_FONTCHANGED;
  136.   protected
  137.     procedure DoMaximize; dynamic;
  138.     procedure DoRestore; dynamic;
  139.     procedure PaintTab(Highlight: boolean); dynamic;
  140.     function TabHitTest(X, Y: integer): boolean; dynamic;
  141.     function DrawArrow(ACanvas: TCanvas; AvailableRect: TRect; Offset: integer;
  142.        ArrowSize: integer; Color: TColor): integer; dynamic;
  143.     procedure InvalidateNonclientArea;
  144.     procedure Resize; override;
  145.     property Orientation: TdfsOrientation
  146.       read GetOrientation;
  147.   public
  148.     constructor Create(AOwner: TComponent); override;
  149.     destructor Destroy; override;
  150.  
  151.     // SCREEN-RELATIVE!!!!
  152.     property TabRect: TRect
  153.        read GetTabRect;
  154.   published
  155.     // Overriden properties
  156.     property Height: integer
  157.        read GetHeight
  158.        write SetHeight;
  159.     property Width: integer
  160.        read GetWidth
  161.        write SetWidth;
  162.     property AutoSize: boolean
  163.        read GetAutoSize
  164.        write ReplacementSetAutoSize;
  165.     property Align: TAlign
  166.        read GetAlign
  167.        write SetAlign;
  168.  
  169.     // New Stuff
  170.     property Version: string
  171.        read GetVersion
  172.        write SetVersion
  173.        stored FALSE;
  174.     property Caption: string
  175.        read FCaption
  176.        write SetCaption;
  177.     property ShowTab: boolean
  178.        read FShowTab
  179.        write SetShowTab
  180.        default TRUE;
  181.     property Maximized: boolean
  182.        read FMaximized
  183.        write SetMaximized
  184.        default TRUE;
  185.     property TabColor: TColor
  186.        read FTabColor
  187.        write SetTabColor
  188.        default clBtnFace;
  189.     property ArrowColor: TColor
  190.        read FArrowColor
  191.        write SetArrowColor
  192.        default clNavy;
  193.     property TabHighlightColor: TColor
  194.        read FTabHighlightColor
  195.        write SetTabHighlightColor
  196.        default DEF_BUTTON_HIGHLIGHT_COLOR;
  197.     property TextureColor1: TColor
  198.        read FTextureColor1
  199.        write SetTextureColor1
  200.        default clWhite;
  201.     property TextureColor2: TColor
  202.        read FTextureColor2
  203.        write SetTextureColor2
  204.        default clNavy;
  205.     property TabSizeMaximized: integer
  206.        read FTabSizeMaximized
  207.        write SetTabSizeMaximized
  208.        default 10;
  209.     property TabSizeMinimized: integer
  210.        read FTabSizeMinimized
  211.        write SetTabSizeMinimized
  212.        default 62;
  213.     property TabIndent: integer
  214.        read FTabIndent
  215.        write SetTabIndent
  216.        default 4;
  217.  
  218.     property OnMaximize: TNotifyEvent
  219.        read FOnMaximize
  220.        write FOnMaximize;
  221.     property OnRestore: TNotifyEvent
  222.        read FOnRestore
  223.        write FOnRestore;
  224.   end;
  225.  
  226. implementation
  227.  
  228. { TdfsToolBar }
  229.  
  230. constructor TdfsToolBar.Create(AOwner: TComponent);
  231. begin
  232.   inherited Create(AOwner);
  233.  
  234.   FIsHighlighted := FALSE;
  235.   FShowTab := TRUE;
  236.   FTabColor := clBtnFace;
  237.   FArrowColor := clNavy;
  238.   FTabHighlightColor := DEF_BUTTON_HIGHLIGHT_COLOR;
  239.   FTextureColor1 := clWhite;
  240.   FTextureColor2 := clNavy;
  241.   FMaximized := TRUE;
  242.   FTabSizeMaximized := 10;
  243.   FTabSizeMinimized := 62;
  244.   FTabIndent := 4;
  245.   FRestoreVal := Height;
  246.   FGotMouseDown := FALSE;
  247.   FRestoreAutosize := AutoSize;
  248. end;
  249.  
  250. destructor TdfsToolBar.Destroy;
  251. begin
  252.   inherited Destroy;
  253. end;
  254.  
  255.  
  256. function TdfsToolBar.GetHeight: integer;
  257. begin
  258.   // If the component is being written to the DFM file, we need to tell it the
  259.   // toolbar's real size if it's minimized.
  260.   if (csWriting in ComponentState) and (not Maximized) and
  261.      (Orientation = oHorizontal) then
  262.     Result := FRestoreVal
  263.   else
  264.     Result := inherited Height;
  265. end;
  266.  
  267. // This is SCREEN-RELATIVE!!!
  268. function TdfsToolBar.GetTabRect: TRect;
  269. begin
  270.   // Have to use this since we are in the non-client area
  271.   GetWindowRect(Handle, Result);
  272.  
  273.   // Adjust for EdgeBorders property
  274.   if ebTop in EdgeBorders then
  275.     inc(Result.Top, 2);
  276.   if ebLeft in EdgeBorders then
  277.     inc(Result.Left, 2);
  278.   if ebBottom in EdgeBorders then
  279.     dec(Result.Bottom, 2);
  280.   if ebRight in EdgeBorders then
  281.     dec(Result.Right, 2);
  282.  
  283.   if FMaximized then
  284.   begin
  285.     // paint skinny tab
  286.     if Orientation = oVertical then
  287.       Result.Bottom := Result.Top + FTabSizeMaximized
  288.     else
  289.       Result.Right := Result.Left + FTabSizeMaximized;
  290.   end else begin
  291.     // paint wide tab
  292.     if Orientation = oVertical then
  293.       Result.Bottom := Result.Top + FTabSizeMinimized
  294.     else
  295.       Result.Right := Result.Left + FTabSizeMinimized;
  296.   end;
  297. end;
  298.  
  299. function TdfsToolBar.GetVersion: string;
  300. begin
  301.   Result := DFS_COMPONENT_VERSION;
  302. end;
  303.  
  304. function TdfsToolBar.GetWidth: integer;
  305. begin
  306.   // If the component is being written to the DFM file, we need to tell it the
  307.   // toolbar's real size if it's minimized.
  308.   if (csWriting in ComponentState) and (not Maximized) and
  309.      (Orientation = oVertical) then
  310.     Result := FRestoreVal
  311.   else
  312.     Result := inherited Width;
  313. end;
  314.  
  315. procedure TdfsToolBar.PaintTab(Highlight: boolean);
  316. const
  317.   TEXTURE_SIZE = 3;
  318. var
  319.   TR, R: TRect;
  320.   TextureBmp: TBitmap;
  321.   RW, RH: integer;
  322.   TabCanvas: TCanvas;
  323.   x, y: integer;
  324.   Poly: array[0..4] of TPoint;
  325.   CaptionFontRec: TLogFont;
  326.   TM: TTextMetric;
  327. begin
  328.   TR := TabRect; // Save it so we don't call GetTabRect repeatedly
  329.   // Offset so that it is client-relative instead of screen-relative
  330.   OffsetRect(TR, -TR.Left, -TR.Top);
  331.   if ebTop in EdgeBorders then
  332.     OffsetRect(TR, 0, 2);
  333.   if ebLeft in EdgeBorders then
  334.     OffsetRect(TR, 2, 0);
  335.  
  336.   FIsHighlighted := Highlight;
  337.  
  338.   // TToolbar doesn't have a Canvas property, and it would be client area only
  339.   // if it did.  We need the non-client area.
  340.   TabCanvas := TCanvas.Create;
  341.   try
  342.     TabCanvas.Handle := GetWindowDC(Handle);
  343.  
  344.     with TabCanvas do
  345.     begin
  346.       if Highlight then
  347.         Brush.Color := TabHighlightColor
  348.       else
  349.         Brush.Color := TabColor;
  350.       if FMaximized then
  351.       begin
  352.         Pen.Color := Brush.Color;
  353.         dec(TR.Right);
  354.         dec(TR.Bottom);
  355.         dec(TR.Left);
  356.         Poly[0] := Point(TR.Right, TR.Top);
  357.         Poly[1] := TR.BottomRight;
  358.         Poly[2] := Point(TR.Left, TR.Bottom);
  359.         Poly[3] := Point(TR.Left, TR.Top);
  360.         Poly[4] := Point(TR.Right, TR.Top);
  361.         Polygon(Poly);
  362.         Pen.Color := clBtnShadow;
  363.         PolyLine(Slice(Poly, 3));
  364.         if Orientation = oHorizontal then
  365.         begin
  366.           // Arrow
  367.           x := DrawArrow(TabCanvas, TR, 2, (TR.Right - TR.Left - 2) div 2,
  368.              ArrowColor);
  369.           inc(TR.Top, x);
  370.         end else begin
  371.           // Arrow
  372.           x := DrawArrow(TabCanvas, TR, 2, (TR.Bottom - TR.Top - 2) div 2,
  373.              ArrowColor);
  374.           inc(TR.Left, x);
  375.         end;
  376.         InflateRect(TR, -2, -2);
  377.       end else begin
  378.         dec(TR.Right);
  379.         dec(TR.Bottom);
  380.         Pen.Color := cl3DDkShadow;
  381.         Poly[0] := TR.TopLeft;
  382.         Poly[1] := Point(TR.Right, TR.Top);
  383.         if Orientation = oHorizontal then
  384.           Poly[2] := Point(TR.Right - (TR.Bottom - TR.Top), TR.Bottom)
  385.         else
  386.           Poly[2] := Point(TR.Right, TR.Bottom - (TR.Right - TR.Left));
  387.         Poly[3] := Point(TR.Left, TR.Bottom);
  388.         Poly[4] := TR.TopLeft;
  389.         Polygon(Poly);
  390.  
  391.         InflateRect(TR, -1, -1);
  392.         if Orientation = oHorizontal then
  393.           Dec(TR.Right)
  394.         else
  395.           Dec(TR.Bottom);
  396.         Pen.Color := clWhite;
  397.         Poly[0] := Point(TR.Left, TR.Bottom);
  398.         Poly[1] := Point(TR.Left, TR.Top);
  399.         Poly[2] := Point(TR.Right, TR.Top);
  400.         Polyline(Slice(Poly, 3));
  401.         Pen.Color := clBtnShadow;
  402.         Poly[0] := Poly[2];
  403.         if Orientation = oHorizontal then
  404.           Poly[1] := Point(TR.Right - (TR.Bottom - TR.Top), TR.Bottom)
  405.         else
  406.           Poly[1] := Point(TR.Right, TR.Bottom - (TR.Right - TR.Left));
  407.         Poly[2] := Point(TR.Left, TR.Bottom);
  408.         Polyline(Slice(Poly, 3));
  409.         if Orientation = oHorizontal then
  410.         begin
  411.           // Arrow
  412.           x := DrawArrow(TabCanvas, TR, 2, (TR.Bottom - TR.Top) div 2,
  413.              ArrowColor);
  414.           inc(TR.Left, x + 2);
  415.           dec(TR.Right, (TR.Bottom - TR.Top));
  416.           InflateRect(TR, 0, -2);
  417.         end else begin
  418.           // Arrow
  419.           x := DrawArrow(TabCanvas, TR, 2, (TR.Right - TR.Left) div 2,
  420.              ArrowColor);
  421.           inc(TR.Top, x + 2);
  422.           dec(TR.Bottom, (TR.Right - TR.Left));
  423.           InflateRect(TR, -2, 0);
  424.         end;
  425.       end;
  426.     end;
  427.  
  428.     // Draw the texture
  429.     // Note: This is so complex because I'm trying to make as much like the
  430.     //       Netscape splitter as possible.  They use a 3x3 texture pattern, and
  431.     //       that's harder to tile.  If the had used an 8x8 (or smaller
  432.     //       divisibly, i.e. 2x2 or 4x4), I could have used Brush.Bitmap and
  433.     //       FillRect and they whole thing would have been about half the size,
  434.     //       twice as fast, and 1/10th as complex.
  435.     RW := TR.Right - TR.Left;
  436.     RH := TR.Bottom - TR.Top;
  437.     if (RW >= TEXTURE_SIZE) and (RH >= TEXTURE_SIZE) then
  438.     begin
  439.       TextureBmp := TBitmap.Create;
  440.       try
  441.         with TextureBmp do
  442.         begin
  443.           Width := RW;
  444.           Height := RH;
  445.           // Draw first square
  446.           Canvas.Brush.Color := TabCanvas.Brush.Color;
  447.           Canvas.FillRect(Rect(0, 0, RW+1, RH+1));
  448.           Canvas.Pixels[1,1] := TextureColor1;
  449.           Canvas.Pixels[2,2] := TextureColor2;
  450.  
  451.           // Tile first square all the way across
  452.           for x := 1 to ((RW div TEXTURE_SIZE) + ord(RW mod TEXTURE_SIZE > 0)) do
  453.           begin
  454.             Canvas.CopyRect(Bounds(x * TEXTURE_SIZE, 0, TEXTURE_SIZE,
  455.                TEXTURE_SIZE), Canvas, Rect(0, 0, TEXTURE_SIZE, TEXTURE_SIZE));
  456.           end;
  457.  
  458.           // Tile first row all the way down
  459.           for y := 1 to ((RH div TEXTURE_SIZE) + ord(RH mod TEXTURE_SIZE > 0)) do
  460.           begin
  461.             Canvas.CopyRect(Bounds(0, y * TEXTURE_SIZE, RW, TEXTURE_SIZE),
  462.                Canvas, Rect(0, 0, RW, TEXTURE_SIZE));
  463.           end;
  464.  
  465.           // Above could be better if it reversed process when splitter was
  466.           // taller than it was wider.  Optimized only for horizontal right now.
  467.         end;
  468.         // Copy texture bitmap to the screen.
  469.         TabCanvas.CopyRect(TR, TextureBmp.Canvas, Rect(0, 0, RW, RH));
  470.       finally
  471.         TextureBmp.Free;
  472.       end;
  473.     end;
  474.  
  475.     if not Maximized then
  476.     begin
  477.       // Draw the caption
  478.       TabCanvas.Font.Assign(Font);
  479.       TabCanvas.Brush.Style := bsClear;
  480.       GetObject(Font.Handle, SizeOf(CaptionFontRec), @CaptionFontRec);
  481.       R := BoundsRect;
  482.       TR := TabRect;
  483.       if Orientation = oVertical then
  484.       begin
  485.         GetTextMetrics(TabCanvas.Handle, TM);
  486.         // Has to be a true type font to be rotated.
  487.         if (TM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then
  488.           StrCopy(CaptionFontRec.lfFaceName, 'Arial');
  489.  
  490.         CaptionFontRec.lfOrientation := 2700;
  491.         CaptionFontRec.lfEscapement := 2700;
  492.         // Could do this to autofit text to the available space.  Need to change
  493.         // the else clause below, though, to get horizontal text.
  494.         // CaptionFontRec.lfHeight := R.Right - R.Left - 2;
  495.         R.Top := TR.Bottom - TR.Top + 10;
  496.  
  497.         TabCanvas.Font.Handle := CreateFontIndirect(CaptionFontRec);
  498.         TabCanvas.Brush.Style := bsClear;
  499.         R.Left := TabCanvas.TextHeight(Caption);
  500.         DrawText(TabCanvas.Handle, PChar(Caption), -1, R, DT_NOCLIP or
  501.           DT_NOPREFIX or DT_SINGLELINE);
  502.       end
  503.       else
  504.       begin
  505.         OffsetRect(R, -Left, -Top);
  506.         R.Left := TR.Right - TR.Left + 10;
  507.         DrawText(TabCanvas.Handle, PChar(Caption), -1, R, DT_VCENTER or
  508.           DT_NOPREFIX or DT_SINGLELINE);
  509.       end;
  510.     end;
  511.  
  512.   finally
  513.     ReleaseDC(Handle, TabCanvas.Handle);
  514.     TabCanvas.Handle := 0;
  515.     TabCanvas.Free;
  516.   end;
  517. end;
  518.  
  519. procedure TdfsToolBar.SetArrowColor(const Value: TColor);
  520. begin
  521.   if FArrowColor <> Value then
  522.   begin
  523.     FArrowColor := Value;
  524.     InvalidateNonclientArea;
  525.   end;
  526. end;
  527.  
  528. procedure TdfsToolBar.SetTabColor(const Value: TColor);
  529. begin
  530.   if FTabColor <> Value then
  531.   begin
  532.     FTabColor := Value;
  533.     InvalidateNonclientArea;
  534.   end;
  535. end;
  536.  
  537. procedure TdfsToolBar.SetTabHighlightColor(const Value: TColor);
  538. begin
  539.   if FTabHighlightColor <> Value then
  540.   begin
  541.     FTabHighlightColor := Value;
  542.     InvalidateNonclientArea;
  543.   end;
  544. end;
  545.  
  546. procedure TdfsToolBar.SetCaption(const Value: string);
  547. begin
  548.   if FCaption <> Value then
  549.   begin
  550.     FCaption := Value;
  551.     InvalidateNonclientArea;
  552.   end;
  553. end;
  554.  
  555. procedure TdfsToolBar.SetHeight(const Value: integer);
  556. begin
  557.   if (Orientation = oHorizontal) and (not FMaximized) then
  558.     FRestoreVal := Value
  559.   else
  560.     inherited Height := Value;
  561. end;
  562.  
  563. procedure TdfsToolBar.SetMaximized(const Value: boolean);
  564. var
  565.   NewVal: integer;
  566. begin
  567.   if FMaximized <> Value then
  568.   begin
  569.     FMaximized := Value;
  570.     if FMaximized then
  571.     begin
  572.       if Orientation = oVertical then
  573.         inherited Width := FRestoreVal
  574.       else
  575.         inherited Height := FRestoreVal;
  576.       inherited AutoSize := FRestoreAutoSize;
  577.       DoMaximize;
  578.     end else begin
  579.       // AutoSize will prevent us from getting small!
  580.       FRestoreAutoSize := AutoSize;
  581.       inherited AutoSize := FALSE;
  582.       if Orientation = oVertical then
  583.       begin
  584.         FRestoreVal := Width;
  585.         NewVal := FTabSizeMaximized;
  586.         if ebLeft in EdgeBorders then
  587.           inc(NewVal, 2);
  588.         if ebRight in EdgeBorders then
  589.           inc(NewVal, 2);
  590.         inherited Width := NewVal;
  591.       end else begin
  592.         FRestoreVal := Height;
  593.         NewVal := FTabSizeMaximized;
  594.         if ebTop in EdgeBorders then
  595.           inc(NewVal, 2);
  596.         if ebBottom in EdgeBorders then
  597.           inc(NewVal, 2);
  598.         inherited Height := NewVal;
  599.       end;
  600.       DoRestore;
  601.     end;
  602.     if HandleAllocated then
  603.       InvalidateNonclientArea;
  604.   end;
  605. end;
  606.  
  607. procedure TdfsToolBar.SetShowTab(const Value: boolean);
  608. begin
  609.   if FShowTab <> Value then
  610.   begin
  611.     FShowTab := Value;
  612.     InvalidateNonclientArea;
  613.   end;
  614. end;
  615.  
  616. procedure TdfsToolBar.SetTabIndent(const Value: integer);
  617. begin
  618.   if FTabIndent <> Value then
  619.   begin
  620.     FTabIndent := Value;
  621.     InvalidateNonclientArea;
  622.   end;
  623. end;
  624.  
  625. procedure TdfsToolBar.SetTabSizeMaximized(const Value: integer);
  626. var
  627.   NewVal: integer;
  628. begin
  629.   if FTabSizeMaximized <> Value then
  630.   begin
  631.     FTabSizeMaximized := Value;
  632.     if not FMaximized then
  633.     begin
  634.       if Orientation = oVertical then
  635.       begin
  636.         NewVal := FTabSizeMaximized;
  637.         if ebLeft in EdgeBorders then
  638.           inc(NewVal, 2);
  639.         if ebRight in EdgeBorders then
  640.           inc(NewVal, 2);
  641.         inherited Width := NewVal;
  642.       end else begin
  643.         NewVal := FTabSizeMaximized;
  644.         if ebTop in EdgeBorders then
  645.           inc(NewVal, 2);
  646.         if ebBottom in EdgeBorders then
  647.           inc(NewVal, 2);
  648.         inherited Height := NewVal;
  649.       end;
  650.     end;
  651.     InvalidateNonclientArea;
  652.   end;
  653. end;
  654.  
  655. procedure TdfsToolBar.SetTabSizeMinimized(const Value: integer);
  656. begin
  657.   if FTabSizeMinimized <> Value then
  658.   begin
  659.     FTabSizeMinimized := Value;
  660.     InvalidateNonclientArea;
  661.   end;
  662. end;
  663.  
  664. procedure TdfsToolBar.SetTextureColor1(const Value: TColor);
  665. begin
  666.   if FTextureColor1 <> Value then
  667.   begin
  668.     FTextureColor1 := Value;
  669.     InvalidateNonclientArea;
  670.   end;
  671. end;
  672.  
  673. procedure TdfsToolBar.SetTextureColor2(const Value: TColor);
  674. begin
  675.   if FTextureColor2 <> Value then
  676.   begin
  677.     FTextureColor2 := Value;
  678.     InvalidateNonclientArea;
  679.   end;
  680. end;
  681.  
  682. procedure TdfsToolBar.SetVersion(const Value: string);
  683. begin
  684.   { empty write method, just needed to get it to show up in Object Inspector }
  685. end;
  686.  
  687. procedure TdfsToolBar.SetWidth(const Value: integer);
  688. begin
  689.   if (Orientation = oVertical) and (not FMaximized) then
  690.     FRestoreVal := Value
  691.   else
  692.     inherited Width := Value;
  693. end;
  694.  
  695. procedure TdfsToolBar.WMNCCalcSize(var Message: TWMNCCalcSize);
  696. begin
  697.   inherited;
  698.  
  699.   if FShowTab then
  700.   begin
  701.     if FMaximized then
  702.     begin
  703.       // Take away some client area (make it non-client) to make room for tab.
  704.       with Message.CalcSize_Params^ do
  705.         if Orientation = oVertical then
  706.           inc(rgrc[0].Top, FTabSizeMaximized + FTabIndent)
  707.         else
  708.           inc(rgrc[0].Left, FTabSizeMaximized + FTabIndent);
  709.     end else begin
  710.       // Everything is non-client, there is no client area, i.e. where toolbar
  711.       // buttons go.  I originally made the rect empty, but that didn't work
  712.       // with toolbars that had AutoSize set to false, so now I move the client
  713.       // rect completely out of the window available.
  714.       with Message.CalcSize_Params^ do
  715. //        SetRectEmpty(rgrc[0]);
  716.       begin
  717.         if Orientation = oVertical then
  718.           inc(rgrc[0].Top, Height)
  719.         else
  720.           inc(rgrc[0].Left, Width);
  721.       end;
  722.     end;
  723.     Message.Result := 0;
  724.   end;
  725. end;
  726.  
  727. procedure TdfsToolBar.WMNCPaint(var Message: TWMNCPaint);
  728. var
  729.   Pt: TPoint;
  730. begin
  731.   inherited;
  732.  
  733.   if FShowTab then
  734.   begin
  735.     GetCursorPos(Pt);
  736.     PaintTab(TabHitTest(Pt.x, Pt.y));
  737.   end;
  738. end;
  739.  
  740. // X, Y are screen-relative, not client-relative!!!
  741. function TdfsToolBar.TabHitTest(X, Y: integer): boolean;
  742. begin
  743.   Result := PtInRect(TabRect{FLastKnownTabRect}, Point(X, Y));
  744. end;
  745.  
  746. procedure TdfsToolBar.WMNCLButtonDown(var Message: TWMNCLButtonDown);
  747. begin
  748.   FGotMouseDown := (Message.HitTest = HTCAPTION);
  749.   if FGotMouseDown then
  750.     Message.Result := 0
  751.   else
  752.     inherited;
  753. end;
  754.  
  755. procedure TdfsToolBar.WMNCLButtonUp(var Message: TWMNCLButtonUp);
  756. begin
  757.   inherited;
  758.  
  759.   if FGotMouseDown and (Message.HitTest = HTCAPTION) and
  760.      not (csDesigning in ComponentState) then
  761.   begin
  762.     Maximized := not Maximized;
  763.  
  764.     FGotMouseDown := FALSE;
  765.   end;
  766. end;
  767.  
  768. procedure TdfsToolBar.WMNCHitTest(var Message: TWMNCHitTest);
  769. begin
  770.   inherited;
  771.  
  772.   if TabHitTest(Message.XPos, Message.YPos) then
  773.   begin
  774.     if csDesigning in ComponentState then
  775.       Message.Result := HTCLIENT // Click to select in IDE.
  776.     else
  777.       Message.Result := HTCAPTION; // Generate WMNCLButtonXXX messages.
  778.  
  779.     if not FIsHighlighted then
  780.       PaintTab(TRUE);
  781.   end else
  782.     if FIsHighlighted then
  783.       PaintTab(FALSE);
  784. end;
  785.  
  786. procedure TdfsToolBar.CMMouseLeave(var Msg: TWMMouse);
  787. begin
  788.   inherited;
  789.  
  790.   if FIsHighlighted then
  791.     PaintTab(FALSE);
  792. end;
  793.  
  794. function TdfsToolBar.DrawArrow(ACanvas: TCanvas; AvailableRect: TRect;
  795.   Offset, ArrowSize: integer; Color: TColor): integer;
  796. var
  797.   x, y, q, i, j: integer;
  798.   ArrowAlign: TAlign;
  799.   OldPen: TColor;
  800. begin
  801.   if not Odd(ArrowSize) then
  802.     Dec(ArrowSize);
  803.   if ArrowSize < 1 then
  804.     ArrowSize := 1;
  805.  
  806.   // The ArrowAlign value is pretty much meaningless as far as a direction goes.
  807.   // I'm just making up a value so I can tell what way I want it done.
  808.   if FMaximized then
  809.   begin
  810.     if Orientation = oVertical then
  811.       ArrowAlign := alRight
  812.     else
  813.       ArrowAlign := alLeft;
  814.   end else begin
  815.     if Orientation = oVertical then
  816.       ArrowAlign := alTop
  817.     else
  818.       ArrowAlign := alBottom;
  819.   end;
  820.   q := ArrowSize * 2 - 1 ;
  821.   Result := q;
  822.   OldPen := ACanvas.Pen.Color;
  823.   ACanvas.Pen.Color := Color;
  824.   with AvailableRect do
  825.   begin
  826.     case ArrowAlign of
  827.       alBottom:
  828.         begin
  829.           if Offset < 0 then
  830.             x := Right + Offset - q
  831.           else
  832.             x := Left + Offset;
  833.           y := Top + ((Bottom - Top - q + 1) div 2);
  834.           for j := x to x + ArrowSize - 1 do
  835.           begin
  836.             for i := y to y + q - 1 do
  837.               ACanvas.Pixels[j, i] := Color;
  838.             inc(y);
  839.             dec(q,2);
  840.           end;
  841.         end;
  842.       alTop:
  843.         begin
  844.           x := Left + ((Right - Left - q + 1) div 2);
  845.           if Offset < 0 then
  846.             y := Bottom + Offset - q
  847.           else
  848.             y := Top + Offset;
  849.           for i := y to y + ArrowSize - 1 do
  850.           begin
  851.             for j := x to x + q - 1 do
  852.               ACanvas.Pixels[j, i] := Color;
  853.             inc(x);
  854.             dec(q,2);
  855.           end;
  856.         end;
  857.       alRight:
  858.         begin
  859.           y := Top + ((Bottom - Top - q) div 2);
  860.           if Offset < 0 then
  861.             x := Left + Offset - q
  862.           else
  863.             x := Left + Offset;
  864.           for j := x to x + ArrowSize - 1 do
  865.           begin
  866.             for i := y to y + q - 1 do
  867.               ACanvas.Pixels[j, i] := Color;
  868.             inc(y);
  869.             dec(q,2);
  870.           end;
  871.         end;
  872.     else // alLeft
  873.       x := Left + ((Right - Left - q) div 2) + 1;
  874.       if Offset < 0 then
  875.         y := Bottom + Offset - q
  876.       else
  877.         y := Top + Offset;
  878.       for i := y to y + ArrowSize - 1 do
  879.       begin
  880.         for j := x to x + q - 1 do
  881.           ACanvas.Pixels[j, i] := Color;
  882.         inc(x);
  883.         dec(q,2);
  884.       end;
  885.     end;
  886.   end;
  887.   ACanvas.Pen.Color := OldPen;
  888. end;
  889.  
  890. procedure TdfsToolBar.DoMaximize;
  891. begin
  892.   if assigned(FOnMaximize) then
  893.     FOnMaximize(Self);
  894. end;
  895.  
  896. procedure TdfsToolBar.DoRestore;
  897. begin
  898.   if assigned(FOnRestore) then
  899.     FOnRestore(Self);
  900. end;
  901.  
  902. function TdfsToolBar.GetAutoSize: boolean;
  903. begin
  904.   // If the component is being written to the DFM file, we need to tell it the
  905.   // toolbar's real AutoSize state if it's minimized.
  906.   if (csWriting in ComponentState) and (not Maximized) then
  907.     Result := FRestoreAutoSize
  908.   else
  909.     Result := inherited AutoSize;
  910. end;
  911.  
  912. procedure TdfsToolBar.ReplacementSetAutoSize(Value: boolean);
  913. begin
  914.   FRestoreAutoSize := Value;
  915.   // Don't pass it on if we are minimized!
  916.   if FMaximized then
  917.     inherited AutoSize := Value;
  918. end;
  919.  
  920.  
  921. function TdfsToolBar.GetAlign: TAlign;
  922. begin
  923.   Result := inherited Align;
  924. end;
  925.  
  926. procedure TdfsToolBar.SetAlign(const Value: TAlign);
  927. begin
  928.   inherited Align := Value;
  929.   InvalidateNonclientArea;
  930. end;
  931.  
  932. procedure TdfsToolBar.CMFontChanged(var TMessage);
  933. begin
  934.   inherited;
  935.   InvalidateNonclientArea;
  936. end;
  937.  
  938. procedure TdfsToolBar.InvalidateNonclientArea;
  939. begin
  940.   // Cause non-client area to repaint
  941.   SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOACTIVATE or
  942.      SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  943. end;
  944.  
  945. function TdfsToolBar.GetOrientation: TdfsOrientation;
  946. var
  947.   R: TRect;
  948. begin
  949.   if Align in [alTop, alBottom] then
  950.     Result := oHorizontal
  951.   else if Align in [alLeft, alRight] then
  952.     Result := oVertical
  953.   else
  954.   begin
  955.     R := BoundsRect;
  956.     if (R.Right - R.Left) > (R.Bottom - R.Top) then
  957.       Result := oHorizontal
  958.     else
  959.       Result := oVertical;
  960.   end;
  961. end;
  962.  
  963. procedure TdfsToolBar.Resize;
  964. begin
  965.   InvalidateNonclientArea;
  966.   inherited;
  967. end;
  968.  
  969. end.
  970.  
  971.