www.pudn.com > dfs.zip > DFSSplitter.pas, change:2001-06-27,size:43141b


{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components } 
 
{------------------------------------------------------------------------------} 
{ TdfsSplitter v2.03                                                           } 
{------------------------------------------------------------------------------} 
{ A descendant of the TSplitter component (D3, C3, & D4) that adds a           } 
{ "maximize - restore" button.  This mimics the behavior of the splitter in    } 
{ Netscape Communicator v4.5.  Clicking the button moves the splitter to its   } 
{ farthest extreme.  Clicking again returns it to the last position.           } 
{                                                                              } 
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     } 
{                                                                              } 
{ Copyright:                                                                   } 
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        } 
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      } 
{ property of the author.                                                      } 
{                                                                              } 
{ Distribution Rights:                                                         } 
{ You are granted a non-exlusive, royalty-free right to produce and distribute } 
{ compiled binary files (executables, DLLs, etc.) that are built with any of   } 
{ the DFS source code unless specifically stated otherwise.                    } 
{ You are further granted permission to redistribute any of the DFS source     } 
{ code in source code form, provided that the original archive as found on the } 
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For } 
{ example, if you create a descendant of TdfsColorButton, you must include in  } 
{ the distribution package the colorbtn.zip file in the exact form that you    } 
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   } 
{                                                                              } 
{ Restrictions:                                                                } 
{ Without the express written consent of the author, you may not:              } 
{   * Distribute modified versions of any DFS source code by itself. You must  } 
{     include the original archive as you found it at the DFS site.            } 
{   * Sell or lease any portion of DFS source code. You are, of course, free   } 
{     to sell any of your own original code that works with, enhances, etc.    } 
{     DFS source code.                                                         } 
{   * Distribute DFS source code for profit.                                   } 
{                                                                              } 
{ Warranty:                                                                    } 
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   } 
{ source code (hereafter "software"). The software is provided to you "AS-IS", } 
{ and all risks and losses associated with it's use are assumed by you. In no  } 
{ event shall the author of the softare, Bradley D. Stowers, be held           } 
{ accountable for any damages or losses that may occur from use or misuse of   } 
{ the software.                                                                } 
{                                                                              } 
{ Support:                                                                     } 
{ Support is provided via the DFS Support Forum, which is a web-based message  } 
{ system.  You can find it at http://www.delphifreestuff.com/discus/           } 
{ All DFS source code is provided free of charge. As such, I can not guarantee } 
{ any support whatsoever. While I do try to answer all questions that I        } 
{ receive, and address all problems that are reported to me, you must          } 
{ understand that I simply can not guarantee that this will always be so.      } 
{                                                                              } 
{ Clarifications:                                                              } 
{ If you need any further information, please feel free to contact me directly.} 
{ This agreement can be found online at my site in the "Miscellaneous" section.} 
{------------------------------------------------------------------------------} 
{ The lateset version of my components are always available on the web at:     } 
{   http://www.delphifreestuff.com/                                            } 
{ See DFSSplitter.txt for notes, known issues, and revision history.           } 
{------------------------------------------------------------------------------} 
{ Date last modified:  June 27, 2001                                           } 
{------------------------------------------------------------------------------} 
 
unit dfsSplitter; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls; 
 
const 
  { This shuts up C++Builder 3 about the redefiniton being different. There 
    seems to be no equivalent in C1.  Sorry. } 
  {$IFDEF DFS_CPPB_3_UP} 
  {$EXTERNALSYM DFS_COMPONENT_VERSION} 
  {$ENDIF} 
  DFS_COMPONENT_VERSION = 'TdfsSplitter v2.03'; 
  MOVEMENT_TOLERANCE = 5; // See WMLButtonUp message handler. 
  DEF_BUTTON_HIGHLIGHT_COLOR = $00FFCFCF; // RGB(207,207,255) 
 
type 
  TdfsButtonWidthType = (btwPixels, btwPercentage); 
  TdfsButtonStyle = (bsNetscape, bsWindows); 
  TdfsWindowsButton = (wbMin, wbMax, wbClose); 
  TdfsWindowsButtons = set of TdfsWindowsButton; 
 
  TdfsSplitter = class(TSplitter) 
  private 
    FShowButton: boolean; 
    FButtonWidthType: TdfsButtonWidthType; 
    FButtonWidth: integer; 
    FOnMaximize: TNotifyEvent; 
    FOnMinimize: TNotifyEvent; 
    FOnRestore: TNotifyEvent; 
    FMaximized: boolean; 
    FMinimized: boolean; 
    // Internal use for "restoring" from "maximized" state 
    FRestorePos: integer; 
    // For internal use to avoid calling GetButtonRect when not necessary 
    FLastKnownButtonRect: TRect; 
    // Internal use to avoid unecessary painting 
    FIsHighlighted: boolean; 
    // Internal for detecting real clicks 
    FGotMouseDown: boolean; 
    FButtonColor: TColor; 
    FButtonHighlightColor: TColor; 
    FArrowColor: TColor; 
    FTextureColor1: TColor; 
    FTextureColor2: TColor; 
    FAutoHighlightColor : boolean; 
    FAllowDrag: boolean; 
    FButtonStyle: TdfsButtonStyle; 
    FWindowsButtons: TdfsWindowsButtons; 
    FOnClose: TNotifyEvent; 
    FButtonCursor: TCursor; 
    procedure SetShowButton(const Value: boolean); 
    procedure SetButtonWidthType(const Value: TdfsButtonWidthType); 
    procedure SetButtonWidth(const Value: integer); 
    function GetButtonRect: TRect; 
    procedure SetMaximized(const Value: boolean); 
    procedure SetMinimized(const Value: boolean); 
    function GetAlign: TAlign; 
    procedure SetAlign(Value: TAlign); 
    procedure SetArrowColor(const Value: TColor); 
    procedure SetButtonColor(const Value: TColor); 
    procedure SetButtonHighlightColor(const Value: TColor); 
    procedure SetButtonStyle(const Value: TdfsButtonStyle); 
    procedure SetTextureColor1(const Value: TColor); 
    procedure SetTextureColor2(const Value: TColor); 
    procedure SetAutoHighLightColor(const Value: boolean); 
    procedure SetAllowDrag(const Value: boolean); 
    procedure SetWindowsButtons(const Value: TdfsWindowsButtons); 
    procedure SetButtonCursor(const Value: TCursor); 
    function GetVersion: string; 
    procedure SetVersion(const Val: string); 
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN; 
    procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP; 
    procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE; 
    procedure CMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER; 
    procedure CMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE; 
  protected 
    // Internal use for moving splitter position with FindControl and 
    // UpdateControlSize 
    FControl: TControl; 
    FDownPos: TPoint; 
 
    procedure LoadOtherProperties(Reader: TReader); dynamic; 
    procedure StoreOtherProperties(Writer: TWriter); dynamic; 
    procedure DefineProperties(Filer: TFiler); override; 
    procedure Paint; override; 
    {$IFDEF DFS_COMPILER_4_UP} 
    function DoCanResize(var NewSize: integer): boolean; override; 
    {$ENDIF} 
    procedure Loaded; override; 
    procedure PaintButton(Highlight: boolean); dynamic; 
    function DrawArrow(ACanvas: TCanvas; AvailableRect: TRect; Offset: integer; 
       ArrowSize: integer; Color: TColor): integer; dynamic; 
    function WindowButtonHitTest(X, Y: integer): TdfsWindowsButton; dynamic; 
    function ButtonHitTest(X, Y: integer): boolean; dynamic; 
    procedure DoMaximize; dynamic; 
    procedure DoMinimize; dynamic; 
    procedure DoRestore; dynamic; 
    procedure DoClose; dynamic; 
    procedure FindControl; dynamic; 
    procedure UpdateControlSize(NewSize: integer); dynamic; 
    function GrabBarColor: TColor; 
    function VisibleWinButtons: integer; 
  public 
    constructor Create(AOwner: TComponent); override; 
 
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 
 
    property ButtonRect: TRect 
       read GetButtonRect; 
    property RestorePos: integer 
       read FRestorePos 
       write FRestorePos; 
  published 
    property Maximized: boolean 
       read FMaximized 
       write SetMaximized; 
    property Minimized: boolean 
       read FMinimized 
       write SetMinimized; 
 
 
    property Version: string 
       read GetVersion 
       write SetVersion 
       stored FALSE; 
    property AllowDrag: boolean 
       read FAllowDrag 
       write SetAllowDrag 
       default TRUE; 
    property ButtonCursor: TCursor 
       read FButtonCursor 
       write SetButtonCursor; 
    property ButtonStyle: TdfsButtonStyle 
       read FButtonStyle 
       write SetButtonStyle 
       default bsNetscape; 
    property WindowsButtons: TdfsWindowsButtons 
       read FWindowsButtons 
       write SetWindowsButtons 
       default [wbMin, wbMax, wbClose]; 
    property ButtonWidthType: TdfsButtonWidthType 
       read FButtonWidthType 
       write SetButtonWidthType 
       default btwPixels; 
    property ButtonWidth: integer 
       read FButtonWidth 
       write SetButtonWidth 
       default 100; 
    property ShowButton: boolean 
       read FShowButton 
       write SetShowButton 
       default TRUE; 
    property ButtonColor: TColor 
       read FButtonColor 
       write SetButtonColor 
       default clBtnFace; 
    property ArrowColor: TColor 
       read FArrowColor 
       write SetArrowColor 
       default clNavy; 
    property ButtonHighlightColor: TColor 
       read FButtonHighlightColor 
       write SetButtonHighlightColor 
       default DEF_BUTTON_HIGHLIGHT_COLOR; 
    property AutoHighlightColor: Boolean 
       read FAutoHighlightColor 
       write SetAutoHighlightColor 
       default FALSE; 
    property TextureColor1: TColor 
       read FTextureColor1 
       write SetTextureColor1 
       default clWhite; 
    property TextureColor2: TColor 
       read FTextureColor2 
       write SetTextureColor2 
       default clNavy; 
    property Align: TAlign // Need to know when it changes to redraw arrows 
       read GetAlign 
       write SetAlign; 
    property Width 
       default 10;  // it looks best with 10 
    property Beveled 
       default FALSE; // it looks best without the bevel 
    property Enabled; 
 
    property OnClose: TNotifyEvent 
       read FOnClose 
       write FOnClose; 
    property OnMaximize: TNotifyEvent 
       read FOnMaximize 
       write FOnMaximize; 
    property OnMinimize: TNotifyEvent 
       read FOnMinimize 
       write FOnMinimize; 
    property OnRestore: TNotifyEvent 
       read FOnRestore 
       write FOnRestore; 
  end; 
 
implementation 
 
{ TdfsSplitter } 
 
constructor TdfsSplitter.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
 
  Beveled := FALSE; 
  FAllowDrag := TRUE; 
  FButtonStyle := bsNetscape; 
  FWindowsButtons := [wbMin, wbMax, wbClose]; 
  FButtonWidthType := btwPixels; 
  FButtonWidth := 100; 
  FShowButton := TRUE; 
  SetRectEmpty(FLastKnownButtonRect); 
  FIsHighlighted := FALSE; 
  FGotMouseDown := FALSE; 
  FControl := NIL; 
  FDownPos := Point(0,0); 
  FMaximized := FALSE; 
  FMinimized := FALSE; 
  FRestorePos := -1; 
  Width := 10; 
  FButtonColor := clBtnFace; 
  FArrowColor := clNavy; 
  FButtonHighlightColor := DEF_BUTTON_HIGHLIGHT_COLOR; 
  FAutoHighLightColor := FALSE; 
  FTextureColor1 := clWhite; 
  FTextureColor2 := clNavy; 
end; 
 
function TdfsSplitter.GrabBarColor: TColor; 
var 
  BeginRGB: array[0..2] of Byte; 
  RGBDifference: array[0..2] of integer; 
  R,G,B: Byte; 
  BeginColor, 
  EndColor: TColor; 
  NumberOfColors: integer; 
 
begin 
  //Need to figure out how many colors available at runtime 
  NumberOfColors := 256; 
 
  BeginColor := clActiveCaption; 
  EndColor := clBtnFace; 
 
  BeginRGB[0] := GetRValue(ColorToRGB(BeginColor)); 
  BeginRGB[1] := GetGValue(ColorToRGB(BeginColor)); 
  BeginRGB[2] := GetBValue(ColorToRGB(BeginColor)); 
 
  RGBDifference[0] := GetRValue(ColorToRGB(EndColor)) - BeginRGB[0]; 
  RGBDifference[1] := GetGValue(ColorToRGB(EndColor)) - BeginRGB[1]; 
  RGBDifference[2] := GetBValue(ColorToRGB(EndColor)) - BeginRGB[2]; 
 
  R := BeginRGB[0] + MulDiv (180, RGBDifference[0], NumberOfColors - 1); 
  G := BeginRGB[1] + MulDiv (180, RGBDifference[1], NumberOfColors - 1); 
  B := BeginRGB[2] + MulDiv (180, RGBDifference[2], NumberOfColors - 1); 
 
  Result := RGB (R, G, B); 
end; 
 
function TdfsSplitter.DrawArrow(ACanvas: TCanvas; AvailableRect: TRect; Offset: integer; 
   ArrowSize: integer; Color: TColor): integer; 
var 
  x, y, q, i, j: integer; 
  ArrowAlign: TAlign; 
begin 
  // STB Nitro drivers have a LineTo bug, so I've opted to use the slower 
  // SetPixel method to draw the arrows. 
 
  if not Odd(ArrowSize) then 
    Dec(ArrowSize); 
  if ArrowSize < 1 then 
    ArrowSize := 1; 
 
  if FMaximized then 
  begin 
    case Align of 
      alLeft:   ArrowAlign := alRight; 
      alRight:  ArrowAlign := alLeft; 
      alTop:    ArrowAlign := alBottom; 
    else //alBottom 
      ArrowAlign := alTop; 
    end; 
  end else 
    ArrowAlign := Align; 
  q := ArrowSize * 2 - 1 ; 
  Result := q; 
  ACanvas.Pen.Color := Color; 
  with AvailableRect do 
  begin 
    case ArrowAlign of 
      alLeft: 
        begin 
          x := Left + ((Right - Left - ArrowSize) div 2) + 1; 
          if Offset < 0 then 
            y := Bottom + Offset - q 
          else 
            y := Top + Offset; 
          for j := x + ArrowSize - 1 downto x do 
          begin 
            for i := y to y + q - 1 do 
              ACanvas.Pixels[j, i] := Color; 
            inc(y); 
            dec(q,2); 
          end; 
        end; 
      alRight: 
        begin 
          x := Left + ((Right - Left - ArrowSize) div 2) + 1; 
          if Offset < 0 then 
            y := Bottom + Offset - q 
          else 
            y := Top + Offset; 
          for j := x to x + ArrowSize - 1 do 
          begin 
            for i := y to y + q - 1 do 
              ACanvas.Pixels[j, i] := Color; 
            inc(y); 
            dec(q,2); 
          end; 
        end; 
      alTop: 
        begin 
          if Offset < 0 then 
            x := Right + Offset - q 
          else 
            x := Left + Offset; 
          y := Top + ((Bottom - Top - ArrowSize) div 2) + 1; 
          for i := y + ArrowSize - 1 downto y do 
          begin 
            for j := x to x + q - 1 do 
              ACanvas.Pixels[j, i] := Color; 
            inc(x); 
            dec(q,2); 
          end; 
        end; 
    else // alBottom 
      if Offset < 0 then 
        x := Right + Offset - q 
      else 
        x := Left + Offset; 
      y := Top + ((Bottom - Top - ArrowSize) div 2) + 1; 
      for i := y to y + ArrowSize - 1 do 
      begin 
        for j := x to x + q - 1 do 
          ACanvas.Pixels[j, i] := Color; 
        inc(x); 
        dec(q,2); 
      end; 
    end; 
  end; 
end; 
 
function TdfsSplitter.GetButtonRect: TRect; 
var 
  BW: integer; 
begin 
  if ButtonStyle = bsWindows then 
  begin 
    if Align in [alLeft, alRight] then 
      BW := (ClientRect.Right - ClientRect.Left) * VisibleWinButtons 
    else 
      BW := (ClientRect.Bottom - ClientRect.Top) * VisibleWinButtons; 
    if BW < 1 then 
      SetRectEmpty(Result) 
    else 
    begin 
      if Align in [alLeft, alRight] then 
        Result := Rect(0, 0, ClientRect.Right - ClientRect.Left, BW - 
          VisibleWinButtons) 
      else 
        Result := Rect(ClientRect.Right - BW + VisibleWinButtons, 0, 
          ClientRect.Right, ClientRect.Bottom - ClientRect.Top); 
      InflateRect(Result, -1, -1); 
    end; 
  end 
  else 
  begin 
    // Calc the rectangle the button goes in 
    if ButtonWidthType = btwPercentage then 
    begin 
      if Align in [alLeft, alRight] then 
        BW := ClientRect.Bottom - ClientRect.Top 
      else 
        BW := ClientRect.Right - ClientRect.Left; 
      BW := MulDiv(BW, FButtonWidth, 100); 
    end 
    else 
      BW := FButtonWidth; 
    if BW < 1 then 
      SetRectEmpty(Result) 
    else 
    begin 
      Result := ClientRect; 
      if Align in [alLeft, alRight] then 
      begin 
        Result.Top := (ClientRect.Bottom - ClientRect.Top - BW) div 2; 
        Result.Bottom := Result.Top + BW; 
        InflateRect(Result, -1, 0); 
      end 
      else 
      begin 
        Result.Left := (ClientRect.Right - ClientRect.Left - BW) div 2; 
        Result.Right := Result.Left + BW; 
        InflateRect(Result, 0, -1); 
      end; 
    end; 
  end; 
  if not IsRectEmpty(Result) then 
  begin 
    if Result.Top < 1 then 
      Result.Top := 1; 
    if Result.Left < 1 then 
      Result.Left := 1; 
    if Result.Bottom >= ClientRect.Bottom then 
      Result.Bottom := ClientRect.Bottom - 1; 
    if Result.Right >= ClientRect.Right then 
      Result.Right := ClientRect.Right - 1; 
    // Make smaller if it's beveled 
    if Beveled then 
      if Align in [alLeft, alRight] then 
        InflateRect(Result, -3, 0) 
      else 
        InflateRect(Result, 0, -3); 
  end; 
  FLastKnownButtonRect := Result; 
end; 
 
procedure TdfsSplitter.Paint; 
begin 
// Exclude button rect from update region here for less flicker. 
  inherited Paint; 
 
// Don't paint while being moved unless ResizeStyle = rsUpdate!!! 
// Make rect smaller if Beveled is true. 
  PaintButton(FIsHighlighted); 
end; 
 
{$IFDEF DFS_COMPILER_4_UP} 
function TdfsSplitter.DoCanResize(var NewSize: integer): boolean; 
begin 
  Result := inherited DoCanResize(NewSize); 
  // D4 version has a bug that causes it to not honor MinSize, which causes a 
  // really nasty problem. 
  if Result and (NewSize < MinSize) then 
    NewSize := MinSize; 
end; 
{$ENDIF} 
 
procedure TdfsSplitter.PaintButton(Highlight: boolean); 
const 
  TEXTURE_SIZE = 3; 
var 
  BtnRect: TRect; 
  CaptionBtnRect: TRect; 
  BW: integer; 
  TextureBmp: TBitmap; 
  x, y: integer; 
  RW, RH: integer; 
  OffscreenBmp: TBitmap; 
  WinButton: array[0..2] of TdfsWindowsButton; 
  b: TdfsWindowsButton; 
  BtnFlag: UINT; 
begin 
  if (not FShowButton) or (not Enabled) or (GetParentForm(Self) = NIL) then 
    exit; 
 
  if FAutoHighLightColor then 
    FButtonHighlightColor := GrabBarColor; 
 
  BtnRect := ButtonRect; // So we don't repeatedly call GetButtonRect 
  if IsRectEmpty(BtnRect) then 
    exit; // nothing to draw 
 
  OffscreenBmp := TBitmap.Create; 
  try 
    OffsetRect(BtnRect, -BtnRect.Left, -BtnRect.Top); 
    OffscreenBmp.Width := BtnRect.Right; 
    OffscreenBmp.Height := BtnRect.Bottom; 
 
    if ButtonStyle = bsWindows then 
    begin 
      OffscreenBmp.Canvas.Brush.Color := Color; 
      OffscreenBmp.Canvas.FillRect(BtnRect); 
      if Align in [alLeft, alRight] then 
        BW := BtnRect.Right 
      else 
        BW := BtnRect.Bottom; 
      FillChar(WinButton, SizeOf(WinButton), 0); 
      x := 0; 
      if Align in [alLeft, alRight] then 
      begin 
        for b := High(TdfsWindowsButton) downto Low(TdfsWindowsButton) do 
          if b in WindowsButtons then 
          begin 
            WinButton[x] := b; 
            inc(x); 
          end; 
      end 
      else 
      begin 
        for b := Low(TdfsWindowsButton) to High(TdfsWindowsButton) do 
          if b in WindowsButtons then 
          begin 
            WinButton[x] := b; 
            inc(x); 
          end; 
      end; 
      for x := 0 to VisibleWinButtons - 1 do 
      begin 
        if Align in [alLeft, alRight] then 
          CaptionBtnRect := Bounds(0, x * BW, BW, BW) 
        else 
          CaptionBtnRect := Bounds(x * BW, 0, BW, BW); 
        BtnFlag := 0; 
        case WinButton[x] of 
          wbMin: 
            begin 
              if Minimized then 
                BtnFlag := DFCS_CAPTIONRESTORE 
              else 
                BtnFlag := DFCS_CAPTIONMIN; 
            end; 
          wbMax: 
            begin 
              if Maximized then 
                BtnFlag := DFCS_CAPTIONRESTORE 
              else 
                BtnFlag := DFCS_CAPTIONMAX; 
            end; 
          wbClose: 
            begin 
              BtnFlag := DFCS_CAPTIONCLOSE; 
            end; 
        end; 
        DrawFrameControl(OffscreenBmp.Canvas.Handle, CaptionBtnRect, DFC_CAPTION, 
          BtnFlag); 
      end; 
    end 
    else 
    begin 
      // Draw basic button 
      OffscreenBmp.Canvas.Brush.Color := clGray; 
      OffscreenBmp.Canvas.FrameRect(BtnRect); 
      InflateRect(BtnRect, -1, -1); 
 
      OffscreenBmp.Canvas.Pen.Color := clWhite; 
      with BtnRect, OffscreenBmp.Canvas do 
      begin 
        // This is not going to work with the STB bug.  Have to find workaround. 
        MoveTo(Left, Bottom-1); 
        LineTo(Left, Top); 
        LineTo(Right, Top); 
      end; 
      Inc(BtnRect.Left); 
      Inc(BtnRect.Top); 
 
      if Highlight then 
        OffscreenBmp.Canvas.Brush.Color := ButtonHighlightColor 
      else 
        OffscreenBmp.Canvas.Brush.Color := ButtonColor; 
      OffscreenBmp.Canvas.FillRect(BtnRect); 
      FIsHighlighted := Highlight; 
      Dec(BtnRect.Right); 
      Dec(BtnRect.Bottom); 
 
      // Draw the insides of the button 
      with BtnRect do 
      begin 
        // Draw the arrows 
        if Align in [alLeft, alRight] then 
        begin 
          InflateRect(BtnRect, 0, -4); 
          BW := BtnRect.Right - BtnRect.Left; 
          DrawArrow(OffscreenBmp.Canvas, BtnRect, 1, BW, ArrowColor); 
          BW := DrawArrow(OffscreenBmp.Canvas, BtnRect, -1, BW, ArrowColor); 
          InflateRect(BtnRect, 0, -(BW+4)); 
        end else begin 
          InflateRect(BtnRect, -4, 0); 
          BW := BtnRect.Bottom - BtnRect.Top; 
          DrawArrow(OffscreenBmp.Canvas, BtnRect, 1, BW, ArrowColor); 
          BW := DrawArrow(OffscreenBmp.Canvas, BtnRect, -1, BW, ArrowColor); 
          InflateRect(BtnRect, -(BW+4), 0); 
        end; 
 
        // Draw the texture 
        // Note: This is so complex because I'm trying to make as much like the 
        //       Netscape splitter as possible.  They use a 3x3 texture pattern, and 
        //       that's harder to tile.  If the had used an 8x8 (or smaller 
        //       divisibly, i.e. 2x2 or 4x4), I could have used Brush.Bitmap and 
        //       FillRect and they whole thing would have been about half the size, 
        //       twice as fast, and 1/10th as complex. 
        RW := BtnRect.Right - BtnRect.Left; 
        RH := BtnRect.Bottom - BtnRect.Top; 
        if (RW >= TEXTURE_SIZE) and (RH >= TEXTURE_SIZE) then 
        begin 
          TextureBmp := TBitmap.Create; 
          try 
            with TextureBmp do 
            begin 
              Width := RW; 
              Height := RH; 
              // Draw first square 
              Canvas.Brush.Color := OffscreenBmp.Canvas.Brush.Color; 
              Canvas.FillRect(Rect(0, 0, RW+1, RH+1)); 
              Canvas.Pixels[1,1] := TextureColor1; 
              Canvas.Pixels[2,2] := TextureColor2; 
 
              // Tile first square all the way across 
              for x := 1 to ((RW div TEXTURE_SIZE) + ord(RW mod TEXTURE_SIZE > 0)) do 
              begin 
                Canvas.CopyRect(Bounds(x * TEXTURE_SIZE, 0, TEXTURE_SIZE, 
                   TEXTURE_SIZE), Canvas, Rect(0, 0, TEXTURE_SIZE, TEXTURE_SIZE)); 
              end; 
 
              // Tile first row all the way down 
              for y := 1 to ((RH div TEXTURE_SIZE) + ord(RH mod TEXTURE_SIZE > 0)) do 
              begin 
                Canvas.CopyRect(Bounds(0, y * TEXTURE_SIZE, RW, TEXTURE_SIZE), 
                   Canvas, Rect(0, 0, RW, TEXTURE_SIZE)); 
              end; 
 
              // Above could be better if it reversed process when splitter was 
              // taller than it was wider.  Optimized only for horizontal right now. 
            end; 
            // Copy texture bitmap to the screen. 
            OffscreenBmp.Canvas.CopyRect(BtnRect, TextureBmp.Canvas, 
               Rect(0, 0, RW, RH)); 
          finally 
            TextureBmp.Free; 
          end; 
        end; 
      end; 
    end; 
(**) 
    Canvas.CopyRect(ButtonRect, OffscreenBmp.Canvas, Rect(0, 0, 
       OffscreenBmp.Width, OffscreenBmp.Height)); 
  finally 
    OffscreenBmp.Free; 
  end; 
end; 
 
procedure TdfsSplitter.SetButtonWidth(const Value: integer); 
begin 
  if Value <> FButtonWidth then 
  begin 
    FButtonWidth := Value; 
    if (FButtonWidthType = btwPercentage) and (FButtonWidth > 100) then 
      FButtonWidth := 100; 
    if FButtonWidth < 0 then 
      FButtonWidth := 0; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.SetButtonWidthType(const Value: TdfsButtonWidthType); 
begin 
  if Value <> FButtonWidthType then 
  begin 
    FButtonWidthType := Value; 
    if (FButtonWidthType = btwPercentage) and (FButtonWidth > 100) then 
      FButtonWidth := 100; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.SetShowButton(const Value: boolean); 
begin 
  if Value <> FShowButton then 
  begin 
    FShowButton := Value; 
    SetRectEmpty(FLastKnownButtonRect); 
    Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.WMMouseMove(var Msg: TWMMouseMove); 
begin 
  if AllowDrag then 
  begin 
    inherited; 
 
    // The order is important here.  ButtonHitTest must be evaluated before 
    // the ButtonStyle because it will change the cursor (over button or not). 
    // If the order were reversed, the cursor would not get set for bsWindows 
    // style since short-circuit boolean eval would stop it from ever being 
    // called in the first place. 
    if ButtonHitTest(Msg.XPos, Msg.YPos) and (ButtonStyle = bsNetscape) then 
    begin 
      if not FIsHighlighted then 
        PaintButton(TRUE) 
    end else 
      if FIsHighlighted then 
        PaintButton(FALSE); 
  end else 
    DefaultHandler(Msg); // Bypass TSplitter and just let normal handling occur. 
end; 
 
procedure TdfsSplitter.CMMouseEnter(var Msg: TWMMouse); 
var 
  Pos: TPoint; 
begin 
  inherited; 
 
  GetCursorPos(Pos); // CM_MOUSEENTER doesn't send mouse pos. 
  Pos := Self.ScreenToClient(Pos); 
  // The order is important here.  ButtonHitTest must be evaluated before 
  // the ButtonStyle because it will change the cursor (over button or not). 
  // If the order were reversed, the cursor would not get set for bsWindows 
  // style since short-circuit boolean eval would stop it from ever being 
  // called in the first place. 
  if ButtonHitTest(Pos.x, Pos.y) and (ButtonStyle = bsNetscape) then 
  begin 
    if not FIsHighlighted then 
      PaintButton(TRUE) 
  end else 
    if FIsHighlighted then 
      PaintButton(FALSE); 
end; 
 
procedure TdfsSplitter.CMMouseLeave(var Msg: TWMMouse); 
begin 
  inherited; 
 
  if (ButtonStyle = bsNetscape) and FIsHighlighted then 
    PaintButton(FALSE); 
 
  FGotMouseDown := FALSE; 
end; 
 
procedure TdfsSplitter.WMLButtonDown(var Msg: TWMLButtonDown); 
begin 
  if Enabled then 
  begin 
    FGotMouseDown := ButtonHitTest(Msg.XPos, Msg.YPos); 
    if FGotMouseDown then 
    begin 
      FindControl; 
      FDownPos := ClientToScreen(Point(Msg.XPos, Msg.YPos)); 
    end; 
  end; 
  if AllowDrag then 
    inherited // Let TSplitter have it. 
  else 
    // Bypass TSplitter and just let normal handling occur. Prevents drag painting. 
    DefaultHandler(Msg); 
end; 
 
procedure TdfsSplitter.WMLButtonUp(var Msg: TWMLButtonUp); 
var 
  CurPos: TPoint; 
  OldMax: boolean; 
begin 
  inherited; 
 
  if FGotMouseDown then 
  begin 
    if ButtonHitTest(Msg.XPos, Msg.YPos) then 
    begin 
      CurPos := ClientToScreen(Point(Msg.XPos, Msg.YPos)); 
      // More than a little movement is not a click, but a regular resize. 
      if ((Align in [alLeft, alRight]) and 
         (Abs(FDownPos.x - CurPos.X) <= MOVEMENT_TOLERANCE)) or 
         ((Align in [alTop, alBottom]) and 
         (Abs(FDownPos.y - CurPos.Y) <= MOVEMENT_TOLERANCE)) then 
      begin 
        StopSizing; 
        if ButtonStyle = bsNetscape then 
          Maximized := not Maximized 
        else 
          case WindowButtonHitTest(Msg.XPos, Msg.YPos) of 
            wbMin: Minimized := not Minimized; 
            wbMax: Maximized := not Maximized; 
            wbClose: DoClose; 
          end; 
      end; 
    end; 
    FGotMouseDown := FALSE; 
  end 
  else if AllowDrag then 
  begin 
    FindControl; 
    if FControl = NIL then 
      exit; 
 
    OldMax := FMaximized; 
    case Align of 
      alLeft, alRight: FMaximized := FControl.Width <= MinSize; 
      alTop, alBottom: FMaximized := FControl.Height <= MinSize; 
    end; 
    if FMaximized then 
    begin 
      UpdateControlSize(MinSize); 
      if not OldMax then 
        DoMaximize; 
    end 
    else 
    begin 
      case Align of 
        alLeft, 
        alRight:  FRestorePos := FControl.Width; 
        alTop, 
        alBottom: FRestorePos := FControl.Height; 
      end; 
      if OldMax then 
        DoRestore; 
    end; 
  end; 
  Invalidate; 
end; 
 
function TdfsSplitter.WindowButtonHitTest(X, Y: integer): TdfsWindowsButton; 
var 
  BtnRect: TRect; 
  i: integer; 
  b: TdfsWindowsButton; 
  WinButton: array[0..2] of TdfsWindowsButton; 
  BW: integer; 
  BRs: array[0..2] of TRect; 
begin 
  Result := wbMin; 
  // Figure out which one was hit.  This function assumes ButtonHitTest has 
  // been called and returned TRUE. 
  BtnRect := ButtonRect; // So we don't repeatedly call GetButtonRect 
  i := 0; 
  if Align in [alLeft, alRight] then 
  begin 
    for b := High(TdfsWindowsButton) downto Low(TdfsWindowsButton) do 
      if b in WindowsButtons then 
      begin 
        WinButton[i] := b; 
        inc(i); 
      end; 
  end 
  else 
    for b := Low(TdfsWindowsButton) to High(TdfsWindowsButton) do 
      if b in WindowsButtons then 
      begin 
        WinButton[i] := b; 
        inc(i); 
      end; 
 
  if Align in [alLeft, alRight] then 
    BW := BtnRect.Right - BtnRect.Left 
  else 
    BW := BtnRect.Bottom - BtnRect.Top; 
  FillChar(BRs, SizeOf(BRs), 0); 
  for i := 0 to VisibleWinButtons - 1 do 
    if ((Align in [alLeft, alRight]) and PtInRect(Bounds(BtnRect.Left, 
      BtnRect.Top + (BW * i), BW, BW), Point(X, Y))) or ((Align in [alTop, 
      alBottom]) and PtInRect(Bounds(BtnRect.Left + (BW * i), BtnRect.Top, BW, 
      BW), Point(X, Y))) then 
    begin 
      Result := WinButton[i]; 
      break; 
    end; 
end; 
 
function TdfsSplitter.ButtonHitTest(X, Y: integer): boolean; 
begin 
  // We use FLastKnownButtonRect here so that we don't have to recalculate the 
  // button rect with GetButtonRect every time the mouse moved.  That would be 
  // EXTREMELY inefficient. 
  Result := PtInRect(FLastKnownButtonRect, Point(X, Y)); 
  if Align in [alLeft, alRight] then 
  begin 
    if (not AllowDrag) or ((Y >= FLastKnownButtonRect.Top) and 
      (Y <= FLastKnownButtonRect.Bottom)) then 
      Cursor := FButtonCursor 
    else 
      Cursor := crHSplit; 
  end else begin 
    if (not AllowDrag) or ((X >= FLastKnownButtonRect.Left) and 
      (X <= FLastKnownButtonRect.Right)) then 
      Cursor := FButtonCursor 
    else 
      Cursor := crVSplit; 
  end; 
end; 
 
procedure TdfsSplitter.DoMaximize; 
begin 
  if assigned(FOnMaximize) then 
    FOnMaximize(Self); 
end; 
 
 
procedure TdfsSplitter.DoRestore; 
begin 
  if assigned(FOnRestore) then 
    FOnRestore(Self); 
end; 
 
//DoClose 
 
procedure TdfsSplitter.SetMaximized(const Value: boolean); 
begin 
  if Value <> FMaximized then 
  begin 
 
    if csLoading in ComponentState then 
    begin 
      FMaximized := Value; 
      exit; 
    end; 
 
    FindControl; 
    if FControl = NIL then 
      exit; 
 
    if Value then 
    begin 
      if FMinimized then 
        FMinimized := FALSE 
      else 
      begin 
        case Align of 
          alLeft, 
          alRight:  FRestorePos := FControl.Width; 
          alTop, 
          alBottom: FRestorePos := FControl.Height; 
        else 
          exit; 
        end; 
      end; 
      if ButtonStyle = bsNetscape then 
        UpdateControlSize(-3000) 
      else 
        case Align of 
          alLeft, 
          alBottom: UpdateControlSize(3000); 
          alRight, 
          alTop: UpdateControlSize(-3000); 
        else 
          exit; 
        end; 
      FMaximized := Value; 
      DoMaximize; 
    end 
    else 
    begin 
      UpdateControlSize(FRestorePos); 
      FMaximized := Value; 
      DoRestore; 
    end; 
  end; 
end; 
 
procedure TdfsSplitter.SetMinimized(const Value: boolean); 
begin 
  if Value <> FMinimized then 
  begin 
 
    if csLoading in ComponentState then 
    begin 
      FMinimized := Value; 
      exit; 
    end; 
 
    FindControl; 
    if FControl = NIL then 
      exit; 
 
    if Value then 
    begin 
      if FMaximized then 
        FMaximized := FALSE 
      else 
      begin 
        case Align of 
          alLeft, 
          alRight:  FRestorePos := FControl.Width; 
          alTop, 
          alBottom: FRestorePos := FControl.Height; 
        else 
          exit; 
        end; 
      end; 
      FMinimized := Value; 
      // Just use something insanely large to get it to move to the other extreme 
      case Align of 
        alLeft, 
        alBottom: UpdateControlSize(-3000); 
        alRight, 
        alTop: UpdateControlSize(3000); 
      else 
        exit; 
      end; 
      DoMinimize; 
    end 
    else 
    begin 
      FMinimized := Value; 
      UpdateControlSize(FRestorePos); 
      DoRestore; 
    end; 
  end; 
end; 
 
function TdfsSplitter.GetAlign: TAlign; 
begin 
  Result := inherited Align; 
end; 
 
procedure TdfsSplitter.SetAlign(Value: TAlign); 
begin 
  inherited Align := Value; 
 
  Invalidate; // Direction changing, redraw arrows. 
  {$IFNDEF DFS_COMPILER_4_UP} 
  // D4 does this already 
  if (Cursor <> crVSplit) and (Cursor <> crHSplit) then Exit; 
  if Align in [alBottom, alTop] then 
    Cursor := crVSplit 
  else 
    Cursor := crHSplit; 
  {$ENDIF} 
end; 
 
 
procedure TdfsSplitter.FindControl; 
var 
  P: TPoint; 
  I: Integer; 
  R: TRect; 
begin 
  if Parent = NIL then 
    exit; 
  FControl := NIL; 
  P := Point(Left, Top); 
  case Align of 
    alLeft: Dec(P.X); 
    alRight: Inc(P.X, Width); 
    alTop: Dec(P.Y); 
    alBottom: Inc(P.Y, Height); 
  else 
    Exit; 
  end; 
  for I := 0 to Parent.ControlCount - 1 do 
  begin 
    FControl := Parent.Controls[I]; 
    if FControl.Visible and FControl.Enabled then 
    begin 
      R := FControl.BoundsRect; 
      if (R.Right - R.Left) = 0 then 
        Dec(R.Left); 
      if (R.Bottom - R.Top) = 0 then 
        Dec(R.Top); 
      if PtInRect(R, P) then 
        Exit; 
    end; 
  end; 
  FControl := NIL; 
end; 
 
 
procedure TdfsSplitter.UpdateControlSize(NewSize: integer); 
  procedure MoveViaMouse(FromPos, ToPos: integer; Horizontal: boolean); 
  begin 
    if Horizontal then 
    begin 
      MouseDown(mbLeft, [ssLeft], FromPos, 0); 
      MouseMove([ssLeft], ToPos, 0); 
      MouseUp(mbLeft, [ssLeft], ToPos, 0); 
    end 
    else 
    begin 
      MouseDown(mbLeft, [ssLeft], 0, FromPos); 
      MouseMove([ssLeft], 0, ToPos); 
      MouseUp(mbLeft, [ssLeft], 0, ToPos); 
    end; 
  end; 
begin 
  if (FControl <> NIL) then 
  begin 
    { You'd think that using FControl directly would be the way to change it's 
      position (and thus the splitter's position), wouldn't you?  But, TSplitter 
      has this nutty idea that the only way a control's size will change is if 
      the mouse moves the splitter.  If you size the control manually, the 
      splitter has an internal variable (FOldSize) that will not get updated. 
      Because of this, if you try to then move the newly positioned splitter 
      back to the old position, it won't go there (NewSize <> OldSize must be 
      true).  Now, what are the odds that the user will move the splitter back 
      to the exact same pixel it used to be on?  Normally, extremely low.  But, 
      if the splitter has been restored from it's minimized position, it then 
      becomes quite likely:  i.e. they drag it back all the way to the min 
      position.  What a pain. } 
    case Align of 
      alLeft: MoveViaMouse(Left, FControl.Left + NewSize, TRUE); 
              // alLeft: FControl.Width := NewSize; 
      alTop: MoveViaMouse(Top, FControl.Top + NewSize, FALSE); 
             // FControl.Height := NewSize; 
      alRight: MoveViaMouse(Left, (FControl.Left + FControl.Width - Width) - NewSize, TRUE); 
        {begin 
          Parent.DisableAlign; 
          try 
            FControl.Left := FControl.Left + (FControl.Width - NewSize); 
            FControl.Width := NewSize; 
          finally 
            Parent.EnableAlign; 
          end; 
        end;} 
      alBottom: MoveViaMouse(Top, (FControl.Top + FControl.Height - Height) - NewSize, FALSE); 
        {begin 
          Parent.DisableAlign; 
          try 
            FControl.Top := FControl.Top + (FControl.Height - NewSize); 
            FControl.Height := NewSize; 
          finally 
            Parent.EnableAlign; 
          end; 
        end;} 
    end; 
    Update; 
  end; 
end; 
 
procedure TdfsSplitter.SetArrowColor(const Value: TColor); 
begin 
  if FArrowColor <> Value then 
  begin 
    FArrowColor := Value; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.SetButtonColor(const Value: TColor); 
begin 
  if FButtonColor <> Value then 
  begin 
    FButtonColor := Value; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.SetButtonHighlightColor(const Value: TColor); 
begin 
  if FButtonHighlightColor <> Value then 
  begin 
    FButtonHighlightColor := Value; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.SetAutoHighlightColor(const Value: boolean); 
begin 
  if FAutoHighLightColor <> Value then 
  begin 
    FAutoHighLightColor := Value; 
    if FAutoHighLightColor then 
      FButtonHighLightColor := GrabBarColor 
    else 
      FButtonHighLightColor := DEF_BUTTON_HIGHLIGHT_COLOR; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.SetTextureColor1(const Value: TColor); 
begin 
  if FTextureColor1 <> Value then 
  begin 
    FTextureColor1 := Value; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
procedure TdfsSplitter.SetTextureColor2(const Value: TColor); 
begin 
  if FTextureColor2 <> Value then 
  begin 
    FTextureColor2 := Value; 
    if (ButtonStyle = bsNetscape) and ShowButton then 
      Invalidate; 
  end; 
end; 
 
function TdfsSplitter.GetVersion: string; 
begin 
  Result := DFS_COMPONENT_VERSION; 
end; 
 
procedure TdfsSplitter.SetVersion(const Val: string); 
begin 
  { empty write method, just needed to get it to show up in Object Inspector } 
end; 
 
 
procedure TdfsSplitter.Loaded; 
begin 
  inherited Loaded; 
  if FRestorePos = -1 then 
  begin 
    FindControl; 
    if FControl <> NIL then 
      case Align of 
        alLeft, 
        alRight:  FRestorePos := FControl.Width; 
        alTop, 
        alBottom: FRestorePos := FControl.Height; 
      end; 
  end; 
{  if FMaximized then 
  begin 
    FMaximized := FALSE; 
    Maximized := TRUE; 
  end 
  else 
  if FMinimized then 
  begin 
    FMinimized := FALSE; 
    Minimized := TRUE; 
  end;} 
end; 
 
procedure TdfsSplitter.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
begin 
  inherited SetBounds(ALeft, ATop, AWidth, AHeight); 
  if FRestorePos < 0 then 
  begin 
    FindControl; 
    if FControl <> NIL then 
      case Align of 
        alLeft, 
        alRight:  FRestorePos := FControl.Width; 
        alTop, 
        alBottom: FRestorePos := FControl.Height; 
      end; 
  end; 
end; 
 
procedure TdfsSplitter.SetAllowDrag(const Value: boolean); 
var 
  Pt: TPoint; 
begin 
  if FAllowDrag <> Value then 
  begin 
    FAllowDrag := Value; 
    // Have to reset cursor in case it's on the splitter at the moment 
    GetCursorPos(Pt); 
    Pt := ScreenToClient(Pt); 
    ButtonHitTest(Pt.x, Pt.y); 
  end; 
end; 
 
function TdfsSplitter.VisibleWinButtons: integer; 
var 
  x: TdfsWindowsButton; 
begin 
  Result := 0; 
  for x := Low(TdfsWindowsButton) to High(TdfsWindowsButton) do 
    if x in WindowsButtons then 
      inc(Result); 
end; 
 
procedure TdfsSplitter.SetButtonStyle(const Value: TdfsButtonStyle); 
begin 
  FButtonStyle := Value; 
  if ShowButton then 
    Invalidate; 
end; 
 
procedure TdfsSplitter.SetWindowsButtons(const Value: TdfsWindowsButtons); 
begin 
  FWindowsButtons := Value; 
  if (ButtonStyle = bsWindows) and ShowButton then 
    Invalidate; 
end; 
 
procedure TdfsSplitter.DoMinimize; 
begin 
  if assigned(FOnMinimize) then 
    FOnMinimize(Self); 
end; 
 
procedure TdfsSplitter.DoClose; 
begin 
  if Assigned(FOnClose) then 
    FOnClose(Self); 
end; 
 
procedure TdfsSplitter.SetButtonCursor(const Value: TCursor); 
begin 
  FButtonCursor := Value; 
end; 
 
procedure TdfsSplitter.LoadOtherProperties(Reader: TReader); 
begin 
  RestorePos := Reader.ReadInteger; 
end; 
 
 
procedure TdfsSplitter.StoreOtherProperties(Writer: TWriter); 
begin 
  Writer.WriteInteger(RestorePos); 
end; 
 
procedure TdfsSplitter.DefineProperties(Filer: TFiler); 
begin 
  inherited; 
  Filer.DefineProperty('RestorePos', LoadOtherProperties, StoreOtherProperties, 
    Minimized or Maximized); 
end; 
 
end.