关于TBUTTON的控制问提，高手请进！(100分)

我想做一个控件，继承Tbutton,当鼠标移到此类按钮时加一编框颜色或者将字体颜色改成红色，应该怎样写？

问题: 如何改变控件Button的颜色？ ( 积分: 100 )
分类: 控件 - 开发

来自: 小弟（陈生）, 时间: 2002-11-11 18:43:00, ID: 1425534
要求做到的效果是：当鼠标移到Button控件上颜色就改变；移开鼠标颜色就变回原来的颜色。


来自: misxjq, 时间: 2002-11-11 18:45:00, ID: 1425535
你是改变button的背景颜色还是字体颜色？清说清楚！

来自: xyl999, 时间: 2002-11-11 18:47:00, ID: 1425538
button.color := clBlue
button.font.color := clwhite;
..................

来自: Derlin, 时间: 2002-11-11 18:48:00, ID: 1425541
可以用FlatButton 第三方控件

来自: louhong, 时间: 2002-11-11 18:54:00, ID: 1425558
在OnEnter里：
button1.color:=clXXXX; //你想要的颜色
在OnExit里：
button1.color:=clUUUU;//你原来的颜色

来自: aizb, 时间: 2002-11-11 19:54:00, ID: 1425644
如果不想用第三方控件也不想用TSpeedButton的话(为什么不用呢?),
你就需要自己定一个控件了,至于如何写,你可以分析一下Delphi的Buttons
单元中的TBitBtn控件的源码,你可以从TBitbtn上继承,主要是要重载DrawItem方法,
不过很遗憾,DrawItem方法是静态方法,不能重载了,所以只好重载CN_DRAWITEM消息处
理函数,这个函数的执行过程可以参照DrawItem方法,只不过加入绘制颜色的语句
就可以了,不过别忘了增加两个颜色属性.

另外如果要做到鼠标感知,还需要重载CM_MOUSEENTER和CM_MOUSELEAVE消息处理函数.

来自: aizb, 时间: 2002-11-11 19:56:00, ID: 1425648
楼上有两位,如果用过Delphi的话请看看TButton控件有没有Color属性.

来自: 小弟（陈生）, 时间: 2002-11-11 20:02:00, ID: 1425657
是改变字体的颜色，有办法吗？

来自: 宁柯, 时间: 2002-11-11 20:08:00, ID: 1425663
我倒是有个主意，你干脆用Panel组件算了，在Panel组件的OnClick时间里面写处理的
代码，在OnEnter和OnExit里面写改变颜色的代码！

来自: 老人家, 时间: 2002-11-11 20:08:00, ID: 1425664
SetCaptureControl
呵呵

来自: Richard3000, 时间: 2002-11-11 21:09:00, ID: 1425761
>>是改变字体的颜色，有办法吗？
這個好辦,font.color:=..
改變Button的顏色就不容易了,可以用別的控件或者有Panel代替,我用的是
Panel不過也不好,Enable=False的時候,不能變成灰色



来自: aizb, 时间: 2002-11-11 21:13:00, ID: 1425772
如果一定要用TButton的话,改变字体的颜色也不行,如果仅仅是改变字体的颜色的话,用TBitbtn不就可以了?

来自: delphi浪客, 时间: 2002-11-12 3:54:00, ID: 1426113
两个消息
Procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
Procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
再这里面修改颜色


来自: 小弟（陈生）, 时间: 2002-11-12 7:36:00, ID: 1426140
如果可以的话，请把原代码写出来，好让我参考参考，因为我是个初学者有许多不明的地方。

来自: vine, 时间: 2002-11-12 10:54:00, ID: 1426633
问题是TButton和TbitBtn都没有publish Color这个属性
如果你要设置字体颜色用TbitBtn还可以

可以用其它第三方控件
如CoolCOntrols
里面的TCoolBtn有Color属性
还有onMouseLeave 和　onMouseEnter事件
设置就方便啦
在51delphi有下

来自: aizb, 时间: 2002-11-12 20:28:00, ID: 1428083
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;

type
TMyBitBtn = class(TBitBtn)
private
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
published

