看了一天的VCL源代码,竟然没有发现哪句代码是画TRadioButton左边的圆圈的(100分)

  • 主题发起人 主题发起人 donkey
  • 开始时间 开始时间
invalidate最终触发的是WM_PAINT
而CN_DRAWITEM(其实就是WM_DRAWITEM)则是在状态改变时(比如按钮按下时)才会发送.并不是每个WM_PAINT里都会跟一个WM_DRAWITEM的
 
要在CreateParams里加上一句话:
procedure TBitBtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style := Style or BS_OWNERDRAW;
end;
 
>>>>>在快速点击的情况的下
>>>>>1.图像和点击无法同步显示
>>>>>2.有闪烁现象

解决方法:(见TBitBtn源代码)
procedure TBcButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
 
出不了XP效果是因为XP同时支持两套界面API,看你调用哪一套了。
 
请问如何调用出winxp的api?
 
由windows画的,delphi仅做了封装,而且所有标准windows部件经delphi封装后仅支持
以前版本的windows,所以在xp下不会由xp的效果。

有人说:
procedure TBitBtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style := Style or BS_OWNERDRAW;
end;
可能有道理,但我没试过。
 
to donkey:

VC和Delphi一样不作任何处理在XP下都是土头土脑的,你看到的VC的程序肯定在资源中加入了
program.exe.manifest。
我的QQ就是土头土脑的。它是VC做的,大家都知道吧。
 
真是难得的好东东,100篇不见一篇的好呀。
我在看个最简单的。Button的OnClick事件怎么就会响应鼠标点击呢?Konkey 一定会吧。
告诉我吧。我的QQ 26761119
E ww960122@163.com
 
to hamsoft:
我就是这样干的
to zw960122:我的源代码里面就重载了click,很简单的。

to 大家:
因为作了太多的尝试试验,所以代码很乱,明天我整理一下,然后贴出来,请大家指教。
事实上可以在上面作很多的变化
 
自己图也是非常简单的!!!
VCL是个外套,只负责消息的一般处理,真正实现是在Windows API源代码中,我们是没
机会看到的了。
 
我的源代码(已经上传到了www.playicq.com)

{-----------------------------------------------------------------------------
Unit Name: mybutton
Author: donkey
mailto: liaojb@21cn.com
Purpose: 一个自画的按钮,有picture和picturedown属性,分别用于显示按钮的常态
和按下状态,可以自行扩展其他的Picture属性以适应更多的状态
本代码仅用于示例,要实用还需加上一些代码,例如透明
History: 2002-6-14
-----------------------------------------------------------------------------}
unit mybutton;

interface

uses Messages, Windows, SysUtils, Controls, Forms, Classes, Menus, Graphics,
StdCtrls, ActnList;

type
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);
TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
TMyButton = class(TButtonControl)
private
FAlignment: TLeftRight;
FChecked: Boolean;
FPicture: TPicture;
FPictureDown: TPicture;
FCanvas: TCanvas;
FClickDown: Boolean;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure SetPicture(Value: TPicture);
procedure SetPictureDown(Value: TPicture);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Action;
property Anchors;
property BiDiMode;
property Caption;
property Checked;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property Picture: TPicture read FPicture write SetPicture;
property PictureDown: TPicture read FPictureDown write SetPictureDown;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;

implementation

constructor TMyButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TCanvas.Create;
FPicture := TPicture.Create;
FPictureDown := TPicture.Create;
Width := 113;
Height := 17;
ControlStyle := [csSetCaption, csDoubleClicks, csOpaque];
FAlignment := taRightJustify;
FClickDown := false;
Invalidate;
end;

destructor TMyButton.Destroy;
begin
inherited Destroy;
FCanvas.free;
FPicture.Free;
FPictureDown.Free;
end;

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

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

