为什么 设计期有效果 运行期的 没有效果.(100分)

  • 主题发起人 主题发起人 令狐小侠
  • 开始时间 开始时间

令狐小侠

Unregistered / Unconfirmed
GUEST, unregistred user!
大侠们 帮忙 看看
unit HlBitbtn;
interface
uses
SysUtils, Classes, StdCtrls,controls,windows,messages,graphics;
type
THlBitbtn = class(TButton)
private
FBmp: TbitMap;
FCanvas : TCanvas;
procedure SetBmp(const Value: TbitMap);
{ Private declarations }
protected
procedure DrawItem(DrawItemStruct : TDrawItemStruct);
{ Protected declarations }
procedure CNMeasureItem(var Message : TWMMeasureItem);
message CN_MeasureItem;
procedure CNDrawItem(var Message: TWMDrawItem);
message CN_DRAWITEM;
procedure CMEnabledChanged(var Message: TMessage);
message CM_ENABLEDCHANGED;
procedure CreateParams(var Params: TCreateParams);
override;
public
Constructor Create(Owner : Tcomponent);override;
Destructor Destroy;override;
{ Public declarations }
published
property Bmp:TbitMap read FBmp write SetBmp;
{ Published declarations }
end;

procedure Register;

implementation
procedure Register;
begin
RegisterComponents('HL', [THlBitbtn]);
end;

{ THlBitbtn }
procedure THlBitbtn.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;

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

procedure THlBitbtn.CNMeasureItem(var Message: TWMMeasureItem);
begin
message.MeasureItemStruct.itemWidth := width;
message.MeasureItemStruct.itemHeight := height;
end;

Constructor THlBitbtn.Create(Owner: Tcomponent);
begin
inherited Create(Owner);
Fbmp := TBitMap.Create;
fbmp.LoadFromFile('c:/a.bmp');
FCanvas := TCanvas.Create;
end;

procedure THlBitbtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(params);
Params.Style := Params.Style + BS_OWNERDRAW;
end;

destructor THlBitbtn.Destroy;
begin
Fbmp.Free;
FCanvas.Free;
inherited;
end;

procedure THlBitbtn.DrawItem(DrawItemStruct: TDrawItemStruct);
var
Rect,R : Trect;
begin
Rect := Fbmp.Canvas.ClipRect;
R := self.ClientRect;
Fcanvas.Handle := DrawItemStruct.hDC;
FCanvas.Brush.Color := clgray;
FCanvas.RoundRect (R.Left ,R.Top ,R.Right ,R.Bottom ,5,5);
Fcanvas.CopyRect(Rect,fbmp.Canvas,rect);
Fcanvas.Handle := 0;
end;

procedure THlBitbtn.SetBmp(const Value: TbitMap);
begin
FBmp := Value;
end;

end.
 
??????什么效果?
 
其实 很简单 就是在 button 上面 画了个筐,还画了个 bmp图而已..在设计期的时候
都有..但 一运行 就 没了..
 
你加一句:
protected
procedure SetButtonStyle(ADefault : Boolean);override;
...
procedure THlBitbtn.SetButtonStyle(ADefault : Boolean);
begin
//
end;

看看button的代码你就明白了:
procedure TButton.SetButtonStyle(ADefault: Boolean);
const
BS_MASK = $000F;
var
Style: Word;
begin
if HandleAllocated then
begin
if ADefault then
Style := BS_DEFPUSHBUTTON else
Style := BS_PUSHBUTTON;
if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
SendMessage(Handle, BM_SETSTYLE, Style, 1);
end;
end;
 
hs-kill 多谢..给分..没说的
 
后退
顶部