发现 TSplitter 在嵌套时不好用, 索性写了个替代品

代替 TSplitter 的 TDirPanel 类:

---

unit DirPanel;

interface

uses
  Classes, Controls, Forms, ExtCtrls;

type
  TDirPanel = class(TCustomPanel)
  private
    FLine: TPanel;
    B: Boolean;
    F: Integer;
  protected
    procedure LineMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
    procedure LineMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
    procedure LineMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
  public
    constructor Create(AOwner: TComponent; aAlign: TAlign = alLeft); reintroduce;
    destructor Destroy; override;
  published

  end;

implementation

{ TDirPanel }

constructor TDirPanel.Create(AOwner: TComponent; aAlign: TAlign);
begin
  inherited Create(AOwner);
  FLine := TPanel.Create(Self);
  FLine.Parent := Self;
  case aAlign of
    alTop: begin
      FLine.Align := alBottom;
      FLine.Height := 5;
      FLine.Cursor := crVSplit;
      Constraints.MaxHeight := Screen.Height div 4;
      Constraints.MinHeight := FLine.Height;
    end;
    alLeft: begin
      FLine.Align := alRight;
      FLine.Width := 5;
      FLine.Cursor := crHSplit;
      Constraints.MinWidth := FLine.Width;
      Constraints.MaxWidth := Screen.Width div 2;
    end;
  end;

  Align := aAlign;
  BevelOuter := bvNone;

  FLine.OnMouseDown := LineMouseDown;
  FLine.OnMouseMove := LineMouseMove;
  FLine.OnMouseUp := LineMouseUp;
end;

destructor TDirPanel.Destroy;
begin
  FLine.Free;
  inherited;
end;

procedure TDirPanel.LineMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  B := True;
  case Align of
    alTop:  F := Y;
    alLeft: F := X;
  end;
end;

procedure TDirPanel.LineMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if not B then Exit;
  case Align of
    alTop: Height := Height + Y - F;
    alLeft: Width := Width + X - F;
  end;
end;

procedure TDirPanel.LineMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  B := False;
end;

end.

---

调用测试:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, DirPanel;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  dir1,dir2: TDirPanel;
  body: TPanel;
  web: TWebBrowser;
  memo: TMemo;

procedure TForm1.FormCreate(Sender: TObject);
begin
  body := TPanel.Create(Self);
  body.Parent := Self;
  body.Align := alClient;
  body.BevelOuter := bvNone;

  dir1 := TDirPanel.Create(Self);
  dir2 := TDirPanel.Create(Self, alTop);
  dir1.Parent := Self;
  dir2.Parent := body;

  web := TWebBrowser.Create(Self);
  TControl(web).Parent := dir1;
  web.Align := alClient;
  web.Navigate('http://del.cnblogs.com');

  memo := TMemo.Create(Self);
  memo.Parent := dir2;
  memo.Align := alClient;
  memo.Text := 'memo';
end;

end.

---