procedure TMyButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
IsDown: Boolean;
R: TRect;
//这是对图像进行透明处理用的内存bitmap,但是目前还没有加上透明处理代码
BufCanvas: TBitmap;
begin
R := ClientRect;
FCanvas.Handle := DrawItemStruct.hDC;
with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
end;
//打开这两句总是有效的
// FCanvas.Brush.Color := Color;
// FCanvas.FillRect (R);
//如果打开下面的这句注释,点击时会出现有时无法显示roundRect的效果的现象
// FCanvas.RoundRect (R.Left ,R.Top ,R.Right ,R.Bottom ,5,5);
try
BufCanvas := TBitmap.Create;
//在没有指定状态图像之前,我想让它显示出来,
// 但是下面这段代码没有达到应有的效果
if (csDesigning in ComponentState)or(csReading in ComponentState)or
(csLoading in ComponentState) then
begin
R:=BoundsRect ;
FCanvas.Pen.Color := clRed;
FCanvas.Brush.Color := clRed;
FCanvas.Brush.Style := bsSolid ;
FCanvas.FillRect(R);
end;
if isdown then
begin
//这下面三句是对图像进行透明处理的代码,打开会有效果,但是快速点击时会出现闪烁
//现象,看来还是要用缓冲的办法
// FPictureDown.Bitmap.Transparent := true;
// FPictureDown.Bitmap.TransparentColor := FPictureDown.Bitmap.Canvas.Pixels[0,0];
// FCanvas.StretchDraw(R, FPictureDown.Bitmap);
FCanvas.CopyMode := cmSrcCopy ;
R.Left := 0;
R.Right := FPictureDown.Bitmap.Width;
R.Top :=0;
R.Bottom := FPictureDown.Bitmap.Height ;
//使用下面的两句显示图像就不会出现闪烁了,直觉上两句的速度一样快,
//所以使用其中的一句就可以了
//FCanvas.CopyRect (R,FPictureDown.Bitmap.Canvas,R);
BitBlt(Fcanvas.Handle,R.Left,R.Top,R.Right-R.Left,R.Bottom-R.Top,
FPictureDown.Bitmap.Canvas.Handle,0,0,SRCCOPY);
end
else
// FCanvas.TextOut(R.Left +2,R.Top +2,Caption);
begin
// FPicture.Bitmap.Transparent := true;
// Picture.Bitmap.TransparentColor := FPicture.Bitmap.Canvas.Pixels[0,0];
// FCanvas.StretchDraw(R, FPicture.Bitmap );
R.Left := 0;
R.Right := FPicture.Bitmap.Width;
R.Top :=0;
R.Bottom := FPicture.Bitmap.Height ;
// FCanvas.CopyRect (R,FPicture.Bitmap.Canvas,R);
BitBlt(Fcanvas.Handle,R.Left,R.Top,R.Right-R.Left,R.Bottom-R.Top,
FPicture.Bitmap.Canvas.Handle,0,0,SRCCOPY);
end;
finally
BufCanvas.Free;
end;
end;

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

procedure TMyButton.SetPicture(Value: TPicture);
Var
R:TRect;
begin
FPicture.Assign(Value);

//我想根据图像大小调整按钮的大小,但是下面这一段代码在运行期没有没有任何效果,
//仅仅在设计期有效,我不知道为什么?
Height := FPicture.Bitmap.Height ;
Width := FPicture.Bitmap.Width ;
SetBounds(Left,Top,FPicture.Bitmap.Width,FPicture.Bitmap.Height);
R.Left := left;
R.Top := Top ;
R.Right := left+ FPicture.Bitmap.Width ;
R.Bottom := Top+ FPicture.Bitmap.Height ;
BoundsRect := R;
UpdateBoundsRect(R);


Invalidate;
end;

procedure TMyButton.SetPictureDown(Value: TPicture);
begin
FPictureDown.Assign(Value);
end;

procedure TMyButton.CreateParams(var Params: TCreateParams);
const
Alignments: array[Boolean, TLeftRight] of DWORD =
((BS_LEFTTEXT, 0), (0, BS_LEFTTEXT));
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'BUTTON');
with Params do

//在这里创建一个自画的按钮,这样不用从TWincontrol继承下来,再重写很多事件,属性
//之类的东西,仅仅重载几个必要的东东就可以了,省了很多事 :)

//我不明白为什么很多按钮的作者要从TWincontrol继承下来,再加上自己的画表面代码,
//控制代码等等,使事情复杂,而且可重用性很差

//我想根据图像的形状控制按钮的Region,但是不知道把代码加在哪里,不过我认为不会
//是在这里
Style := Style or BS_OWNERDRAW or //BS_RADIOBUTTON or
//改变这里的参数会变换界面
Alignments[UseRightToLeftAlignment, FAlignment];
end;

procedure TMyButton.CNCommand(var Message: TWMCommand);
begin
inherited;
if Message.NotifyCode = BN_CLICKED then Click;
end;

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

end.
 
下载的链接:http://www.playicq.com/dispdoc.asp?id=1201
 
有没有方法可以使TBitBtn在XP下像Button一样有XP的外观?
 
哎呀,这很明显的。windows中各种button(checkbox,button,radiobutton等)
是基本的窗口,有系统自己绘制的。
用api写一个程序就知道了,按钮用createwindow()来生成上面的各种按钮。
 
硬木花椒,能不能给个源代码?我很菜,不会。
或者你详细的说应该在哪里改。
 
肯定是Windows自己画的 createWindow
 
后退
顶部