end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
BT:TMyBitBtn;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TMyBitBtn }

procedure TMyBitBtn.CMMouseEnter(var Message: TMessage);
begin
inherited;
Font.Color:=clRed;
Font.Size:=16;
Refresh;
end;

procedure TMyBitBtn.CMMouseLeave(var Message: TMessage);
begin
inherited;
Font.Color:=clBtnText;
Font.Size:=9;
Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
BT:=TMyBitBtn.Create(Self);
BT.Caption:='NewButton';
BT.Parent:=Self;
BT.Width:=150;
BT.Height:=50;
end;

end.


来自: wr960204, 时间: 2002-11-13 8:48:00, ID: 1428620
Tbutton的颜色并没有公开出来。
可以TLable(Button1).Color:=clBlue;

来自: wql, 时间: 2002-11-13 9:14:00, ID: 1428682
试了一下,可以改变字体的颜色,Font.Color:=clRed改为Color:=clRed; 后可以看到快速
的 Button颜色红了一下又改变会灰色,再试
procedure TMyBitBtn.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
inherited;
brush.Color:=clred;
end;
也不行!



来自: 视觉音乐, 时间: 2002-11-13 9:19:00, ID: 1428702
这个问题以前讨论过的，用强制转换可以，因为button的canvas属性是只读的。

来自: aizb, 时间: 2002-11-14 18:37:00, ID: 1432480
你们不用去试验了,不行的,如果要改变按钮的颜色只有重写CN_DRAWITEM消息.至于字体颜色嘛,用TBitbtn不用改什么不就可以了?

来自: jsxjd, 时间: 2002-11-14 21:55:00, ID: 1432908
是比较难的。

来自: cnjyl, 时间: 2002-11-14 22:36:00, ID: 1432966
同意上面说法。除非自已写组件。

来自: whynozg, 时间: 2002-11-17 13:01:00, ID: 1437277
API 函数

来自: joe-liu, 时间: 2002-11-29 14:20:00, ID: 1471284
button控件沒有color的屬性呀.....,用bitbtn吧....

来自: 小乙, 时间: 2002-11-29 14:28:00, ID: 1471315
可以用Toolbar+Imaglist组合，并且Toolbar.button的Flat属性设为True;imagelist属性...
自己领悟去吧！

来自: protagonist, 时间: 2002-11-29 14:42:00, ID: 1471367
Button的变色问题是个值得研究，假如急得话就用Bitbtn先代替一下。
不急的话可以学习学习。

来自: cowbird, 时间: 2002-11-29 14:45:00, ID: 1471378
关注中。。。

来自: hpn_cao(小海), 时间: 2002-12-07 16:15:00, ID: 1493088
unit Button1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;

type
TButton1 = class(TButton)
private
FColor: TColor;
FCanvas: TCanvas;
IsFocused: Boolean;
procedure SetColor(Value: TColor);
procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;

procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState);

protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Color: TColor read FColor write SetColor default clBtnFace;
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TButton1]);
end;

{ TButton1 }

procedure TButton1.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;

procedure TButton1.CMFontChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;

procedure TButton1.CNDrawItem(var Message: TWMDrawItem);
begin
DrawItem(Message.DrawItemStruct^);
end;

procedure TButton1.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemWidth := Width;
itemHeight := Height;
end;
end;

constructor TButton1.Create(AOwner: TComponent);
begin
inherited;
FCanvas := TCanvas.Create;
FColor := clBtnFace;
end;

procedure TButton1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or BS_OWNERDRAW;
end;

destructor TButton1.Destroy;
begin
FCanvas.Free;
inherited;
end;

procedure TButton1.DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState);
begin
with Canvas do
begin
Brush.Style := bsClear;
if State = bsDisabled then
begin
OffsetRect(TextBounds, 1, 1);
Font.Color := clWhite;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
OffsetRect(TextBounds, -1, -1);
Font.Color := clDkGray;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
end else
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
end;

procedure TButton1.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
IsDown, IsDefault: Boolean;
State: TButtonState;
R: TRect;
begin
FCanvas.Handle := DrawItemStruct.hDC;
R := ClientRect;

