文档章节

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

涂孟超
 涂孟超
发布于 2014/09/26 15:36
字数 329
阅读 2
收藏 0
点赞 0
评论 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
博文 2004
码字总数 14107
作品 0
深圳
程序员
GO 语言 UI 组件库 - govcl

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

不在乎y ⋅ 2017/10/10 ⋅ 17

原创开源 VB 小程序: 质数判断(因数分解)

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

闪星空间 ⋅ 2014/09/07 ⋅ 0

自定义Expandable ,QQ显示效果

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

迷途d书童 ⋅ 2012/03/26 ⋅ 0

linux下netbeans中文菜单转英文

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

散装海盗 ⋅ 2012/08/16 ⋅ 0

TP5的volist嵌套在循环时key值变化如何解决.

今天写页面的时候,遇到一个问题:外层是一个volist,然后里面嵌套了一个volist的下拉框选项.但是发现里面这个volist写了后,外层的的key值全部变成了1. 后来用volist嵌套foreach还是没有用,只有...

老bia同学 ⋅ 04/09 ⋅ 0

Flex 语法扫描器生成器

flex (fast lexical analyser generator) 是Lex的另一个替代品。它经常和自由软件Bison语法分析器生成器 一起使用。Flex 最初由 Vern Paxson 于 1987 年用C语言写成。 Flex手册里对Flex 描述...

匿名 ⋅ 2008/09/21 ⋅ 0

最简单易懂闭包讲解

简介 闭包在web前端开发中特别重要,好多前端开发者工作了几年都不知道闭包原理。现在我就讲一下【闭包】希望各位开发者都能够理解其原理。网上的教程也很多,希望这篇您真的能够学会使用。 ...

java-script ⋅ 2017/12/11 ⋅ 0

翻译成中文的 Phabricator 手册

之前,使用了一段时间的Phabricator. 感觉界面和方式都还是很友好的。 看到很多朋友对这个工具有很多的困惑。我索性就翻译了它的手册。 因为是个人翻译,所以可能还是有些不完美的地方。 我在...

枫听烨歌 ⋅ 2014/06/26 ⋅ 14

Shell 程序设计简易教程

Shell 程序设计简易教程 我不能说我写过多少功能复杂的 shell 脚本,但一些简单的脚本倒是写了不少。在 Linux 下工作,有时候一些零零碎碎的工作,如果你通过写 shell 脚本来处理,会发现那是...

Konghy ⋅ 2015/09/02 ⋅ 0

信息统计DashBoard踩坑总结

最近根据需求用Tornado框架在写了一个从数据库统计Redis服务器的数量、内存等信息的接口,并写了一个从接口获取数据并推送至grafana进行展示的程序。现在已经实现所有功能,现将实现过程中遇...

帅宇 ⋅ 2017/08/28 ⋅ 0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

20.zip压缩 tar打包 打包并压缩

6月25日任务 6.5 zip压缩工具 6.6 tar打包 6.7 打包并压缩 6.5 zip压缩工具: zip支持压缩目录 zip压缩完之后原来的文件不删除 不同的文件内容其实压缩的效果不一样 文件内有很多重复的用xz压...

王鑫linux ⋅ 11分钟前 ⋅ 0

double类型数据保留四位小数的另一种思路

来源:透析公式处理,有时候数据有很长的小数位,有的时候由在四位以内,如果用一般的处理方法,那么不足四位的小树会补充0到第四位,这样子有点画蛇添足的感觉,不太好看。所以要根据小数的...

young_chen ⋅ 18分钟前 ⋅ 0

Python 优化 回溯下降算法

使用sympy构造表达式,实现回溯下降算法 画出函数图像,先使用暴力搜索,找到最小值约为2.5左右 然后选定初始点,开始进行回溯搜索,下降方向为负梯度方向 下降的误差与步数大致呈现下面的状...

阿豪boy ⋅ 22分钟前 ⋅ 0

Django配置163邮箱出现 authentication failed(535)错误解决方法

最近用Django写某网站,当配置163邮箱设置完成后,出现535错误即:smtplib.SMTPAuthenticationError: (535, b'Error: authentication failed') Django初始配置邮箱设置 EMAIL_HOST = "smtp.1...

陈墨轩_CJX ⋅ 24分钟前 ⋅ 0

用接口模拟可伸缩枚举(34)

1、枚举的可伸缩性最后证明都不是什么好点子 扩展类型的元素是基本类型实例,基本类型的实例却不是扩展类型的元素,很混乱 目前还没有很好的方法来枚举基本类型的所有元素,及其扩展 可伸缩性...

职业搬砖20年 ⋅ 27分钟前 ⋅ 0

Ubuntu18.04 IDEA快捷键无法使用

IDEA默认的回退到上一视图的快捷键是Ctrl + Alt + Left,在ubuntu中这个快捷键被占用了,在16.04中可以在界面中取消这个快捷键,但是18.04就看不到了,可以使用以下命令解决 gsettings set ...

Iceberg_XTY ⋅ 31分钟前 ⋅ 0

如何解决s权限位引发postfix及crontab异常

一、问题现象 业务反馈某台应用服务器,普通用户使用mutt程序发送邮件时,提示“postdrop warning: mail_queue_enter: create file maildrop/713410.6065: Permission denied”,而且普通用法...

问题终结者 ⋅ 44分钟前 ⋅ 0

Unable to load database on disk

由于磁盘空间满了以后,导致zookeeper异常退出,清理磁盘空间后,zk启动报错,信息如下: 2018-06-25 17:18:46,904 INFO org.apache.zookeeper.server.quorum.QuorumPeerConfig: Reading co...

刀锋 ⋅ 今天 ⋅ 0

css3 box-sizing:border-box 实现div一行多列

<!DOCTYPE html><html><head><style> div.container{ background:green; padding:10px 10px;}div.box{box-sizing:border-box;-moz-box-sizing:border-box; /* Fir......

qimh ⋅ 今天 ⋅ 0

Homebrew简介和基本使用

一、Homebrew是什么 Homebrew是一款Mac OS平台下的软件包管理工具,拥有安装、卸载、更新、查看、搜索等很多实用的功能。简单的一条指令,就可以实现包管理,而不用你关心各种依赖和文件路径...

说回答 ⋅ 今天 ⋅ 0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

返回顶部
顶部