www.pudn.com > virdisk_source.rar > TFlatSplitterUnit.pas

unit TFlatSplitterUnit; 
 
{***************************************************************} 
{  TFlatsplitter                                                } 
{  Copyright ©1999 Lloyd Kinsella.                              } 
{                                                               } 
{  FlatStyle is Copyright ©1998-99 Maik Porkert.                } 
{***************************************************************} 
 
interface 
 
{$I Version.inc} 
 
uses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus, Graphics, 
     StdCtrls, ExtCtrls, FlatUtilitys; 
 
type 
  TSplitterStatus = (ssIn, ssOut); 
 
type 
  THack = class(TWinControl); 
 
  TFlatSplitter = class(TGraphicControl) 
  private 
    FUseAdvColors: Boolean; 
    FAdvColorBorder: TAdvColors; 
    FAdvColorFocused: TAdvColors; 
    FBorderColor: TColor; 
    FFocusedColor: TColor; 
    FLineDC: HDC; 
    FDownPos: TPoint; 
    FSplit: Integer; 
    FMinSize: NaturalNumber; 
    FMaxSize: Integer; 
    FControl: TControl; 
    FNewSize: Integer; 
    FActiveControl: TWinControl; 
    FOldKeyDown: TKeyEvent; 
    FLineVisible: Boolean; 
    FOnMoved: TNotifyEvent; 
    FStatus: TSplitterStatus; 
    procedure AllocateLineDC; 
    procedure DrawLine; 
    procedure ReleaseLineDC; 
    procedure UpdateSize(X, Y: Integer); 
    procedure FocusKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 
    procedure SetColors (Index: Integer; Value: TColor); 
    procedure SetAdvColors (Index: Integer; Value: TAdvColors); 
    procedure SetUseAdvColors (Value: Boolean); 
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE; 
    procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED; 
    procedure CMEnter(var Message: TMessage); message CM_MOUSEENTER; 
    procedure CMExit(var Message: TMessage); message CM_MOUSELEAVE; 
  protected 
    procedure CalcAdvColors; 
    procedure Paint; override; 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 
    procedure StopSizing; 
  public 
    constructor Create(AOwner: TComponent); override; 
  published 
    property AdvColorBorder: TAdvColors index 0 read FAdvColorBorder write SetAdvColors default 50; 
    property AdvColorFocused: TAdvColors index 1 read FAdvColorFocused write SetAdvColors default 50; 
    property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default False; 
    property Color default $00E0E9EF; 
    property FocusedColor: TColor index 0 read FFocusedColor write SetColors default $0053D2FF; 
    property BorderColor: TColor index 1 read FBorderColor write SetColors default $00555E66; 
    property MinSize: NaturalNumber read FMinSize write FMinSize default 30; 
    property OnMoved: TNotifyEvent read FOnMoved write FOnMoved; 
    property Align default alLeft; 
    property Enabled; 
    property ParentColor; 
    property ParentShowHint; 
    property ShowHint; 
    property Visible; 
   {$IFDEF D4CB4} 
    property Anchors; 
    property BiDiMode; 
    property Constraints; 
    property ParentBiDiMode; 
   {$ENDIF} 
  end; 
 
implementation 
 
constructor TFlatSplitter.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  Align := alLeft; 
  Width := 5; 
  Cursor := crHSplit; 
  FMinSize := 30; 
  FStatus := ssOut; 
  Color := $00E0E9EF; 
  FocusedColor := $0053D2FF; 
  BorderColor := $00555E66; 
end; 
 
procedure TFlatSplitter.AllocateLineDC; 
begin 
  FLineDC := GetDCEx(Parent.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_LOCKWINDOWUPDATE); 
end; 
 
procedure TFlatSplitter.DrawLine; 
var 
  P: TPoint; 
begin 
  FLineVisible := not FLineVisible; 
  P := Point(Left, Top); 
  if Align in [alLeft, alRight] then 
    P.X := Left + FSplit 
  else 
    P.Y := Top + FSplit; 
  with P do 
    PatBlt(FLineDC, X, Y, Width, Height, PATINVERT); 
end; 
 
procedure TFlatSplitter.ReleaseLineDC; 
begin 
  ReleaseDC(Parent.Handle, FLineDC); 
end; 
 
procedure TFlatSplitter.Paint; 
var 
  R: TRect; 
begin 
  R := ClientRect; 
  if FStatus = ssIn then 
  begin 
    Canvas.Brush.Color := FFocusedColor; 
    Canvas.FillRect(R); 
    Frame3D(Canvas,R,FBorderColor,FBorderColor,1); 
  end; 
  if FStatus = ssOut then 
  begin 
    Canvas.Brush.Color := Color; 
    Canvas.FillRect(R); 
    Frame3D(Canvas,R,FBorderColor,FBorderColor,1); 
  end; 
end; 
 
procedure TFlatSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
 
function FindControl: TControl; 
var 
  P: TPoint; 
  I: Integer; 
begin 
  Result := 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 
    Result := Parent.Controls[I]; 
    if PtInRect(Result.BoundsRect, P) then 
      Exit; 
  end; 
  Result := nil; 
end; 
 
var 
  I: Integer; 
begin 
  inherited; 
  if Button = mbLeft then 
  begin 
    FControl := FindControl; 
    FDownPos := Point(X, Y); 
    if Assigned(FControl) then 
    begin 
      if Align in [alLeft, alRight] then 
      begin 
        FMaxSize := Parent.ClientWidth - FMinSize; 
        for I := 0 to Parent.ControlCount - 1 do 
          with Parent.Controls[I] do 
            if Align in [alLeft, alRight] then 
              Dec(FMaxSize, Width); 
            Inc(FMaxSize, FControl.Width); 
        end 