with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
IsDefault := itemState and ODS_FOCUS <> 0;
if not Enabled then State := bsDisabled
else if IsDown then State := bsDown
else State := bsUp;
end;

if IsFocused or IsDefault then
begin
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

InflateRect(R, -1, -1);
end;

if IsDown then
begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := FColor;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
InflateRect(R, -1, -1);
end
else
with FCanvas do
begin
DrawEdge(Handle, R, BDR_RAISEDINNER or BDR_RAISEDOUTER, BF_RECT or BF_ADJUST);
FCanvas.Pen.Color := FColor;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := FColor;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
InflateRect(R, -1, -1);
end;

if IsFocused then
begin
R := ClientRect;


问题讨论没有结束 ...

给分吧！刚给你写的；粘进去就能用！你也可以提出来写成控件！
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
Tmybutton = class(TButton)
private
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
AForm:TComponent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
public
constructor Create(AOwner: TComponent); override;
published
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ Tmybutton }


constructor Tmybutton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AForm:=AOwner;
end;

procedure Tmybutton.CMMouseEnter(var Message: TMessage);
begin
inherited;
if (AForm is TForm) then
begin
(AForm as TForm).Canvas.Pen.Width:=2;
(AForm as TForm).Canvas.Pen.Color:=clblue;
(AForm as TForm).Canvas.Rectangle(self.Left-2,self.Top-2,self.Left+self.Width+2,self.Top+2+self.hEIGHT);
end;
end;

procedure Tmybutton.CMMouseLeave(var Message: TMessage);
begin
inherited;
if (AForm is TForm) then
begin
(AForm as TForm).Canvas.Pen.Width:=2;
(AForm as TForm).Canvas.Pen.Color:=Form1.Color;
(AForm as TForm).Canvas.Rectangle(self.Left-2,self.Top-2,self.Left+self.Width+2,self.Top+2+self.hEIGHT);
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
MyButton:TMybutton;
begin
MyButton:=TMybutton.Create(Self);
MyButton.Parent:=self;
MyButton.Left:=10;
MyButton.Top:=10;
end;

end.

重载鼠标的移动消息

我刚才用鼠标的移动消息处理了，但有不尽人意的地方，我希望Tbutton在设计阶段字体为黑色，当鼠标移入字体则变成设置的（红色），当鼠标移出字体则变成设置的（黑色）但在设计时候，如果鼠标移到Tbutton时则变成红色了，请问有没有什么解决办法？代码如下：
unit BitBtn_HD;

interface

uses
SysUtils, Classes, Controls, StdCtrls, Buttons,QGraphics,QControls,QDialogs;

type
TBitBtn_HD = class(TBitBtn)
private
{ Private declarations }
FEnterFontColor:TColor; //获得焦点时候字体颜色
FEnterCursor:TCursor; //获得焦点时候鼠标的形状
procedure SetEnterFontColor(const value:TColor);
procedure SetEnterCursor(const value:TCursor);
protected
{ Protected declarations }
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property EnterFontColor : TColor read FEnterFontColor write SetEnterFontColor default clred;
property EnterCursor : TCursor read FEnterCursor write SetEnterCursor default crHandPoint;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('HDPublic', [TBitBtn_HD]);
end;

procedure TBitBtn_HD.SetEnterFontColor(const value:TColor);
begin
if FEnterFontColor<> value then FEnterFontColor:=value;
end;

procedure TBitBtn_HD.SetEnterCursor(const value:TCursor);
begin
if FEnterCursor<> value then FEnterCursor:=value;
end;

procedure TBitBtn_HD.CMMouseEnter(var Message: TMessage);
begin
if TBitBtn_HD=nil then exit;
Font.Color:=EnterFontColor;
Cursor:= crHandPoint;
Refresh;
end;

procedure TBitBtn_HD.CMMouseLeave(var Message: TMessage);
begin
if TBitBtn_HD=nil then exit;
Font.color:=clWindowText;
Cursor:= crDefault;
Refresh;
end;

