Look Inside

unit Execute.SplitPanels;

{
  TSplitPanel (c)2015 Execute SARL 

  http://www.execute.fr

  v1 2015.11.17
  v2 2015.11.23 Stefan Grube added themed colors 

  TSplitPanel.Splitter : Integer -> add a splitter inside the panel when Align is in [alTop, alLeft, alRight, alBottom], the value is the Size of the splitter

  TSplitPanel.Collapsed: boolean -> close/open the Panel, like when DblClick on the Splitter or SimpleClick on the splitter's button

  TSplitPanel.MinSize  : Integer -> minimal widht/height of the Collapsed Panel

}
interface

uses
  Winapi.Windows,
  System.Types,
  System.Classes,
  System.SysUtils,
  Vcl.Controls,
  Vcl.ExtCtrls,
  Vcl.Graphics,
  Vcl.Themes;

type
  TSplitPanel = class(Vcl.ExtCtrls.TPanel)
  private
    FSplitter   : Integer;
    FSplitting  : Boolean;
    FMinSize    : Integer;
    FMaxSize    : Integer;
    FSize       : Integer;
    FDown       : TPoint;
    FLineDC     : hDC;
    FBrush      : TBrush;
    FPrevBrush  : hBrush;
    FSplitPos   : TPoint;
    FSplitSize  : TSize;
    FSplitMin   : Integer;
    FSplitMax   : Integer;
    FButtonClick: Boolean;
    FLineVisible: Boolean;
    FOldCursor  : TCursor;
    procedure SetSplitter(Value: Integer);
    procedure GetMaxSize;
    function GetCollapsed: Boolean;
    procedure SetCollapsed(Value: Boolean);
    procedure SetSize(Value: Integer);
    function GetSize: Integer;
    procedure ResizeTop(Value: Integer);
    procedure ResizeLeft(Value: Integer);
    procedure ResizeRight(Value: Integer);
    procedure ResizeBottom(Value: Integer);
    procedure AllocateLineDC;
    procedure ReleaseLineDC;
    procedure DrawLine;
    procedure ReadSize(Reader: TReader);
    procedure WriteSize(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function ButtonRect(FullSize: Boolean):  TRect;
    procedure RequestAlign; override;
    function GetClientRect: TRect; override;
    procedure Loaded; override;
    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;
  published
    property Splitter : Integer read FSplitter write SetSplitter default 0;
    property Collapsed: Boolean read GetCollapsed write SetCollapsed stored False;
    property MinSize  : Integer read FMinSize write FMinSize default 0;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Execute SARL', [TSplitPanel]);
end;

{ TSplitPanel }

procedure TSplitPanel.AllocateLineDC;
begin
  FLineDC := GetDCEx(Parent.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
    or DCX_LOCKWINDOWUPDATE);
  if FBrush = nil then
  begin
    FBrush := TBrush.Create;
    if TStyleManager.IsCustomStyleActive then
      with StyleServices do
        FBrush.Bitmap := AllocPatternBitmap(clBlack, GetStyleColor(scSplitter))
    else
      FBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite);
  end;
  FPrevBrush := SelectObject(FLineDC, FBrush.Handle);
end;

function TSplitPanel.ButtonRect(FullSize: Boolean): TRect;
var
  I: Integer;
begin
  Result := inherited GetClientRect;
  case Align of
    alTop,
    alBottom:
    begin
      if Align = alBottom then
        Result.Bottom := Result.Top + FSplitter
      else
        Result.Top := Result.Bottom - FSplitter;
      if not FullSize then
      begin
        I := Result.Width div 2 - 15;
        Inc(Result.Left, I);
        Dec(Result.Right, I);
      end;
    end;
    alLeft,
    alRight:
    begin
      if Align = alRight then
        Result.Right := Result.Left + FSplitter
      else
        Result.Left := Result.Right - FSplitter;
      if not FullSize then
      begin
        I := Result.Height div 2 - 15;
        Inc(Result.Top, I);
        Dec(Result.Bottom, I);
      end;
    end;
  end;
end;

procedure TSplitPanel.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('ExpandedSize', ReadSize, WriteSize, FSize <> 0);
end;

procedure TSplitPanel.DrawLine;
begin
  FLineVisible := not FLineVisible;
  PatBlt(FLineDC, Left + FSplitPos.X, Top + FSplitPos.Y, FSplitSize.cx, FSplitSize.cy, PATINVERT);
end;

function TSplitPanel.GetClientRect: TRect;
begin
  Result := inherited GetClientRect;
  if FSplitter > 0 then
  case Align of
    alBottom : Inc(Result.Top, FSplitter);
    alTop    : Dec(Result.Bottom, FSplitter);
    alRight  : Inc(Result.Left, FSplitter);
    alLeft   : Dec(Result.Right, FSplitter);
  end;
end;

function TSplitPanel.GetCollapsed: Boolean;
begin
  Result := FSize > 0;
end;

