代替 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 := ;
FLine.Cursor := crVSplit;
Constraints.MaxHeight := Screen.Height div ;
Constraints.MinHeight := FLine.Height;
end;
alLeft: begin
FLine.Align := alRight;
FLine.Width := ;
FLine.Cursor := crHSplit;
Constraints.MinWidth := FLine.Width;
Constraints.MaxWidth := Screen.Width div ;
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.
http://www.cnblogs.com/del/archive/2011/05/12/2044635.html