constructor TBitBtn_HD.Create(AOwner: TComponent);
begin
inherited;
EnterFontColor:=clred;
FEnterCursor:= crHandPoint;
Font.Color:=clWindowText;
Cursor:= crDefault;
end;

end.

怎么没人回答呢

简单。通过消息处理就行了。
TMySpeedButton=CLASS(TMySpeedButton)
procedure CMMOUSEENTER(var Message:TMessage); Message CM_MOUSEENTER;
procedure CMMOUSELEAVE(var Message:TMessage); Message CM_MOUSELEAVE;
procedure TMySpeedButton.CMMOUSEENTER(var Message:TMessage);
begin
if not(csDesigning in ComponentState) then
begin
Font.Color:=clred;
end;
inherited;
end;
procedure TMySpeedButton.CMMOUSELEAVE(var Message:TMessage);
begin
if not(csDesigning in ComponentState) then
begin
Font.Color:=clblack;
end;
inherited;
end;

to hzjone：
谢谢你，
我还有一问题，请问怎么处理：
1、我有一button是冲TBitBtn继承得到的，当他得到焦点时候会触发什么事件(是不是onEnter事件)或得到什么消息？
2、如果是事件的话，为何我在TBitBtn看到onEnter是TBitBtn的一个属性？

button从TBitBtn继承得到hzjone方法根本不行！speedbutton本身的font.color是有用的！

to 清新空气 我的意思是要达到如下效果：
当TBitBtn获得焦点时候将字体改成红色(但不在onEnter事件写),失去焦点时候字体改成黑色(但不在onExitr事件写)，

清新空气,这样你认为BITBTN没有FONT,了吗?哈哈.
得到焦点,以前有写了一个从BUTTON继承下来能变背景色,画边框的,控件.
procedure WMSETFOCUS(var Message:TWMSetFocus); Message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message:TWMKillFocus); Message WM_KILLFOCUS;

procedure TMySpeedButton.DrawFocus;
var
Offset :integer;
Rect :TRect;
begin
if FFocused then
begin
Offset:=5;
self.Canvas.Brush.Color:=clWhite;
Rect.Left:=Offset;
Rect.Top:=Offset;
Rect.Right:=self.Width-Offset;
Rect.Bottom:=self.Height-Offset;
self.Canvas.DrawFocusRect(Rect);
end;
end;

谢谢，hzjone
又要麻烦你了，
能不能给我讲一下用delphi做ocx的详细过程及注意事项，
在里面如何增加一函数

废话！从Tbutton继承的类，画边框的我上边早就写了完全可以用；
我是说从Tbutton继承的类你的方法不能改变按钮上面字体的颜色！

谁能讲一下用delphi做ocx的详细过程及注意事项，
在里面如何增加一函数，为什么我在ocx里写的函数(Get_StrID)在调用时候不能看到,但函数ConnDB在调用时候能看到[?]？
unit ActiveQryFilter_HDImpl;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ActiveX, AxCtrls, ActiveQryFilter_HDProj_TLB, StdVcl, StdCtrls, Buttons,
DB, ADODB, Grids, DBGrids, ExtCtrls;

