R
redted
Unregistered / Unconfirmed
GUEST, unregistred user!
各位高手:我的组件终于初步成功。但还没有最终实现我的目标,请帮一把
原意是两个shape稍错一点,下而的黑色,上面的彩色,再加一个透明的Label,当MOuse滑过上面的Shape时变色,离开时又恢复原色。代码如下
procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
shape2.Brush.Color:=clLime;
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
ShowMessage('ok');
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
shape2.Brush.color:=clGreen;
end;
--------------------------------------------------------------
现在成形控件的代码如下
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms,
Dialogs, Buttons, ExtCtrls;
type
TddgButtonEdit = class(TWinControl)
private
{ Private declarations }
FShape1:TShape;
FShape2:TShape;
FLabel:TLabel;
protected
{ Protected declarations }
procedure WMSize(var Message:TWMSize);message WM_SIZE;
procedure SetCaption(Value:String);
function GetCaption:String;
function GetFont:TFont;
procedure SetFont(Value:TFont);
function GetOnLabelClick:TNotifyEvent;
procedure SetOnLabelClick(Value:TNotifyEvent);
public
{ Public declarations }
Constructor Create(AOWner:TComponent);override;
destructor Destroy;override;
published
{ Published declarations }
Property Caption:String read GetCaption Write SetCaption;
property Font:TFont read GetFont Write SetFont;
Property OnClick:TNotifyEvent read GetOnLabelClick Write SetOnLabelClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TddgButtonEdit]);
end;
procedure TddgButtonEdit.WMSize(var Message:TWMSize);
begin
inherited;
FShape2.Width:=Message.Width-2;
FShape2.Height:=Message.Height-4;
FShape2.left:=Message.Width-FShape2.Width;
FShape2.Top:=Message.Height-FShape2.Height;
FShape1.Left:=FShape2.Left-2;
FShape1.top:=FShape2.top-4;
end;
Constructor TddgButtonEdit.Create(AOWner:TComponent);
begin
inherited Create(AOWner);
FShape2:=TShape.create(self);
FShape2.Height:=42;
FShape2.Width:=77;
FShape2.Parent:=self;
FShape2.shape:=stEllipse;
FShape2.brush.Color:=clBlack;
FShape1:=TShape.create(self);
FShape1.Height:= FShape2.Height;
FShape1.Width:= FShape2.Width;
FShape1.Parent:=self;
FShape1.shape:=stEllipse;
FShape1.brush.Color:=clRed;
FLabel:=TLabel.Create(self);
FLabel.Left:=FShape1.Left+3;
FLabel.top:=FShape1.top+7;
FLabel.Height:=29;
FLabel.Width:=72;
FLabel.Height:=29;
FLabel.Width:=57;
FLabel.Alignment:=taCenter;
FLabel.AutoSize:=False;
FLabel.Parent:=self;
FLabel.Transparent:=true;
FLabel.Caption:='ColorButton';
FLabel.Font.Charset:=GB2312_CHARSET;
FLabel.Font.Size:=10;
Width:=FShape2.Width+2;
Height:=FShape2.height+4;
end;
destructor TddgButtonEdit.destroy;
begin
FShape1.free;
FShape2.free;
FLabel.Free;
inherited destroy;
end;
function TddgButtonEdit.GetCaption:String;
begin
Result:=FLabel.Caption;
end;
procedure TddgButtonEdit.SetCaption(Value:String);
begin
FLabel.Caption:=Value;
end;
function TddgButtonEdit.GetFont:TFont;
begin
Result:=FLabel.Font;
end;
procedure TddgButtonEdit.SetFont(Value:TFont);
begin
if Assigned(FLabel.Font) then
FLabel.Font.Assign(Value);
end;
function TddgButtonEdit.GetOnLabelClick:TNotifyEvent;
begin
Result:=FLabel.OnClick;
end;
procedure TddgButtonEdit.SetOnLabelClick(Value:TNotifyEvent);
begin
FLabel.OnClick:=Value;
end;
end.
我现在变色这一步实现不了,请帮一把,先谢
原意是两个shape稍错一点,下而的黑色,上面的彩色,再加一个透明的Label,当MOuse滑过上面的Shape时变色,离开时又恢复原色。代码如下
procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
shape2.Brush.Color:=clLime;
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
ShowMessage('ok');
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
shape2.Brush.color:=clGreen;
end;
--------------------------------------------------------------
现在成形控件的代码如下
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms,
Dialogs, Buttons, ExtCtrls;
type
TddgButtonEdit = class(TWinControl)
private
{ Private declarations }
FShape1:TShape;
FShape2:TShape;
FLabel:TLabel;
protected
{ Protected declarations }
procedure WMSize(var Message:TWMSize);message WM_SIZE;
procedure SetCaption(Value:String);
function GetCaption:String;
function GetFont:TFont;
procedure SetFont(Value:TFont);
function GetOnLabelClick:TNotifyEvent;
procedure SetOnLabelClick(Value:TNotifyEvent);
public
{ Public declarations }
Constructor Create(AOWner:TComponent);override;
destructor Destroy;override;
published
{ Published declarations }
Property Caption:String read GetCaption Write SetCaption;
property Font:TFont read GetFont Write SetFont;
Property OnClick:TNotifyEvent read GetOnLabelClick Write SetOnLabelClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TddgButtonEdit]);
end;
procedure TddgButtonEdit.WMSize(var Message:TWMSize);
begin
inherited;
FShape2.Width:=Message.Width-2;
FShape2.Height:=Message.Height-4;
FShape2.left:=Message.Width-FShape2.Width;
FShape2.Top:=Message.Height-FShape2.Height;
FShape1.Left:=FShape2.Left-2;
FShape1.top:=FShape2.top-4;
end;
Constructor TddgButtonEdit.Create(AOWner:TComponent);
begin
inherited Create(AOWner);
FShape2:=TShape.create(self);
FShape2.Height:=42;
FShape2.Width:=77;
FShape2.Parent:=self;
FShape2.shape:=stEllipse;
FShape2.brush.Color:=clBlack;
FShape1:=TShape.create(self);
FShape1.Height:= FShape2.Height;
FShape1.Width:= FShape2.Width;
FShape1.Parent:=self;
FShape1.shape:=stEllipse;
FShape1.brush.Color:=clRed;
FLabel:=TLabel.Create(self);
FLabel.Left:=FShape1.Left+3;
FLabel.top:=FShape1.top+7;
FLabel.Height:=29;
FLabel.Width:=72;
FLabel.Height:=29;
FLabel.Width:=57;
FLabel.Alignment:=taCenter;
FLabel.AutoSize:=False;
FLabel.Parent:=self;
FLabel.Transparent:=true;
FLabel.Caption:='ColorButton';
FLabel.Font.Charset:=GB2312_CHARSET;
FLabel.Font.Size:=10;
Width:=FShape2.Width+2;
Height:=FShape2.height+4;
end;
destructor TddgButtonEdit.destroy;
begin
FShape1.free;
FShape2.free;
FLabel.Free;
inherited destroy;
end;
function TddgButtonEdit.GetCaption:String;
begin
Result:=FLabel.Caption;
end;
procedure TddgButtonEdit.SetCaption(Value:String);
begin
FLabel.Caption:=Value;
end;
function TddgButtonEdit.GetFont:TFont;
begin
Result:=FLabel.Font;
end;
procedure TddgButtonEdit.SetFont(Value:TFont);
begin
if Assigned(FLabel.Font) then
FLabel.Font.Assign(Value);
end;
function TddgButtonEdit.GetOnLabelClick:TNotifyEvent;
begin
Result:=FLabel.OnClick;
end;
procedure TddgButtonEdit.SetOnLabelClick(Value:TNotifyEvent);
begin
FLabel.OnClick:=Value;
end;
end.
我现在变色这一步实现不了,请帮一把,先谢