ssplitter.pas

AlphaControls是一个Delphi标准控件的集合

unit sSplitter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sCommonData;

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

  TsSplitter = class(TCustomControl)
  private
    FCommonData: TsCommonData;
    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;
    FResizeStyle: TsResizeStyle;
    function FindControl: TControl;
    procedure ControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure StartMoving;
    procedure StartInverseRect;
    procedure EndInverseRect(X, Y: Integer; AllowChange, Apply: Boolean);
    function GetAlign: TAlign;
    procedure MoveAndUpdate(X, Y: Integer; AllowChange: Boolean);
    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 Paint; override;
    procedure WndProc (var Message: TMessage); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Changed; dynamic;
    procedure Changing(X, Y: Integer; var AllowChange: Boolean); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure UpdateState;
  published
    property Align: TAlign read GetAlign write SetAlign default alNone;
    property CommonData : TsCommonData read FCommonData write FCommonData;
    property ControlFirst: TControl read FControlFirst write SetControlFirst;
    property ControlSecond: TControl read FControlSecond write SetControlSecond;
    property Constraints;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property Enabled;
    property Color;
    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 ResizeStyle : TsResizeStyle read FResizeStyle write FResizeStyle default srsInverseLine;
    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 sConst, sVclUtils, sMaskData, sMessages, sStyleSimply, sGraphUtils, sUtils;

const
  InverseThickness = 2;
  DefWidth = 3;

type
  TWC = class (TWinControl);

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

{ TsSplitter }

procedure TsSplitter.AfterConstruction;
begin
  inherited;
  CommonData.Loaded;
end;

procedure TsSplitter.Changed;
begin
  if Assigned(FOnPosChanged) then FOnPosChanged(Self);
end;

procedure TsSplitter.Changing(X, Y: Integer; var AllowChange: Boolean);
begin
  if Assigned(FOnPosChanging) then FOnPosChanging(Self, X, Y, AllowChange);
end;

procedure TsSplitter.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 TsSplitter.ControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_ESCAPE then StopSizing(0, 0, False)
  else if Assigned(FOldKeyDown) then FOldKeyDown(Sender, Key, Shift);
end;

constructor TsSplitter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsSplitter;

  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, {csOpaque,} csDoubleClicks];
  Width := 185;
  Height := DefWidth;
  FSizing := False;
  FTopLeftLimit := 20;
  FBottomRightLimit := 20;
  FControlFirst := nil;
  FControlSecond := nil;
  ParentCtl3D := False;
  Ctl3D := False;
  FResizeStyle := srsInverseLine;
end;

procedure TsSplitter.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('LimitOffset', ReadOffset, WriteOffset, False);
end;

destructor TsSplitter.Destroy;
begin
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsSplitter.DrawSizingLine(Split: TPoint);
var
  P: TPoint;
begin
  if FForm <> nil then begin
    P := FForm.ScreenToClient(Split);
    with FForm.Canvas do begin
      MoveTo(P.X, P.Y);
      if FStyle in [spHorizontalFirst, spHorizontalSecond] then
        LineTo(CToC(FForm, Self, Point(Width, 0)).X, P.Y)
      else LineTo(P.X, CToC(FForm, Self, Point(0, Height)).Y);
    end;
  end;
end;

procedure TsSplitter.EndInverseRect(X, Y: Integer; AllowChange, Apply: Boolean);
const
  DecSize = 3;
var
  NewSize: Integer;
  Rect: TRect;
  W, H: Integer;
  DC: HDC;
  P: TPoint;
  i : integer;
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;
  Parent.DisableAlign;
  try
    if FStyle = spHorizontalFirst then begin
      NewSize := ControlFirst.Height + Y - FOffset.Y;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= H then NewSize := H - DecSize;
      ControlFirst.Height := NewSize;
    end
    else if FStyle = spHorizontalSecond then begin
      NewSize := ControlSecond.Height + Y - FOffset.Y;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= H then NewSize := H - DecSize;
      ControlSecond.Height := NewSize;
    end
    else if FStyle = spVerticalFirst then begin
      NewSize := ControlFirst.Width + X - FOffset.X;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= W then NewSize := W - DecSize;
      ControlFirst.Width := NewSize;
    end
    else if FStyle = spVerticalSecond then begin
      NewSize := ControlSecond.Width + X - FOffset.X;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= W then NewSize := W - DecSize;
      ControlSecond.Width := NewSize;
    end;
  finally
    Parent.EnableAlign;
    for i := 0 to Parent.ControlCount - 1 do begin
      Parent.Controls[i].Repaint;    
    end;
//    if Assigned(ControlFirst) then ControlFirst.Repaint;
//    if Assigned(ControlSecond) then ControlSecond.Repaint;
  end;
end;

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

function TsSplitter.GetAlign: TAlign;
begin
  Result := inherited Align;
end;

function TsSplitter.GetCursor: TCursor;
begin
  Result := crDefault;
  case GetStyle of
    spHorizontalFirst, spHorizontalSecond: Result := crVSplit;
    spVerticalFirst, spVerticalSecond: Result := crHSplit;
  end;
end;

function TsSplitter.GetStyle: TSplitterStyle;
begin
  Result := spUnknown; // other styles 
  if ControlFirst <> nil then begin
    if ((ControlFirst.Align = alTop) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) or
       ((ControlFirst.Align = alBottom) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) then
      Result := spHorizontalFirst
    else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alBottom)) or
       ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alTop)) then
      Result := spHorizontalSecond
    else if ((ControlFirst.Align = alLeft) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) or
       ((ControlFirst.Align = alRight) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) then
      Result := spVerticalFirst
    else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alRight)) or
       ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alLeft)) then
      Result := spVerticalSecond;
    case Result of
      spHorizontalFirst, spVerticalFirst:
        if Align <> FControlFirst.Align then Result := spUnknown;
      spHorizontalSecond, spVerticalSecond:
        if Align <> FControlSecond.Align then Result := spUnknown;
    end;
  end;
end;

procedure TsSplitter.Loaded;
begin
  inherited Loaded;
  CommonData.Loaded;
  UpdateState;
end;

procedure TsSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if not (csDesigning in ComponentState) and (Button = mbLeft) and not (srsNone = ResizeStyle) then begin
    FStyle := GetStyle;
    if FStyle <> spUnknown then begin
      FSizing := True;
      FAppShowHint := Application.ShowHint;
      ReleaseCapture;
      SetCapture(Handle);

      with ValidParentForm(Self) do begin
        if ActiveControl <> nil
          then FActiveControl := ActiveControl
          else FActiveControl := GetParentForm(Self);
        FOldKeyDown := TWC(FActiveControl).OnKeyDown;
        TWC(FActiveControl).OnKeyDown := ControlKeyDown;
      end;
      Application.ShowHint := False;
      FOffset := Point(X, Y);
      case ResizeStyle of
        srsUpdate : begin
          Repaint;
          StartMoving;
        end;
        srsInverseLine : begin
          StartInverseRect;
        end;