rxsplit.pas

灰鸽子1.23源码,,,,,,,

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 2001,2002 SGB Software          }
{         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
{                        Igor Pavluk and Serge Korolev  }
{                                                       }
{*******************************************************}


unit RXSplit;

interface

{$I RX.INC}

uses Classes, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Controls, ExtCtrls, Forms, Graphics, VCLUtils;

type

{ TRxSplitter }

  TSplitterStyle = (spUnknown, spHorizontalFirst, spHorizontalSecond,
    spVerticalFirst, spVerticalSecond);
  TInverseMode = (imNew, imClear, imMove);
  TSplitterMoveEvent = procedure (Sender: TObject; X, Y: Integer;
    var AllowChange: Boolean) of object;

  TRxSplitter = class(TCustomPanel)
  private
    FControlFirst: TControl;
    FControlSecond: TControl;
    FSizing: Boolean;
    FStyle: TSplitterStyle;
    FPrevOrg: TPoint;
    FOffset: TPoint;
    FNoDropCursor: Boolean;
    FLimitRect: TRect;
    FTopLeftLimit: Integer;
    FBottomRightLimit: Integer;
    FForm: TCustomForm;
    FActiveControl: TWinControl;
    FAppShowHint: Boolean;
    FOldKeyDown: TKeyEvent;
    FOnPosChanged: TNotifyEvent;
    FOnPosChanging: TSplitterMoveEvent;
    function FindControl: TControl;
    procedure ControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure StartInverseRect;
    procedure EndInverseRect(X, Y: Integer; AllowChange, Apply: Boolean);
    function GetAlign: TAlign;
    procedure MoveInverseRect(X, Y: Integer; AllowChange: Boolean);
    procedure ShowInverseRect(X, Y: Integer; Mode: TInverseMode);
    procedure DrawSizingLine(Split: TPoint);
    function GetStyle: TSplitterStyle;
    function GetCursor: TCursor;
    procedure SetControlFirst(Value: TControl);
    procedure SetControlSecond(Value: TControl);
    procedure SetAlign(Value: TAlign);
    procedure StopSizing(X, Y: Integer; Apply: Boolean);
    procedure CheckPosition(var X, Y: Integer);
    procedure ReadOffset(Reader: TReader);
    procedure WriteOffset(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; AOperation: TOperation); 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 Changed; dynamic;
    procedure Changing(X, Y: Integer; var AllowChange: Boolean); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    procedure UpdateState;
  published
    property ControlFirst: TControl read FControlFirst write SetControlFirst;
    property ControlSecond: TControl read FControlSecond write SetControlSecond;
    property Align: TAlign read GetAlign write SetAlign default alNone;
{$IFDEF RX_D4}
    property Constraints;
{$ENDIF}
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderStyle;
    property Enabled;
    property Color;
    property Ctl3D {$IFDEF WIN32} default False {$ENDIF};
    property Cursor read GetCursor stored False;
    property TopLeftLimit: Integer read FTopLeftLimit write FTopLeftLimit default 20;
    property BottomRightLimit: Integer read FBottomRightLimit write FBottomRightLimit default 20;
    property ParentColor;
    property ParentCtl3D default False;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnPosChanged: TNotifyEvent read FOnPosChanged write FOnPosChanged;
    property OnPosChanging: TSplitterMoveEvent read FOnPosChanging write FOnPosChanging;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
  end;

implementation

uses SysUtils;

const
  InverseThickness = 2;
  DefWidth = 3;

function CToC(C1, C2: TControl; P: TPoint): TPoint;
begin
  Result := C1.ScreenToClient(C2.ClientToScreen(P));
end;

type
  THack = class(TWinControl);

{ TRxSplitter }

constructor TRxSplitter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csOpaque, csDoubleClicks];
  Width := 185;
  Height := DefWidth;
  FSizing := False;
  FTopLeftLimit := 20;
  FBottomRightLimit := 20;
  FControlFirst := nil;
  FControlSecond := nil;
  ParentCtl3D := False;
{$IFDEF WIN32}
  Ctl3D := False;
{$ENDIF}
end;

