您的位置:首页 > 其它

发现 TSplitter 在嵌套时不好用, 索性写了个替代品(处理MouseDown,MouseMove,MouseUp,然后设定控件的Left值就可以了)

2016-11-03 21:46 387 查看
代替 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.
http://www.cnblogs.com/del/archive/2011/05/12/2044635.html
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