How to synchronize splitters?

[Mike Torrettinni 198]

I have 2 splitters that I would like to synchronize moves, to move at the same time.

Here I have example of top and bottom 2 panels, and 2 splitters:

 

 

When Splitter1 resizes Panels 1&2, I would like for Splitter2 to resize Panels 3&4 at the same time, as if it's 1 splitter. Horizontal splitter of course splits Up & Down areas, so I can't have 1 vertical splitter.

 

I found this code (http://www.delphigroups.info/2/66/312669.html) and works good for just 1 splitter. It works good when moving Splitter1 it also moves the same way Splitter2.

 

TForm1
private
    fOriginalWindowProc: TWndMethod;
    procedure MoveOtherSplitter(var aMsg: TMessage);
...
procedure TForm1.FormCreate(Sender: TObject);
begin
  fOriginalWindowProc := Splitter1.WindowProc;
  Splitter1.WindowProc := MoveOtherSplitter;
end;

procedure TForm1.MoveOtherSplitter(var aMsg: TMessage);
begin
  Case aMsg.Msg Of
    WM_MOUSEFIRST..WM_MOUSELAST:
      Splitter2.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
  end;
   fOriginalWindowProc(aMsg);
end;

 

But I don't know how to modify the code to apply the same behavior when moving Splitter2 to move Splitter1 at the same time.

 

I tried to assign similar to Splitter2:

 

var fOriginalWindowProc2: TWndMethod;
    procedure MoveOtherSplitter2(var aMsg: TMessage);
...
fOriginalWindowProc2 := Splitter2.WindowProc;
Splitter2.WindowProc := MoveOtherSplitter2;

procedure TForm1.MoveOtherSplitter2(var aMsg: TMessage);
begin
  Case aMsg.Msg Of
    WM_MOUSEFIRST..WM_MOUSELAST:
      Splitter1.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
  end;
   fOriginalWindowProc2(aMsg);
end;

 

I get stack overflow, because it locks in a message loop between both splitters moves.

 

Any help appreciated in implementing how to synchronize splitters.

 

full code with form:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter3: TSplitter;
    Panel3: TPanel;
    Panel4: TPanel;
    Splitter1: TSplitter;
    Panel5: TPanel;
    Panel6: TPanel;
    Splitter2: TSplitter;
    procedure FormCreate(Sender: TObject);
  private

    fOriginalWindowProc: TWndMethod;
    procedure MoveOtherSplitter(var aMsg: TMessage);

    var fOriginalWindowProc2: TWndMethod;
    procedure MoveOtherSplitter2(var aMsg: TMessage);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  fOriginalWindowProc := Splitter1.WindowProc;
  Splitter1.WindowProc := MoveOtherSplitter;

  fOriginalWindowProc2 := Splitter2.WindowProc;
  Splitter2.WindowProc := MoveOtherSplitter2;
end;

procedure TForm1.MoveOtherSplitter(var aMsg: TMessage);
begin
  Case aMsg.Msg Of
    WM_MOUSEFIRST..WM_MOUSELAST:
      Splitter2.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
  end;
   fOriginalWindowProc(aMsg);
end;

procedure TForm1.MoveOtherSplitter2(var aMsg: TMessage);
begin
  Case aMsg.Msg Of
    WM_MOUSEFIRST..WM_MOUSELAST:
      Splitter1.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
  end;
   fOriginalWindowProc2(aMsg);
end;

end.



object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 360
  ClientWidth = 477
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  OnCreate = FormCreate
  TextHeight = 15
  object Splitter3: TSplitter
    Left = 0
    Top = 180
    Width = 477
    Height = 3
    Cursor = crVSplit
    Align = alTop
    Color = clActiveCaption
    ParentColor = False
    ExplicitLeft = 1
    ExplicitTop = 1
    ExplicitWidth = 832
  end
  object Panel1: TPanel
    AlignWithMargins = True
    Left = 3
    Top = 3
    Width = 471
    Height = 174
    Align = alTop
    BevelOuter = bvNone
    ParentBackground = False
    TabOrder = 0
    object Splitter1: TSplitter
      Left = 235
      Top = 0
      Width = 5
      Height = 174
      Color = clActiveCaption
      ParentColor = False
      ExplicitLeft = 481
      ExplicitTop = 17
      ExplicitHeight = 431
    end
    object Panel3: TPanel
      AlignWithMargins = True
      Left = 250
      Top = 10
      Width = 211
      Height = 154
      Margins.Left = 10
      Margins.Top = 10
      Margins.Right = 10
      Margins.Bottom = 10
      Align = alClient
      BevelOuter = bvNone
      Caption = 'Panel2'
      Color = clWhite
      ParentBackground = False
      TabOrder = 0
      ExplicitLeft = 451
      ExplicitTop = 5
      ExplicitWidth = 452
      ExplicitHeight = 425
    end
    object Panel4: TPanel
      AlignWithMargins = True
      Left = 10
      Top = 10
      Width = 215
      Height = 154
      Margins.Left = 10
      Margins.Top = 10
      Margins.Right = 10
      Margins.Bottom = 10
      Align = alLeft
      BevelOuter = bvNone
      Caption = 'Panel1'
      Color = clWhite
      ParentBackground = False
      TabOrder = 1
      ExplicitHeight = 210
    end
  end
  object Panel2: TPanel
    AlignWithMargins = True
    Left = 3
    Top = 186
    Width = 471
    Height = 171
    Align = alClient
    BevelOuter = bvNone
    ParentBackground = False
    TabOrder = 1
    ExplicitLeft = 168
    ExplicitTop = 344
    ExplicitWidth = 185
    ExplicitHeight = 41
    object Splitter2: TSplitter
      Left = 235
      Top = 0
      Width = 5
      Height = 171
      Color = clActiveCaption
      ParentColor = False
      ExplicitLeft = 448
      ExplicitTop = 2
      ExplicitHeight = 425
    end
    object Panel5: TPanel
      AlignWithMargins = True
      Left = 10
      Top = 10
      Width = 215
      Height = 151
      Margins.Left = 10
      Margins.Top = 10
      Margins.Right = 10
      Margins.Bottom = 10
      Align = alLeft
      BevelOuter = bvNone
      Caption = 'Panel3'
      Color = clWhite
      ParentBackground = False
      TabOrder = 0
      ExplicitHeight = 95
    end
    object Panel6: TPanel
      AlignWithMargins = True
      Left = 250
      Top = 10
      Width = 211
      Height = 151
      Margins.Left = 10
      Margins.Top = 10
      Margins.Right = 10
      Margins.Bottom = 10
      Align = alClient
      BevelOuter = bvNone
      Caption = 'Panel4'
      Color = clWhite
      ParentBackground = False
      TabOrder = 1
      ExplicitLeft = 451
      ExplicitTop = 5
      ExplicitWidth = 1027
      ExplicitHeight = 425
    end
  end
end

 

Edited August 26, 2022 by Mike Torrettinni

[Lajos Juhász 295]

Why not use the OnMoved event of the splitter?

[Attila Kovacs 631]

OnAlignInsertBefore

OnAlignPosition

[Mike Torrettinni 198]

9 minutes ago, Lajos Juhász said:

Why not use the OnMoved event of the splitter?

 

4 minutes ago, Attila Kovacs said:

OnAlignInsertBefore

OnAlignPosition

 

I think these suggestions will not work because I want the both splitters to move at the same time, not when moving is done.

 

See the behavior:

 

[Attila Kovacs 631]

you should have a flag which describes if the message are coming from the mouse or from the window proc of the other splitter and if it's not the mouse, skip the feedback

 

[Mike Torrettinni 198]

It could be improved, but this if how I made it work:

 

 

new variable that gets assigned by moving control:

var fMovingControl: TObject;

 

and new move methods:

 

procedure TForm1.MoveOtherSplitter(var aMsg: TMessage);
begin
 if  (fMovingControl = nil) or (fMovingControl = Splitter1) then
 Case aMsg.Msg Of
    WM_MOUSEFIRST..WM_MOUSELAST:
    begin
      fMovingControl := Splitter1;
      Splitter2.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
      fMovingControl := nil
    end;
  end;
  fOriginalWindowProc(aMsg);
end;

procedure TForm1.MoveOtherSplitter2(var aMsg: TMessage);
begin
 if (fMovingControl = nil) or (fMovingControl = Splitter2) then
  Case aMsg.Msg Of
    WM_MOUSEFIRST..WM_MOUSELAST:
     begin
      fMovingControl := Splitter2;
      Splitter1.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
      fMovingControl := nil;
     end;
  end;
   fOriginalWindowProc2(aMsg);
end;

 

I tried to make it more generic, but TMessage doesn't have Sender, so I can't identify which control send the Perform message. 

Edited August 26, 2022 by Mike Torrettinni

[Remy Lebeau 1436]

1 hour ago, Mike Torrettinni said:

It could be improved, but this if how I made it work:

...

I tried to make it more generic, but TMessage doesn't have Sender, so I can't identify which control send the Perform message. 

Simply move the logic into another procedure that you can pass the Sender into, eg:

procedure TForm1.MoveOtherSplitterImpl(Sender: TSplitter; var aMsg: TMessage);
begin
  if (fMovingControl = nil) or (fMovingControl = Sender) then
    case aMsg.Msg of
      WM_MOUSEFIRST..WM_MOUSELAST:
      begin
        fMovingControl := Sender;
        try
          if Sender = Splitter1 then
            Splitter2.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam)
          else if Sender = Splitter2 then
            Splitter1.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
        finally
          fMovingControl := nil;
        end;
      end;
    end;
  end;
