我的整个控件代码是这样的。
unit mymb;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, StdCtrls, Graphics;
type
Tmymb = class(TWincontrol)
private
{ Private declarations }
MyPath : String;
FPanel0 : TPanel;
FPanel : TPanel;
FLabel : TLabel;
FImage : Array[0..2] of Timage;
FShape : Array[0..5] of TShape;
FOnClick : TNotifyEvent;
protected
{ Protected declarations }
Procedure SetCaption(Value : String);
function GetCaption : String;
Procedure SetLed(Value : String);
// Procedure SetOnMbClick(Value : TNotifyEvent);
// function GetOnMbClick : TNotifyEvent;
Procedure Click; dynamic;
Procedure SetAppPath(Value : String);
public
{ Public declarations }
Constructor Create(AOwner : TComponent); Override;
Destructor Destroy; Override;
published
{ Published declarations }
Property Caption : String Read GetCaption Write SetCaption;
Property Led : String Write SetLed;
Property MyAppPath : String Write SetAppPath;
Property OnClick : TNotifyEvent read FOnClick Write FOnClick;
// Property OnClick : TNotifyEvent read GetOnMbClick Write SetOnMbClick;
end;
implementation
Constructor Tmymb.Create(AOwner : TComponent);
var
i : Integer;
begin
Inherited Create(AOwner);
FPanel0 := TPanel.Create(Self);
FPanel0.Parent := Self;
FPanel0.Height := 235;
FPanel0.Width := 42;
FPanel0.Show ;
FPanel0.ShowHint := true;
FPanel := TPanel.create(Self);
FPanel.Parent := FPanel0;
FPanel.Height := 233;
FPanel.Width := 40;
FPanel.Left := 1;
FPanel.Top := 1;
FPanel.Color := clHighlight;
FPanel.Caption := '';
FPanel.ShowHint := True;
FPanel.BevelOuter := bvLowered;
Fpanel.BevelWidth := 1;
FPanel.Show;
FLabel := TLabel.Create(Self);
FLabel.Parent := FPanel;
FLabel.Caption := '';
Flabel.AutoSize := True;
Flabel.Font.Color := clWindow;
Flabel.Transparent := True;
Flabel.Top := 8;
Flabel.Left := 13;
Flabel.ParentShowHint := True;
FLabel.Show ;
For i := 0 to 2 do
begin
FImage := TImage.Create(Self);
FImage.Parent := FPanel;
FImage.AutoSize := True;
FImage.ShowHint :=True;
FImage.Left := 9;
FImage.Show;
// FImage.OnClick := GetOnMbClick;
end;
FImage[0].Top :=40;
FImage[0].Hint := '电口 0';
FImage[1].Top := 80;
FImage[1].Hint := '电口 1';
FImage[2].Top := 160;
FImage[2].Hint := '光口';
For i := 0 to 5 do
begin
FShape := TShape.Create(Self);
FShape.Parent := FPanel;
FShape.Shape := stCircle;
FShape.Width := 10;
FShape.Height := 10;
FShape.ShowHint := True;
FShape.Pen.Width := 1;
FShape.Pen.Color := clSkyBlue; //灰灯。
FShape.Brush.Color := clLime;
FShape.Show;
// FShape.Pen.Color := clWhite; //亮灯。 各个灯的意义及程序中的 FShape 数组序号
// FShape.Brush.Color := clSilver;
end; // spd | 1 | 0 | power
// -----|--------|-------|----------
FShape[0].Pen.Color := clWhite; //Power亮 数组 | 1 | 0 | 5
FShape[0].Brush.Color := clSilver; // 索引 | 3 | 2 | 4
FShape[1].Left := 4; // -----|--------|-------|----------
FShape[0].Left := 15; // link | 1 | 0 | 4
FShape[5].Left := 26;
FShape[0].Top := 122;
FShape[1].Top := 122;
FShape[5].Top := 122;
FShape[3].Left := 4;
FShape[2].Left := 15;
FShape[4].Left := 26;
FShape[3].Top := 137;
FShape[2].Top := 137;
FShape[4].Top := 137;
FShape[0].Hint := 'Spd 0';
FShape[1].Hint := 'Spd 1';
FShape[2].Hint := '电口 0 Link';
FShape[3].Hint := '电口 1 Link';
FShape[4].Hint := '光口Link';
FShape[5].Hint := '电源';
Width := FPanel0.Width; //235
Height := FPanel0.Height; //42
end;
Destructor Tmymb.Destroy;
var
I : Integer;
begin
FLabel.Free;
For i := 0 to 2 do
FImage.Free;
For i:= 0 to 5 do
Fshape.Free;
FPanel.Free;
FPanel0.Free;
Inherited Destroy;
end;
Procedure Tmymb.SetCaption(Value : String);
begin
Flabel.Caption := Value;
FPanel.Caption := value;
end;
function Tmymb.GetCaption : String;
begin
Result := FLabel.Caption ;
end;
Procedure Tmymb.SetLed(Value : String);
var
i : Integer;
mm : string;
begin
For i := 4 to 8 do
begin
mm := copy(value,i,1) ;
if mm = '0' then //灯亮
begin
FShape[i-4].Pen.Color := clWhite;
FShape[i-4].Brush.Color := clLime;
FShape[i-4].Tag := 0;
end
else begin //灯灭
FShape[i-4].Pen.Color := clSkyBlue;
FShape[i-4].Brush.Color := clSilver;
FShape[i-4].Tag := 1;
end;
end;
if FShape[4].Tag = 0 then
begin
FImage[2].Picture.LoadFromFile( MyPath + 'pic/f_On.bmp' ); //光口灯亮
end
else
begin
FImage[2].Picture.LoadFromFile(MyPath + 'pic/f_Off.bmp'); //光口灯灭
end;
if FShape[2].Tag = 0 then
begin
FImage[0].Picture.LoadFromFile(MyPath + 'pic/t_On.bmp'); //电口 0 灯亮
end
else
begin
FImage[0].Picture.LoadFromFile(MyPath + 'pic/t_Off.bmp'); //电口 0 灯灭
end;
if FShape[3].Tag = 0 then
begin
FImage[1].Picture.LoadFromFile(MyPath + 'pic/t_On.bmp'); //电口 1 灯亮
end
else
begin
FImage[1].Picture.LoadFromFile(MyPath + 'pic/t_Off.bmp'); //电口 1 灯灭
end;
end;
Procedure Tmymb.Click;
begin
inherited;
if assigned(FOnClick) then FOnClick(Self);
end;
{
Procedure Tmymb.SetOnMbClick(Value : TNotifyEvent);
begin
FPanel.OnClick := Value;
end;
function Tmymb.GetOnMbClick : TNotifyEvent;
begin
Result := FPanel.OnClick ;
end;
}
Procedure Tmymb.SetAppPath(Value : String);
begin
MyPath := Value;
end;
end.
窗体中是这么用的。
unit shuxing;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Mymb, IdBaseComponent;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Procedure myclick(Sender : TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses main;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
mbb : Tmymb ;
begin
mbb := Tmymb.Create(self);
mbb.Parent := Form1;
mbb.MyAppPath := ExtractFilePath(Application.EXEName);
mbb.Led := '11111111';
mbb.Caption := '66';
mbb.OnClick := Myclick;
end;
Procedure TForm1.myclick(Sender : TObject);
begin
showmessage(Tmymb(sender).Caption);
end;
end.
请大家救我呀。