else 
begin 
FMaxSize := Parent.ClientHeight - FMinSize; 
for I := 0 to Parent.ControlCount - 1 do 
with Parent.Controls[I] do 
if Align in [alTop, alBottom] then Dec(FMaxSize, Height); 
Inc(FMaxSize, FControl.Height); 
end; 
UpdateSize(X, Y); 
AllocateLineDC; 
with ValidParentForm(Self) do 
if ActiveControl <> nil then 
begin 
FActiveControl := ActiveControl; 
FOldKeyDown := THack(FActiveControl).OnKeyDown; 
THack(FActiveControl).OnKeyDown := FocusKeyDown; 
end; 
DrawLine; 
end; 
end; 
end; 
 
procedure TFlatSplitter.UpdateSize(X, Y: Integer); 
var 
  S: Integer; 
begin 
  if Align in [alLeft, alRight] then 
    FSplit := X - FDownPos.X 
  else 
    FSplit := Y - FDownPos.Y; 
  S := 0; 
  case Align of 
    alLeft: S := FControl.Width + FSplit; 
    alRight: S := FControl.Width - FSplit; 
    alTop: S := FControl.Height + FSplit; 
    alBottom: S := FControl.Height - FSplit; 
  end; 
  FNewSize := S; 
  if S < FMinSize then 
    FNewSize := FMinSize 
  else 
    if S > FMaxSize then 
      FNewSize := FMaxSize; 
  if S <> FNewSize then 
  begin 
    if Align in [alRight, alBottom] then 
      S := S - FNewSize 
    else 
      S := FNewSize - S; 
    Inc(FSplit, S); 
  end; 
end; 
 
procedure TFlatSplitter.MouseMove(Shift: TShiftState; X, Y: Integer); 
begin 
  inherited; 
  if Assigned(FControl) then 
  begin 
    DrawLine; 
    UpdateSize(X, Y); 
    DrawLine; 
  end; 
end; 
 
procedure TFlatSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
  inherited; 
  if Assigned(FControl) then 
  begin 
    DrawLine; 
    case Align of 
      alLeft: FControl.Width := FNewSize; 
      alTop: FControl.Height := FNewSize; 
      alRight: 
        begin 
          Parent.DisableAlign; 
          try 
            FControl.Left := FControl.Left + (FControl.Width - FNewSize); 
            FControl.Width := FNewSize; 
          finally 
            Parent.EnableAlign; 
          end; 
        end; 
      alBottom: 
        begin 
          Parent.DisableAlign; 
          try 
            FControl.Top := FControl.Top + (FControl.Height - FNewSize); 
            FControl.Height := FNewSize; 
          finally 
            Parent.EnableAlign; 
          end; 
        end; 
    end; 
    StopSizing; 
  end; 
end; 
 
procedure TFlatSplitter.FocusKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 
begin 
  if Key = VK_ESCAPE then 
    StopSizing 
  else 
    if Assigned(FOldKeyDown) then 
      FOldKeyDown(Sender, Key, Shift); 
end; 
 
procedure TFlatSplitter.StopSizing; 
begin 
  if Assigned(FControl) then 
  begin 
    if FLineVisible then DrawLine; 
    FControl := nil; 
    ReleaseLineDC; 
    if Assigned(FActiveControl) then 
    begin 
      THack(FActiveControl).OnKeyDown := FOldKeyDown; 
      FActiveControl := nil; 
    end; 
  end; 
  if Assigned(FOnMoved) then 
    FOnMoved(Self); 
end; 
 
procedure TFlatSplitter.CMEnter(var Message: TMessage); 
begin 
  if FStatus <> ssIn then 
  begin 
    FStatus := ssIn; 
    Repaint; 
  end; 
end; 
 
procedure TFlatSplitter.CMExit(var Message: TMessage); 
begin 
  if FStatus <> ssOut then 
  begin 
    FStatus := ssOut; 
    Repaint; 
  end; 
end; 
 
procedure TFlatSplitter.SetColors (Index: Integer; Value: TColor); 
begin 
  case Index of 
    0: FFocusedColor := Value; 
    1: FBorderColor := Value; 
  end; 
  Invalidate; 
end; 
 
procedure TFlatSplitter.CalcAdvColors; 
begin 
  if FUseAdvColors then 
  begin 
    FBorderColor := CalcAdvancedColor(Color, FBorderColor, FAdvColorBorder, darken); 
    FFocusedColor := CalcAdvancedColor(Color, FFocusedColor, FAdvColorFocused, darken); 
  end; 
end; 
 
procedure TFlatSplitter.SetAdvColors(Index: Integer; Value: TAdvColors); 
begin 
  case Index of 
    0: FAdvColorBorder := Value; 
    1: FAdvColorFocused := Value; 
  end; 
  CalcAdvColors; 
  Invalidate; 
end; 
 
procedure TFlatSplitter.SetUseAdvColors (Value: Boolean); 
begin 
  if Value <> FUseAdvColors then 
  begin 
    FUseAdvColors := Value; 
    ParentColor := Value; 
    CalcAdvColors; 
    Invalidate; 
  end; 
end; 
 
procedure TFlatSplitter.CMSysColorChange (var Message: TMessage); 
begin 
  if FUseAdvColors then 
  begin 
    ParentColor := True; 
    CalcAdvColors; 
  end; 
  Invalidate; 
end; 
 
procedure TFlatSplitter.CMParentColorChanged (var Message: TWMNoParams); 
begin 
  inherited; 
  if FUseAdvColors then 
  begin 
    ParentColor := True; 
    CalcAdvColors; 
  end; 
  Invalidate; 
end; 
 
end.