end;

procedure TForm1.MoveOtherSplitter(var aMsg: TMessage);
begin
  MoveOtherSplitterImpl(Splitter1, aMsg);
  fOriginalWindowProc(aMsg);
end;

procedure TForm1.MoveOtherSplitter2(var aMsg: TMessage);
begin
  MoveOtherSplitterImpl(Splitter2, aMsg);
  fOriginalWindowProc2(aMsg);
end;

If you really want something more generic, then you should link the two Splitters together, such as by their Tag properties, eg:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Splitter1.Tag := NativeInt(Splitter2);
  fOriginalWindowProc := Splitter1.WindowProc;
  Splitter1.WindowProc := MoveOtherSplitter;

  Splitter2.Tag := NativeInt(Splitter1);
  fOriginalWindowProc2 := Splitter2.WindowProc;
  Splitter2.WindowProc := MoveOtherSplitter2;
end;

procedure TForm1.MoveOtherSplitterImpl(Sender: TSplitter; var aMsg: TMessage);
begin
  if (fMovingControl = nil) or (fMovingControl = Sender) then
    case aMsg.Msg of
      WM_MOUSEFIRST..WM_MOUSELAST:
      begin
        fMovingControl := Sender;
        try
          TSplitter(Sender.Tag).Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
        finally
          fMovingControl := nil;
        end;
      end;
    end;
  end;