type
TActiveQryFilter_HD = class(TActiveForm, IActiveQryFilter_HD)
Panel1: TPanel;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
BitBtn_Find: TBitBtn;
BitBtn_Load: TBitBtn;
BitBtn_Select: TBitBtn;
BitBtn4: TBitBtn;
RadioGroup1: TRadioGroup;
Label1: TLabel;
Ed_value: TEdit;
procedure BitBtn4Click(Sender: TObject);
procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DBGrid1DblClick(Sender: TObject);
procedure BitBtn_SelectClick(Sender: TObject);
private
{ Private declarations }
FEvents: IActiveQryFilter_HDEvents;
procedure ActivateEvent(Sender: TObject);
procedure ClickEvent(Sender: TObject);
procedure CreateEvent(Sender: TObject);
procedure DblClickEvent(Sender: TObject);
procedure DeactivateEvent(Sender: TObject);
procedure DestroyEvent(Sender: TObject);
procedure KeyPressEvent(Sender: TObject; var Key: Char);
procedure PaintEvent(Sender: TObject);
protected
{ Protected declarations }
procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
procedure EventSinkChanged(const EventSink: IUnknown); override;
function Get_Active: WordBool; safecall;
function Get_AlignDisabled: WordBool; safecall;
function Get_AutoScroll: WordBool; safecall;
function Get_AutoSize: WordBool; safecall;
function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
function Get_Caption: WideString; safecall;
function Get_Color: OLE_COLOR; safecall;
function Get_DoubleBuffered: WordBool; safecall;
function Get_DropTarget: WordBool; safecall;
function Get_Enabled: WordBool; safecall;
function Get_Font: IFontDisp; safecall;
function Get_HelpFile: WideString; safecall;
function Get_KeyPreview: WordBool; safecall;
function Get_PixelsPerInch: Integer; safecall;
function Get_PrintScale: TxPrintScale; safecall;
function Get_Scaled: WordBool; safecall;
function Get_ScreenSnap: WordBool; safecall;
function Get_SnapBuffer: Integer; safecall;
function Get_Visible: WordBool; safecall;
function Get_VisibleDockClientCount: Integer; safecall;
procedure _Set_Font(var Value: IFontDisp); safecall;
procedure Set_AutoScroll(Value: WordBool); safecall;
procedure Set_AutoSize(Value: WordBool); safecall;
procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
procedure Set_Caption(const Value: WideString); safecall;
procedure Set_Color(Value: OLE_COLOR); safecall;
procedure Set_DoubleBuffered(Value: WordBool); safecall;
procedure Set_DropTarget(Value: WordBool); safecall;
procedure Set_Enabled(Value: WordBool); safecall;
procedure Set_Font(const Value: IFontDisp); safecall;
procedure Set_HelpFile(const Value: WideString); safecall;
procedure Set_KeyPreview(Value: WordBool); safecall;
procedure Set_PixelsPerInch(Value: Integer); safecall;
procedure Set_PrintScale(Value: TxPrintScale); safecall;
procedure Set_Scaled(Value: WordBool); safecall;
procedure Set_ScreenSnap(Value: WordBool); safecall;
procedure Set_SnapBuffer(Value: Integer); safecall;
procedure Set_Visible(Value: WordBool); safecall;

procedure Set_StrID(const Value: WideString); safecall;
public
{ Public declarations }
procedure Initialize; override;
procedure ConnDB(const AStrConn: WideString); safecall;
function Get_StrID: WideString; safecall;
end;

var
RtStr:WideString='';
implementation

uses ComObj, ComServ;

{$R *.DFM}

{ TActiveQryFilter_HD }

procedure TActiveQryFilter_HD.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
{ Define property pages here. Property pages are defined by calling
DefinePropertyPage with the class id of the page. For example,
DefinePropertyPage(Class_ActiveQryFilter_HDPage); }
end;

procedure TActiveQryFilter_HD.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IActiveQryFilter_HDEvents;
inherited EventSinkChanged(EventSink);
end;

procedure TActiveQryFilter_HD.Initialize;
begin
inherited Initialize;
OnActivate := ActivateEvent;
OnClick := ClickEvent;
OnCreate := CreateEvent;
OnDblClick := DblClickEvent;
OnDeactivate := DeactivateEvent;
OnDestroy := DestroyEvent;
OnKeyPress := KeyPressEvent;
OnPaint := PaintEvent;
end;

function TActiveQryFilter_HD.Get_Active: WordBool;
begin
Result := Active;
end;

function TActiveQryFilter_HD.Get_AlignDisabled: WordBool;
begin
Result := AlignDisabled;
end;

function TActiveQryFilter_HD.Get_AutoScroll: WordBool;
begin
Result := AutoScroll;
end;

function TActiveQryFilter_HD.Get_AutoSize: WordBool;
begin
Result := AutoSize;
end;

function TActiveQryFilter_HD.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
Result := Ord(AxBorderStyle);
end;

function TActiveQryFilter_HD.Get_Caption: WideString;
begin
Result := WideString(Caption);
end;

