TSplitterはネストする時使いにくいことを発見して、いっそ代替品を書きました
3762 ワード
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.