end;

procedure TForm1.MoveOtherSplitter(var aMsg: TMessage);
begin
  MoveOtherSplitterImpl(Splitter1, aMsg);
  fOriginalWindowProc(aMsg);
end;

procedure TForm1.MoveOtherSplitter2(var aMsg: TMessage);
begin
  MoveOtherSplitterImpl(Splitter2, aMsg);
  fOriginalWindowProc2(aMsg);
end;

 

[Mike Torrettinni 198]

thanks @Remy Lebeau I went a little different - with TSplitter interposer:

 

// Splitter interposer
TSplitter = class(Vcl.ExtCtrls.TSplitter)
  private
    var fOriginalWindowProc: TWndMethod;
    var fOtherSplitter: TSplitter;
    var fMovingControl: TSplitter;
  public
    procedure MoveOtherSplitter(var aMsg: TMessage);
  end;

procedure TSplitter.MoveOtherSplitter(var aMsg: TMessage);
begin
  if  (fMovingControl = nil) or (fMovingControl = Self) then
  Case aMsg.Msg Of
    WM_MOUSEFIRST..WM_MOUSELAST:
    begin
      fMovingControl := Self;
      fOtherSplitter.fMovingControl := Self;
      fOtherSplitter.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
      fMovingControl := nil;
      fOtherSplitter.fMovingControl := nil;
    end;
  end;
  fOriginalWindowProc(aMsg);
end;

 

And assigning method:

 

procedure LinkSplitters(aSplitter1, aSplitter2: TSplitter);
begin
  aSplitter1.fOriginalWindowProc := aSplitter1.WindowProc;
  aSplitter1.WindowProc := aSplitter1.MoveOtherSplitter;
  aSplitter1.fOtherSplitter := aSplitter2;

  aSplitter2.fOriginalWindowProc := aSplitter2.WindowProc;
  aSplitter2.WindowProc := aSplitter2.MoveOtherSplitter;
  aSplitter2.fOtherSplitter := aSplitter1;
end;

 

the I can just use simple LinkSplitters:

 

LinkSplitters(Splitter1, Splitter2);

 

 