procedure TRxSplitter.Loaded;
begin
  inherited Loaded;
  UpdateState;
end;

procedure TRxSplitter.DefineProperties(Filer: TFiler); { for backward compatibility }
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('LimitOffset', ReadOffset, WriteOffset, False);
end;

procedure TRxSplitter.ReadOffset(Reader: TReader);
var
  I: Integer;
begin
  I := Reader.ReadInteger;
  FTopLeftLimit := I;
  FBottomRightLimit := I;
end;

procedure TRxSplitter.WriteOffset(Writer: TWriter);
begin
  Writer.WriteInteger(FTopLeftLimit);
end;

procedure TRxSplitter.UpdateState;
begin
  inherited Cursor := Cursor;
end;

function TRxSplitter.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;

procedure TRxSplitter.CheckPosition(var X, Y: Integer);
begin
  if X - FOffset.X < FLimitRect.Left then
    X := FLimitRect.Left + FOffset.X
  else if X - FOffset.X + Width > FLimitRect.Right then
    X := FLimitRect.Right - Width + FOffset.X;
  if Y - FOffset.Y < FLimitRect.Top then
    Y := FLimitRect.Top + FOffset.Y
  else if Y - FOffset.Y + Height > FLimitRect.Bottom then
    Y := FLimitRect.Bottom + FOffset.Y - Height;
end;

procedure TRxSplitter.StartInverseRect;
var
  R: TRect;
  W: Integer;
begin
  if Parent = nil then Exit;
  R := Parent.ClientRect;
  FLimitRect.TopLeft := CToC(Self, Parent, Point(R.Left + FTopLeftLimit,
    R.Top + FTopLeftLimit));
  FLimitRect.BottomRight := CToC(Self, Parent, Point(R.Right - R.Left -
    FBottomRightLimit, R.Bottom - R.Top - FBottomRightLimit));
  FNoDropCursor := False;
  FForm := ValidParentForm(Self);
  FForm.Canvas.Handle := GetDCEx(FForm.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
    or DCX_LOCKWINDOWUPDATE);
  with FForm.Canvas do begin
    Pen.Color := clWhite;
    if FStyle in [spHorizontalFirst, spHorizontalSecond] then W := Height
    else W := Width;
    if W > InverseThickness + 1 then W := W - InverseThickness
    else W := InverseThickness;
    Pen.Width := W;
    Pen.Mode := pmXOR;
  end;
  ShowInverseRect(Width div 2, Height div 2, imNew);
end;

procedure TRxSplitter.EndInverseRect(X, Y: Integer; AllowChange,
  Apply: Boolean);
const
  DecSize = 3;
var
  NewSize: Integer;
  Rect: TRect;
  W, H: Integer;
  DC: HDC;
  P: TPoint;
begin
  if FForm <> nil then begin
    ShowInverseRect(0, 0, imClear);
    with FForm do begin
      DC := Canvas.Handle;
      Canvas.Handle := 0;
      ReleaseDC(Handle, DC);
    end;
    FForm := nil;
  end;
  FNoDropCursor := False;
  if Parent = nil then Exit;
  Rect := Parent.ClientRect;
  H := Rect.Bottom - Rect.Top - Height;
  W := Rect.Right - Rect.Left - Width;
  if not AllowChange then begin
    P := ScreenToClient(FPrevOrg);
    X := P.X + FOffset.X - Width div 2;
    Y := P.Y + FOffset.Y - Height div 2
  end;
  if not Apply then Exit;
  CheckPosition(X, Y);
  if (ControlFirst.Align = alRight) or
    ((ControlSecond <> nil) and (ControlSecond.Align = alRight)) then
  begin
    X := -X;
    FOffset.X := -FOffset.X;
  end;
  if (ControlFirst.Align = alBottom) or
    ((ControlSecond <> nil) and (ControlSecond.Align = alBottom)) then
  begin
    Y := -Y;
    FOffset.Y := -FOffset.Y;
  end;