procedure TSplitPanel.GetMaxSize;
var
  Index: Integer;
begin
  if Parent = nil then
    Exit;
  if Align in [alTop, alBottom] then
  begin
    FMaxSize := Parent.ClientHeight;
    for Index := 0 to Parent.ControlCount - 1 do
      if Parent.Controls[Index].Align in [alTop, alBottom] then
        Dec(FMaxSize, Parent.Controls[Index].Height);
    Inc(FMaxSize, Height);
  end else begin
    FMaxSize := Parent.ClientWidth;
    for Index := 0 to Parent.ControlCount - 1 do
      if Parent.Controls[Index].Align in [alLeft, alRight] then
        Dec(FMaxSize, Parent.Controls[Index].Width);
    Inc(FMaxSize, Width);
  end;
end;

procedure TSplitPanel.Loaded;
begin
  inherited;
  if FSplitter > 0 then
  begin
    GetMaxSize;
  end;
end;

procedure TSplitPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  R: TRect;
begin
  inherited;

  if (Button = mbLeft) and (FSplitting) then
  begin

    if ssDouble in Shift then
    begin

      Collapsed := not Collapsed;
      Invalidate;
      FSplitting := False;

    end else begin

      GetMaxSize();

      R := ButtonRect(True);

      FSplitSize.cx := R.Width;
      FSplitSize.cy := R.Height;
      FSplitPos := R.TopLeft;

      FDown.X := X;
      FDown.Y := Y;

      R := ButtonRect(False);
      FButtonClick := R.Contains(FDown);

      case Align of
        alBottom :
        begin
          FSplitMin := Height - FMaxSize;
          FSplitMax := Height - FMinSize - FSplitter;
        end;
        alTop :
        begin
          Dec(FDown.Y, R.Top);
          FSplitMin := FMinSize;
          FSplitMax := FMaxSize - FSplitter;
        end;
        alRight :
        begin
          FSplitMin := Width - FMaxSize;
          FSplitMax := Width - FMinSize - FSplitter;
        end;
        alLeft :
        begin
          Dec(FDown.X, R.Left);
          FSplitMin := FMinSize;
          FSplitMax := FMaxSize - FSplitter;
        end;
      end;
      AllocateLineDC;
      SetCaptureControl(Self);
    end;
  end;
end;

procedure TSplitPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
begin
  inherited;

  if FSplitting = False then
    FOldCursor := Cursor;

  if ssLeft in Shift then
  begin

    if FSplitting then
    begin

      if FLineVisible then
        DrawLine;

      if Align in [alTop, alBottom] then
      begin
        FSplitPos.Y := Y - FDown.Y;
        if FSplitPos.Y < FSplitMin then
        begin
          FSplitPos.Y := FSplitMin;
        end else
        if FSplitPos.Y > FSplitMax then
        begin
          FSplitPos.Y := FSplitMax;
        end;
      end else begin
        FSplitPos.X := X - FDown.X;
        if FSplitPos.X < FSplitMin then
        begin
          FSplitPos.X := FSplitMin;
        end else
        if FSplitPos.X > FSplitMax then
        begin
          FSplitPos.X := FSplitMax;
        end;
      end;

      DrawLine;
      Exit;
    end;

  end else

  if (FSplitter > 0) and (Align in [alLeft, alTop, alBottom, alRight]) then
  begin
    FDown.X := X;
    FDown.Y := Y;
    R := ButtonRect(True);
    if R.Contains(FDown) then
    begin
      if Align in [alTop, alBottom] then
      begin
        Cursor := crVSplit;
      end else begin
        Cursor := crHSplit;
      end;
      FSplitting := True;
      Exit;
    end;
  end;

  Cursor := FOldCursor;
  FSplitting := False;
end;

procedure TSplitPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if FSplitting then
  begin
    SetCaptureControl(nil);
    Cursor := FOldCursor;
    if FLineVisible then
      DrawLine;
    ReleaseLineDC;
    case Align of
      alBottom: SetSize(Height - FSplitPos.Y);
      alTop   : SetSize(FSplitPos.Y + FSplitter);
      alRight : SetSize(Width - FSplitPos.X);
      alLeft  : SetSize(FSplitPos.X + FSplitter);
    end;
  end;
end;

procedure TSplitPanel.Paint;
var
  R: TRect;
begin
  inherited;
  if (FSplitter > 0) and (Align in [alTop, alLeft, alRight, alBottom]) then
  begin
    R := ButtonRect(True);
    Canvas.Brush.Color := StyleServices.GetSystemColor(Self.Color);
    Canvas.FillRect(R);
    R := ButtonRect(False);
    Frame3D(Canvas, R, StyleServices.GetSystemColor(clBtnHighlight), StyleServices.GetSystemColor(clBtnShadow), 1);
  end;
end;

procedure TSplitPanel.ReadSize(Reader: TReader);
begin
  FSize := Reader.ReadInteger;
end;

