lazarus创建自定义组件,方便有一堆标准控件有相同或相似操作,建个新组件,这样用的时候只要继承一下,就不用再重复代码了。
参考文章 Delphi自定义控件开发
lazarus里新建组件菜单在 顶层菜单 软件包下
比如我想新建个继承之tstatictext控件的TURLLabel,就新建URLLabel.pas文件,unit单元名也是URLLabel,类里几个作用域简单说明一下
组件可用于工程内或安装到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,就可以当做普通控件使用了。