文档章节

发现 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
原创开源 VB 小程序: 质数判断(因数分解)

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

闪星空间
2014/09/07
0
0
自定义Expandable ,QQ显示效果

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

迷途d书童
2012/03/26
345
0
linux下netbeans中文菜单转英文

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

散装海盗
2012/08/16
0
0
Flex 语法扫描器生成器

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

匿名
2008/09/21
3.9K
0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

获取多个集合列表的笛卡尔积

获取多个集合笛卡尔积 电商中典型业务场景:商品搜索 单属性属性值之间为并查询 不同属性的属性值之间查询为与查询 import java.util.ArrayList;import java.util.List;/** * Created w...

键走偏锋
21分钟前
0
0
echarts 迁移地图 控制鼠标缩放大小比例

在网上找了好久没有找到解决方式,还是重新看了一下文档,终于找到的解决方案, zoom:1, //默认显示级别 scaleLimit:{min:1,max:3}, // 缩放级别 echarts 文档-配置项链接 http://echarts.b...

心驰
25分钟前
0
0
Boot2Docker ISO is out-of-date,

Boot2Docker ISO is out-of-date, downloading the latest release. 使用docker-machine时无法更新Boot2Docker ISO导致创建vm machine失败 解决方法:关闭网络,创建好之后再开启...

writeademo
33分钟前
0
0
在 Tomcat 中设置 Tapestry 框架的 html 热加载

如果开发中使用到了 Tapestry 这个框架,如果事先没有设置过的话,开发的时候 html 是不会热加载的,也就是说修改了 html 文件,不能刷新浏览器后立马看到修改完的效果,必须先重新启动应用服...

LeoXu
55分钟前
0
0
【微服务】开启巨石应用到微服务的探索

背景 在过去的一年时间里,我一直在从事一件事情,将现有的单体应用(巨石应用)向微服务改造。 接下来,将持续整理一些在微服务路上的学习与成长。 为什么要做微服务 单体应用,开发、部署简...

艳沐石
今天
1
0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

返回顶部
顶部