procedure TSplitPanel.ReleaseLineDC;
begin
  if FPrevBrush <> 0 then
    SelectObject(FLineDC, FPrevBrush);
  ReleaseDC(Parent.Handle, FLineDC);
  FreeAndNil(FBrush);
end;

procedure TSplitPanel.RequestAlign;
begin
  GetMaxSize;
  inherited;
end;

procedure TSplitPanel.ResizeBottom(Value: Integer);
var
  Delta  : Integer;
  Y      : Integer;
  Index  : Integer;
  Control: TControl;
begin
  Y := Top;
  Delta := Height - Value;

  for Index := 0 to Parent.ControlCount - 1 do
  begin
    Control := Parent.Controls[Index];
    if Control = Self then
    begin
      Control.SetBounds(Left, Top + Delta, Width, Value);
    end else
    if Control.Align = Align then
    begin
      if Control.Top + Control.Height <= Y then
      begin
        Control.Top := Control.Top + Delta;
      end;
    end else
    if Control.Align = alClient then
    begin
      Control.Height := Control.Height + Delta;
    end;
  end;
end;

procedure TSplitPanel.ResizeLeft(Value: Integer);
var
  Delta  : Integer;
  X      : Integer;
  Index  : Integer;
  Control: TControl;
begin
  X := Left + Width;
  Delta := Width - Value;

  for Index := 0 to Parent.ControlCount - 1 do
  begin
    Control := Parent.Controls[Index];
    if Control = Self then
    begin
      Control.SetBounds(Left, Top, Value, Height);
    end else
    if Control.Align = Align then
    begin
      if Control.Left >= X then
      begin
        Control.Left := Control.Left - Delta;
      end;
    end else
    if Control.Align = alClient then
    begin
      Control.Width := Control.Width + Delta;
    end;
  end;
end;

procedure TSplitPanel.ResizeRight(Value: Integer);
var
  Delta  : Integer;
  X      : Integer;
  Index  : Integer;
  Control: TControl;
begin
  X := Left;
  Delta := Width - Value;

  for Index := 0 to Parent.ControlCount - 1 do
  begin
    Control := Parent.Controls[Index];
    if Control = Self then
    begin
      Control.SetBounds(Left + Delta, Top, Value, Height);
    end else
    if Control.Align = Align then
    begin
      if Control.Left + Control.Width <= X then
      begin
        Control.Left := Control.Left + Delta;
      end;
    end else
    if Control.Align = alClient then
    begin
      Control.Width := Control.Width + Delta;
    end;
  end;
end;
procedure TSplitPanel.ResizeTop(Value: Integer);
var
  Delta  : Integer;
  Y      : Integer;
  Index  : Integer;
  Control: TControl;
begin
  Y := Top + Height;
  Delta := Height - Value;

  for Index := 0 to Parent.ControlCount - 1 do
  begin
    Control := Parent.Controls[Index];
    if Control = Self then
    begin
      Control.SetBounds(Left, Top, Width, Value);
    end else
    if Control.Align = Align then
    begin
      if Control.Top >= Y then
      begin
        Control.Top := Control.Top - Delta;
      end;
    end else
    if Control.Align = alClient then
    begin
      Control.Height := Control.Height + Delta;
    end;
  end;
end;

function TSplitPanel.GetSize: Integer;
begin
  if Align in [alTop, alBottom] then
    Result := Height
  else
    Result := Width;
end;

procedure TSplitPanel.SetCollapsed(Value: Boolean);
begin
  FButtonClick := False;
  if Value then
  begin
    if FSize = 0 then
    begin
      SetSize(FMinSize + FSplitter);
    end;
  end else begin
    if FSize > 0 then
    begin
      SetSize(FSize);
    end;
  end;
end;

procedure TSplitPanel.SetSize(Value: Integer);
var
  Size: Integer;
begin
  Size := GetSize;

  if FButtonClick and (Abs(Value - Size) < 2) then
  begin

    if FSize = 0 then  // not Collapsed
    begin
      Value := FMinSize + FSplitter; // do collapse
    end else begin
      Value := FSize; // restore size
      Size := 0;
    end;

  end else begin

    if Value > FMinSize + FSplitter then
      Size := 0  // no more collapsed
    else begin
      if FSize > 0 then  // already collasped
        Exit;
    end;

  end;

  FSize := Size;

  Parent.DisableAlign;
  try
    case Align of
      alTop    : ResizeTop(Value);
      alLeft   : ResizeLeft(Value);
      alRight  : ResizeRight(Value);
      alBottom : ResizeBottom(Value);
    end;
  finally
    Parent.EnableAlign;
  end;
end;

procedure TSplitPanel.SetSplitter(Value: Integer);
begin
  if FSplitter <> Value then
  begin
    FSplitter := Value;
    if not (csLoading in ComponentState) then
    begin
      Realign;
      Invalidate;
    end;
  end;
end;

procedure TSplitPanel.WriteSize(Writer: TWriter);
begin
  Writer.WriteInteger(FSize);
end;

end.