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

来源:互联网 时间:1970-01-01


代替 TSplitter 的 TDirPanel 类:



unit DirPanel;interfaceuses 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 p 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 p 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;interfaceuses 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.


相关阅读:
Top