S
snappy
Unregistered / Unconfirmed
GUEST, unregistred user!
刚刚学会怎样编写控件,由于资料甚少,只是略懂皮毛,可我又是对它十分的钟爱,所以想开一个专门探索Delphi控件奥秘与技巧方面的网站,不只各位有何意见?
我打算将我所编写的控件代码全部公布出来,所以,您如果想要更好的控件源码,希望您能向我提供一些关于设计控件的资料,如果您提供了,我保证所编写的控件,您将会是第一个收到源码的人。
希望大家多多支持!!
下面是我为了需要编写的第一个控件,是模拟电子表显示板的,现在贴在这,您只要把它创建到LED.PAS文件中即可安装使用了。在这个控件里我没有考虑太多的优化,所以只是模拟一下,有什么不足之处盼能原谅,把它贴出来也只是希望您能提点意见!见笑了!
unit Led;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Consts;
type
TLed = class(TGraphicControl)
private
FForeColor: TColor;
FBackColor: TColor;
FLedHeight:Integer;
FLedWidth:integer;
Fpen:integer;
FValueouble;
FAutoSize:boolean;
procedure SetForeColor(Value: TColor);
procedure SetBackColor(Value: TColor);
Procedure Setpen(Value :integer);
Procedure SetLedwidth(value:integer);
procedure setledheight(value:integer);
procedure setvalue(value:double);
procedure ShowLed;
Procedure Setautosize(value:boolean);
procedure line(x1,y1,x2,y2:integer);
{ Private declarations }
protected
procedure Paint; override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent);override;
{ Public declarations }
published
property BackColor: TColor read FBackColor write SetBackColor default clWhite;
property ForeColor: TColor read FForeColor write SetForeColor default clBlack;
property Value: Double read FValue write setValue;// default 0.00;
property LEDHeight:Integer read FLedHeight Write setLedHeight Default 80;
property LEDWidth:Integer read FLedwidth Write setLedWidth Default 40;
property Pen:integer read Fpen write Setpen Default 4;
property AutoSize:boolean read FautoSize write SetAutoSize default False;
{ Published declarations }
end;
procedure Register;
implementation
type
TBltBitmap = class(TBitmap)
end;
procedure tled.line;
begin
canvas.moveto(x1,y1);
canvas.LineTo(x2,y2);
end;
procedure Tled.Setautosize;
begin
Fautosize:=value;
refresh;
end;
procedure tled.setvalue;
begin
FValue:=value;
refresh;
end;
procedure tled.SetLedwidth;
begin
Fledwidth:=value;
Refresh;
end;
procedure tled.setledheight;
begin
Fledheight:=value;
refresh;
end;
procedure TLed.Setpen;
begin
Fpen:=Value;
if Fpen<2 then pen:=2;
Refresh;
end;
procedure Tled.ShowLed;
var
Str:string;
i,sbl,sbt,n,Len:integer;
begin
Str:=floattostr(value);
Len:=Length(str);
sbl:=(width-len*ledwidth) div 2;
sbt:=(height-ledheight) div 2;
if autosize then
begin
width:=len*ledwidth+5;
height:=ledheight+6;
end;
for n:=1 to len do
begin
if n>1 then sbl:=sbl+ledwidth;
if pchar(copy(str,n,1))[0] in ['0'..'9'] then
begin
case strtoint(copy(str,n,1)) of
0:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
end;
1:begin
for i:=1 to pen do
line(sbl+i+1,sbt+i,sbl+i+1,sbt+(ledheight div 2)-i);
for i:=1 to pen do
line(sbl+i+1,sbt+(ledheight div 2)+i,sbl+i+1,sbt+ledheight-i);
end;
2:begin
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1)
end;
end;
3:begin
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
4:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
5:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
6:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
7:begin
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
end;
8:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
9:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
begin
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
end;
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to ((pen Div 2)) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
end;
end else
begin
if copy(str,n,1)='.' then
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
if copy(str,n,1)='-' then
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
end;
end;
procedure Tled.SetForeColor(Value: TColor);
begin
if Value <> FForeColor then
begin
FForeColor := Value;
Refresh;
end;
end;
procedure Tled.SetBackColor(Value: TColor);
begin
if Value <> FBackColor then
begin
FBackColor := Value;
Refresh;
end;
end;
constructor TLed.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FForeColor := clBlack;
FBackColor := clWhite;
Width := 100;
Height := 100;
Ledheight:=80;
LedWidth:=60;
pen:=8;
repaint
end;
procedure TLed.Paint;
begin
Canvas.brush.Color:=FbackColor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(0, 0, Width, Height));
Canvas.pen.Color:=FForeColor;
showled; //显示数字
end;
procedure Register;
begin
RegisterComponents('MyVcl', [TLed]);
end;
end.
我打算将我所编写的控件代码全部公布出来,所以,您如果想要更好的控件源码,希望您能向我提供一些关于设计控件的资料,如果您提供了,我保证所编写的控件,您将会是第一个收到源码的人。
希望大家多多支持!!
下面是我为了需要编写的第一个控件,是模拟电子表显示板的,现在贴在这,您只要把它创建到LED.PAS文件中即可安装使用了。在这个控件里我没有考虑太多的优化,所以只是模拟一下,有什么不足之处盼能原谅,把它贴出来也只是希望您能提点意见!见笑了!
unit Led;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Consts;
type
TLed = class(TGraphicControl)
private
FForeColor: TColor;
FBackColor: TColor;
FLedHeight:Integer;
FLedWidth:integer;
Fpen:integer;
FValueouble;
FAutoSize:boolean;
procedure SetForeColor(Value: TColor);
procedure SetBackColor(Value: TColor);
Procedure Setpen(Value :integer);
Procedure SetLedwidth(value:integer);
procedure setledheight(value:integer);
procedure setvalue(value:double);
procedure ShowLed;
Procedure Setautosize(value:boolean);
procedure line(x1,y1,x2,y2:integer);
{ Private declarations }
protected
procedure Paint; override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent);override;
{ Public declarations }
published
property BackColor: TColor read FBackColor write SetBackColor default clWhite;
property ForeColor: TColor read FForeColor write SetForeColor default clBlack;
property Value: Double read FValue write setValue;// default 0.00;
property LEDHeight:Integer read FLedHeight Write setLedHeight Default 80;
property LEDWidth:Integer read FLedwidth Write setLedWidth Default 40;
property Pen:integer read Fpen write Setpen Default 4;
property AutoSize:boolean read FautoSize write SetAutoSize default False;
{ Published declarations }
end;
procedure Register;
implementation
type
TBltBitmap = class(TBitmap)
end;
procedure tled.line;
begin
canvas.moveto(x1,y1);
canvas.LineTo(x2,y2);
end;
procedure Tled.Setautosize;
begin
Fautosize:=value;
refresh;
end;
procedure tled.setvalue;
begin
FValue:=value;
refresh;
end;
procedure tled.SetLedwidth;
begin
Fledwidth:=value;
Refresh;
end;
procedure tled.setledheight;
begin
Fledheight:=value;
refresh;
end;
procedure TLed.Setpen;
begin
Fpen:=Value;
if Fpen<2 then pen:=2;
Refresh;
end;
procedure Tled.ShowLed;
var
Str:string;
i,sbl,sbt,n,Len:integer;
begin
Str:=floattostr(value);
Len:=Length(str);
sbl:=(width-len*ledwidth) div 2;
sbt:=(height-ledheight) div 2;
if autosize then
begin
width:=len*ledwidth+5;
height:=ledheight+6;
end;
for n:=1 to len do
begin
if n>1 then sbl:=sbl+ledwidth;
if pchar(copy(str,n,1))[0] in ['0'..'9'] then
begin
case strtoint(copy(str,n,1)) of
0:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
end;
1:begin
for i:=1 to pen do
line(sbl+i+1,sbt+i,sbl+i+1,sbt+(ledheight div 2)-i);
for i:=1 to pen do
line(sbl+i+1,sbt+(ledheight div 2)+i,sbl+i+1,sbt+ledheight-i);
end;
2:begin
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1)
end;
end;
3:begin
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
4:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
5:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
6:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
7:begin
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
end;
8:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //左下
line(sbl+i+pen,sbt+(ledheight div 2)+i,sbl+i+pen,sbt+ledheight-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
9:begin
for i:=1 to pen do //左上
line(sbl+i+pen,sbt+i,sbl+i+pen,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右上
line(sbl+ledwidth-i-pen-1,sbt+i,sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)-i);
for i:=1 to pen do //右下
begin
line(sbl+ledwidth-i-pen-1,sbt+(ledheight div 2)+i,sbl+ledwidth-i-pen-1,sbt+ledheight-i);
end;
for i:=1 to pen do //上
line(sbl+i+pen+2,sbt+i,sbl+ledwidth-pen-2-i,sbt+i);
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
for i:=1 to ((pen Div 2)) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
end;
end else
begin
if copy(str,n,1)='.' then
for i:=1 to pen do //下
line(sbl+i+pen+2,sbt-i+ledheight,sbl+ledwidth-pen-2-i,sbt-i+ledheight);
if copy(str,n,1)='-' then
for i:=1 to (pen Div 2) do //中
begin
line(sbl+i+pen+2,sbt+(ledheight div 2)-i,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)-i);
line(sbl+i+pen+2,sbt+(ledheight div 2)+i-1,sbl+ledwidth-pen-2-i,sbt+(ledheight div 2)+i-1);
end;
end;
end;
end;
procedure Tled.SetForeColor(Value: TColor);
begin
if Value <> FForeColor then
begin
FForeColor := Value;
Refresh;
end;
end;
procedure Tled.SetBackColor(Value: TColor);
begin
if Value <> FBackColor then
begin
FBackColor := Value;
Refresh;
end;
end;
constructor TLed.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FForeColor := clBlack;
FBackColor := clWhite;
Width := 100;
Height := 100;
Ledheight:=80;
LedWidth:=60;
pen:=8;
repaint
end;
procedure TLed.Paint;
begin
Canvas.brush.Color:=FbackColor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(0, 0, Width, Height));
Canvas.pen.Color:=FForeColor;
showled; //显示数字
end;
procedure Register;
begin
RegisterComponents('MyVcl', [TLed]);
end;
end.