文档章节

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

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

闪星空间
2014/09/07
0
0
重温 wallabag:Instapaper 的开源替代品

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

14%
08/22
0
0
自定义广告图片轮播View——CarouselView

  因为一个广告机的需求,需要做一个广告轮播的效果,不需要什么特别的动画,正常的轮播就可以了。笔者看了网上很多文章,要么不好用,要么就是效果太多,太复杂,用不上。索性自己写了一个...

饮水思源为名
08/08
0
0

没有更多内容

加载失败,请刷新页面

加载更多

android -------- MVP+DataBinding 的使用

天来说说MVP+DataBinding 的使用 以一个登录案例来讲解 布局:(ConstraintLayout 作为根布局) <layout> <data> <variable name="onClick" ......

切切歆语
42分钟前
1
0
阿里十年Java架构经验总结,这几点尤为重要!

你有没有静下心来思考过:同样是做了x年Java开发,为什么你的技术比别人差很多?为什么别人每月28K你却只有10K? 其实技术水平的高低和个人智商关系不大(毕竟能做Java编程开发大家都不会差)...

别打我会飞
46分钟前
1
0
Ubuntu 中安装和配置 Caddy 服务

首先访问:https://caddyserver.com/download 选择操作系统、插件和授权类型,点击 Download 下载编译好的文件包,或者执行页面最下面的一键安装脚本,完成 caddy 的安装。 安装完成后,/us...

八风不动
今天
2
0
java代码效率优化

1、 尽量指定类的final修饰符 带有final修饰符的类是不可派生的。 2、 尽量重用对象。 3、 尽量使用局部变量,调用方法时传递的参数以及在调用中创建的临时变量都保存在栈(Stack)中,速度较...

踏破铁鞋无觅处
今天
3
0
程序员的几款利器

1. 作为程序员,最希望的就是自己的代码能够在一个云平台上保留下来,gitlab等等这些很多。但是我这里推荐“码云平台”码云平台和开源中国可以直接关联起来。开源中国可以记录博客,当然也是...

ChinaHYF
今天
3
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部