Edited August 26, 2022 by Mike Torrettinni

[Uwe Raabe 2064]

I have another approach:

type
  TSplitter = class(Vcl.ExtCtrls.TSplitter)
  private
    FInMoveSplitter: Boolean;
    FSibling: TSplitter;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    procedure MoveSplitter(var aMsg: TMessage);
    property Sibling: TSplitter read FSibling write FSibling;
  end;

procedure TSplitter.MoveSplitter(var aMsg: TMessage);
begin
  FInMoveSplitter := True;
  try
    Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam);
  finally
    FInMoveSplitter := False;
  end;
end;

procedure TSplitter.WndProc(var Message: TMessage);
begin
  if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) and not FInMoveSplitter and (Sibling <> nil) then
    Sibling.MoveSplitter(Message);
  inherited WndProc(Message);
end;

Linking is a two liner:

  Splitter2.Sibling := Splitter3;
  Splitter3.Sibling := Splitter2;

 

[Mike Torrettinni 198]

10 hours ago, Uwe Raabe said:

I have another approach:

Nice and clean. Thanks!

[Remy Lebeau 1436]

On 8/26/2022 at 3:05 PM, Uwe Raabe said:

I have another approach:

When using an Interposer, this is the way I would have do it, too.

[Fr0sT.Brutal 900]

On 8/27/2022 at 1:05 AM, Uwe Raabe said:

Linking is a two liner:

Little semantic note: being sibling is always two-way link. So the one setter should assign both properties to ensure consistency. Otherwise this relations could be better named mater-slave or smth alike

[HeartWare 1]

 

 

I'd use TJvSplitter from Jedi VCL, set their ResizeStyle = rsUpdate, and then on Splitter2's OnMoved event, I have this:

 

procedure TForm128.JvSplitter2Moved(Sender: TObject);
begin
  Panel5.Width:=Panel3.Width
end;

 

and on Splitter3's OnMoved:

 

procedure TForm128.JvSplitter3Moved(Sender: TObject);
begin
  Panel3.Width:=Panel5.Width
end;

 

This way, not only are they updated while dragging, but also follow along each other.

[Mike Torrettinni 198]

9 hours ago, HeartWare said:

I'd use TJvSplitter from Jedi VCL, set their ResizeStyle = rsUpdate, and then on Splitter2's OnMoved event, I have this:

I need to use rsPattern because of annoying flicker. I have multiple VirtualStringTrees and Scrollbox with multiple Frames and controls. But now I do see that OnMoved actually works when using rsUpdate or rsPattern.

 

I prefer interposer solution, and no matter what control the Splitters resize, it just works when synched.

Edited August 29, 2022 by Mike Torrettinni
typo

[David Schwartz 430]

On 8/29/2022 at 12:16 AM, Fr0sT.Brutal said:

Little semantic note: being sibling is always two-way link. So the one setter should assign both properties to ensure consistency. Otherwise this relations could be better named mater-slave or smth alike

Yes, I think they should be set together to ensure contextual integrity. Eg, a TSplitter.Constructor that takes the two splitters as parameters then sets their siblings appropriately.

[Mike Torrettinni 198]

On 9/12/2022 at 4:55 AM, David Schwartz said:

Yes, I think they should be set together to ensure contextual integrity. Eg, a TSplitter.Constructor that takes the two splitters as parameters then sets their siblings appropriately.

How would you use TSplitter.Constructor for splitters already on the form, to connect them?

I already have UI set, don't want to create splitter controls when form is created, if that is what your suggestion requires. 

[David Schwartz 430]

7 hours ago, Mike Torrettinni said:

How would you use TSplitter.Constructor for splitters already on the form, to connect them?

I already have UI set, don't want to create splitter controls when form is created, if that is what your suggestion requires. 

have you considered making a helper method? Or a subclass?

 

It really doesn't matter all that much, but they should be set together, not separately, IMHO

[Mike Torrettinni 198]

3 minutes ago, David Schwartz said:

have you considered making a helper method? Or a subclass?

 

It really doesn't matter all that much, but they should be set together, not separately, IMHO

I have TSplitter interposer in Commons.UI.SyncSplitters unit and method procedure SyncSplitters(aSplitter1, aSplitter2: TSplitter);. So all I do is use the unit and call SyncSplitters - which sets the Siblings, in one method. 

Perhaps I'm already doing what you are suggesting.