lazarus创建自定义组件

lazarus创建自定义组件,方便有一堆标准控件有相同或相似操作,建个新组件,这样用的时候只要继承一下,就不用再重复代码了。

参考文章 Delphi自定义控件开发

lazarus里新建组件菜单在 顶层菜单 软件包下

比如我想新建个继承之tstatictext控件的TURLLabel,就新建URLLabel.pas文件,unit单元名也是URLLabel,类里几个作用域简单说明一下

  • private 类内访问
  • protected 类内访问,可用于组件的覆盖方法
  • public 可类内外访问,运行时可访问,可用于组件的新方法
  • published 可类内外访问,设计时可访问,可用于组件的属性

 组件可用于工程内或安装到lazarus,显示到组件面板方便其他任何工程使用

register方法确定了显示的新组件名和新分组名,如果工程庞大,可能一个分组放一堆新组件

下面是我实现的一个简单组件,新增了2个属性browse存放操作系统浏览器,url存放一个网址,继承重写了click方法,假如url不为空,点击即可用浏览器打开一个网址

还重写了mouseleave和mouseenter,在鼠标移动到组件上和离开组件变化一下组件背景色和边框,本来一个效果就可以,发现window和linux分别只能看到一个效果,那就写2个效果,这样2个操作系统就能都有效果

unit URLLabel;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,StdCtrls,Process;

type
  TURLLabel = class(tstatictext)
  private
       FUrl:AnsiString;
        Fbrowse:AnsiString;
  protected
       procedure click;override;
        procedure MouseLeave; override;
    procedure Mouseenter; override;
  public
        constructor create(Aowner:Tcomponent);override;
  published
       property Url:AnsiString read FUrl write FUrl;
        property browse:AnsiString read Fbrowse write Fbrowse;
  end;

procedure Register;

implementation

procedure Register;
begin
  //组件面板 linco是组名 turllabel是具体组件名
  RegisterComponents('Linco',[TURLLabel]);
end;
procedure TUrlLabel.click;
var
  Process: TProcess;
begin
  if length(Url) >0 then
  begin
  Process := TProcess.Create(nil);
  try
    Process.InheritHandles := False;
    Process.Options := [];
    Process.ShowWindow := swoShow;
    Process.Executable := browse;
    Process.Parameters.Add(Url);
    Process.Execute;
  except
    on E: EOSError do
      writeln(e.Message);
  end;
  Process.Free;
  end;
//ShellExecute(Application.Handle, nil, Pchar(Url), nil, nil,SW_noRMAL);
inherited;

end;
constructor TUrlLabel.create(Aowner:Tcomponent);
begin
inherited create(Aowner);
cursor:=crHandPoint;
Font.Style:= [fsUnderline];
font.color:=clhighlight;
color:=clsilver;
browse:='/usr/bin/browser';
end;

procedure TUrlLabel.MouseLeave;
begin
       Color:=clsilver;
       borderstyle:= sbssingle;
     inherited;
 end;
  procedure TUrlLabel.Mouseenter;
begin
     Color:=clmedgray;
       borderstyle:= sbssunken;
     inherited;
 end;

end.            

代码输入完毕,软件包面板有编译按钮,编译后选择使用下的安装,安装后自动重启lazarus,就可以当做普通控件使用了。

  • 0
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值