文档章节

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

涂孟超
 涂孟超
发布于 2014/09/26 15:36
字数 329
阅读 2
收藏 0

代替 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

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
私信 提问
GO 语言 UI 组件库 - govcl

由于现有第三方的Go UI库不是太大就是用的不习惯,或者组件太少。就萌生了自己写一个UI库的想法Delphi(Lazarus)有些许多优秀的VCL(LCL)组件,不拿来使用太可惜了。所以就索性做了一套。目前支...

不在乎y
2017/10/10
6.9K
17
自定义Expandable ,QQ显示效果

今天发现ExpandableListAdapter 用起来挺麻烦的, 要建很多个map 数据对象,感觉特别烦, 自己索性写了一个list 的adapter ,自己鼓捣了一下 写了一个扩展的自定义的Expand 类似QQ的样子, ...

迷途d书童
2012/03/26
384
0
原创开源 VB 小程序: 质数判断(因数分解)

原创开源 VB 小程序: 质数判断(因数分解) 闪星空间2014-09-07332 阅读 判断开源vb质数 2014-9-7 P.S.更新 v3.5 版。(本文原发布日期为8月3日) 这是一个判断一正整数(1 除外)是否为质数的...

闪星空间
2014/09/07
0
0
linux下netbeans中文菜单转英文

最近在fedora下安装netbeans,可是菜单是非常不好看的变形字体,看了网上说的加上 --fontsize 12也没有效果,索性使用英文菜单好了,google了一下,发现一位牛人已经解决了: 修改/usr/local/...

散装海盗
2012/08/16
0
0
重温 wallabag:Instapaper 的开源替代品

这个稍后阅读应用增加了功能,使其成为诸如 Pocket、Paper 和 Instapaper 之类应用的可靠替代品。 早在 2014 年,我写了篇关于 wallabag 的文章,它是诸如 Instapaper 和 Pocket 这样的稍后阅...

14%
08/22
0
0

没有更多内容

加载失败,请刷新页面

加载更多

spring学习笔记(二)spring 事件的使用

spring 中的事件 spring事件通过订阅发布 可以解耦操作 可以同步 可以异步 步骤 编写事件 通过继承org.springframework.context.ApplicationEvent 来编写事件 public ApplicationEvent(Obj...

NotFound403
9分钟前
1
0
特斯拉车主成功破解了自己Model 3汽车

据汽车博客Electrek消息,一位特斯拉车主成功破解了自己Model 3汽车,还在此基础上运行了Ubuntu。 这位叫trsohmers的网友表示,“功劳大多要归到Ingineerix的头上,他花了数月才找到初始的那...

linuxCool
23分钟前
1
0
Gitbook : random errors when using gitbook plugin on running "gitbook serve"

在执行gitbook serve时,会有不定的失败错误 参考问题 :#1309 解决方案: 更新gitbook版本,这个问题似乎是3版本的问题 , 官方也不打算在这个版本解决了。 更新 到最新版本后, 不再出现问...

ol_O_O_lo
37分钟前
1
0
提灯照暗,向内自省——《中国文化的深层结构》读书笔记3800字

提灯照暗,向内自省——《中国文化的深层结构》读书笔记3800字: 作者:王健茜;断断续续一个多月才读完了《中国文化的深层结构》,这并不是一本难懂的书,之所以读得慢,源于对书中观点的思...

原创小博客
40分钟前
1
0
高德地图-行政区域接口

1、获取全国各省信息 https://restapi.amap.com/v3/config/district?extensions=all&key=应用Key&s=rsv3&output=json 2、获取下级行政区域信息 https://restapi.amap.com/v3/config/distric......

voole
52分钟前
4
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部