发现 TSplitter 在嵌套时不好用, 索性写了个替代品
作者:互联网
发现 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.
标签:end,FLine,Self,TDirPanel,嵌套,TSplitter,替代品,Integer,Create 来源: https://blog.51cto.com/u_14617575/2748293