function TActiveQryFilter_HD.Get_Color: OLE_COLOR;
begin
Result := OLE_COLOR(Color);
end;

function TActiveQryFilter_HD.Get_DoubleBuffered: WordBool;
begin
Result := DoubleBuffered;
end;

function TActiveQryFilter_HD.Get_DropTarget: WordBool;
begin
Result := DropTarget;
end;

function TActiveQryFilter_HD.Get_Enabled: WordBool;
begin
Result := Enabled;
end;

function TActiveQryFilter_HD.Get_Font: IFontDisp;
begin
GetOleFont(Font, Result);
end;

function TActiveQryFilter_HD.Get_HelpFile: WideString;
begin
Result := WideString(HelpFile);
end;

function TActiveQryFilter_HD.Get_KeyPreview: WordBool;
begin
Result := KeyPreview;
end;

function TActiveQryFilter_HD.Get_PixelsPerInch: Integer;
begin
Result := PixelsPerInch;
end;

function TActiveQryFilter_HD.Get_PrintScale: TxPrintScale;
begin
Result := Ord(PrintScale);
end;

function TActiveQryFilter_HD.Get_Scaled: WordBool;
begin
Result := Scaled;
end;

function TActiveQryFilter_HD.Get_ScreenSnap: WordBool;
begin
Result := ScreenSnap;
end;

function TActiveQryFilter_HD.Get_SnapBuffer: Integer;
begin
Result := SnapBuffer;
end;

function TActiveQryFilter_HD.Get_Visible: WordBool;
begin
Result := Visible;
end;

function TActiveQryFilter_HD.Get_VisibleDockClientCount: Integer;
begin
Result := VisibleDockClientCount;
end;

procedure TActiveQryFilter_HD._Set_Font(var Value: IFontDisp);
begin
SetOleFont(Font, Value);
end;

procedure TActiveQryFilter_HD.ActivateEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnActivate;
end;

procedure TActiveQryFilter_HD.ClickEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnClick;
end;

procedure TActiveQryFilter_HD.CreateEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnCreate;
end;

procedure TActiveQryFilter_HD.DblClickEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TActiveQryFilter_HD.DeactivateEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TActiveQryFilter_HD.DestroyEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TActiveQryFilter_HD.KeyPressEvent(Sender: TObject;
var Key: Char);
var
TempKey: Smallint;
begin
TempKey := Smallint(Key);
if FEvents <> nil then FEvents.OnKeyPress(TempKey);
Key := Char(TempKey);
end;

procedure TActiveQryFilter_HD.PaintEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnPaint;
end;

procedure TActiveQryFilter_HD.Set_AutoScroll(Value: WordBool);
begin
AutoScroll := Value;
end;

procedure TActiveQryFilter_HD.Set_AutoSize(Value: WordBool);
begin
AutoSize := Value;
end;

procedure TActiveQryFilter_HD.Set_AxBorderStyle(
Value: TxActiveFormBorderStyle);
begin
AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TActiveQryFilter_HD.Set_Caption(const Value: WideString);
begin
Caption := TCaption(Value);
end;

procedure TActiveQryFilter_HD.Set_Color(Value: OLE_COLOR);
begin
Color := TColor(Value);
end;

procedure TActiveQryFilter_HD.Set_DoubleBuffered(Value: WordBool);
begin
DoubleBuffered := Value;
end;

procedure TActiveQryFilter_HD.Set_DropTarget(Value: WordBool);
begin
DropTarget := Value;
end;

procedure TActiveQryFilter_HD.Set_Enabled(Value: WordBool);
begin
Enabled := Value;
end;

procedure TActiveQryFilter_HD.Set_Font(const Value: IFontDisp);
begin
SetOleFont(Font, Value);
end;

procedure TActiveQryFilter_HD.Set_HelpFile(const Value: WideString);
begin
HelpFile := String(Value);
end;

procedure TActiveQryFilter_HD.Set_KeyPreview(Value: WordBool);
begin
KeyPreview := Value;
end;

procedure TActiveQryFilter_HD.Set_PixelsPerInch(Value: Integer);
begin
PixelsPerInch := Value;
end;

procedure TActiveQryFilter_HD.Set_PrintScale(Value: TxPrintScale);
begin
PrintScale := TPrintScale(Value);
end;

procedure TActiveQryFilter_HD.Set_Scaled(Value: WordBool);
begin
Scaled := Value;
end;

procedure TActiveQryFilter_HD.Set_ScreenSnap(Value: WordBool);
begin
ScreenSnap := Value;
end;

procedure TActiveQryFilter_HD.Set_SnapBuffer(Value: Integer);
begin
SnapBuffer := Value;
end;

procedure TActiveQryFilter_HD.Set_Visible(Value: WordBool);
begin
Visible := Value;
end;

procedure TActiveQryFilter_HD.BitBtn4Click(Sender: TObject);
begin
close;
end;

procedure TActiveQryFilter_HD.ConnDB(const AStrConn: WideString);
begin
ADOConnection1.Close;
self.ADOConnection1.ConnectionString:=AStrConn;
self.ADOConnection1.Open;
with self.ADOQuery1 do
begin
close;
sql.Clear;
sql.Text:=' select * from studentinfo ';
open;
first;
end;
end;

procedure TActiveQryFilter_HD.DBGrid1KeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if key=13 then self.BitBtn_Select.Click;
end;

procedure TActiveQryFilter_HD.DBGrid1DblClick(Sender: TObject);
begin
self.BitBtn_Select.Click;
end;

procedure TActiveQryFilter_HD.BitBtn_SelectClick(Sender: TObject);
begin
if not self.ADOQuery1.Active then exit;
if self.ADOQuery1.RecordCount=0 then exit;
RtStr:=Trim(self.ADOQuery1.fieldbyname('id').AsString);
end;

function TActiveQryFilter_HD.Get_StrID: WideString;
begin
result:=RtStr;
end;

procedure TActiveQryFilter_HD.Set_StrID(const Value: WideString);
begin

end;

initialization
TActiveFormFactory.Create(
ComServer,
TActiveFormControl,
TActiveQryFilter_HD,
Class_ActiveQryFilter_HD,
1,
'',
OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
tmApartment);
end.

怎么没人回答呢，谢谢各位大虾

我代码如下：
A、~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure CMEnter(var Message: TMessage); message CBN_SETFOCUS;//获得焦点消息
procedure CMExit(var Message: TMessage); message CBN_KILLFOCUS;//失去焦点消息
procedure TComboBox_HD.CMEnter(var Message: TMessage);
begin
inherited;
if (csDesigning in ComponentState) then exit;
showmessage('enter');
Color:=EnterColor;
font.Color:=EnterFontColor;
end;

procedure TComboBox_HD.CMExit(var Message: TMessage);
begin
inherited;
if (csDesigning in ComponentState) then exit;
showmessage('exit');
Color:=OutColor;
font.Color:=OutFontColor;
end;

B、~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.ComboBox1Enter(Sender: TObject);
begin
self.ComboBox1.Color:=clBlue;
self.ComboBox1.Font.Color:=clRed;
end;

procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
self.ComboBox1.Color:=clWindow;
self.ComboBox1.Font.Color:=clWindowText;
end;

为什么A段写法不能触发得到焦点和失去焦点
而B段写法能触发得到焦点和失去焦点

请各位大虾给帮忙看看，我没分了只能在贵地发一下 拜托，先谢谢了[!]

怎么没人回答呢，谢谢各位大虾

别人已经回答得很清楚了
答案就在上面的代码里面
你所要做的就是把有用的东西提取出来
这点分析能力都应该是有的吧

to 一条大鱼, 我的意思是
TCOMBOBOX
获得焦点的消息：CBN_SETFOCUS
失去焦点的消息：CBN_KILLFOCUS
还是
获得焦点的消息：WM_SETFOCUS
失去焦点的消息：WM_KILLFOCUS
procedure CMEnter(var Message: TMessage); message CBN_SETFOCUS(消息号)
对不对？

怎么没人知道啊，TCOMBOBOX获得焦点和失去焦点的消息号是？