Imgbtn with caption?
Is it possible to add a caption to an Timgbtn?Caption like a normal button has?
Couse now its only an image button with 3 states. I've tried imgbtn.canvas.textout(x,y,text) >> this only works when theres no bitmap loaded
Delphi-Quellcode:
unit ImgBtn;
interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TOnMouseEvent = procedure( Msg: TWMMouse ) of object; TImgBtn = class( TImage ) protected procedure WMMouseEnter( var Msg : TWMMouse ); message CM_MOUSEENTER; procedure WMMouseLeave( var Msg : TWMMouse ); message CM_MOUSELEAVE; procedure WMLButtonUp( var Msg : TWMLButtonUp ); message WM_LBUTTONUP; procedure WMLButtonDown( var Msg : TWMLButtonUp ); message WM_LBUTTONDOWN; private FEntered : boolean; FDown : boolean; FOnMouseEnter : TOnMouseEvent; FOnMouseLeave : TOnMouseEvent; FOnMouseDown : TOnMouseEvent; FOnMouseUp : TOnMouseEvent; FPic : TPicture; FPicDown : TPicture; FPicUp : TPicture; FSupported : boolean; procedure SetPic( Value : TPicture ); procedure SetPicDown( Value : TPicture ); procedure SetPicUp( Value : TPicture ); public constructor Create( AOwner: TComponent ); override; destructor Destroy; override; published //** Images **// property Pic : TPicture read FPic write SetPic; property PicDown : TPicture read FPicDown write SetPicDown; property PicUp : TPicture read FPicUp write SetPicUp; //** Events **// property OnMouseDown : TOnMouseEvent read FOnMouseDown write FOnMouseDown; property OnMouseEnter : TOnMouseEvent read FOnMouseEnter write FOnMouseEnter; property OnMouseLeave : TOnMouseEvent read FOnMouseLeave write FOnMouseLeave; property OnMouseUp : TOnMouseEvent read FOnMouseUp write FOnMouseUp; property Supported : boolean read FSupported write FSupported; end; procedure Register; implementation {$R *.RES} (*******************************************************************************) procedure Register; begin RegisterComponents( 'Plus', [ TImgBtn ] ); end; (*******************************************************************************) constructor TImgBtn.Create; begin inherited; FPic := TPicture.Create; FPicUp := TPicture.Create; FPicDown := TPicture.Create; FEntered := False; FDown := False; FSupported := True; end; (*******************************************************************************) destructor TImgBtn.Destroy; begin FPic.Free; FPicDown.Free; FPicUp.Free; inherited; end; (*******************************************************************************) procedure TImgBtn.WMMouseEnter( var Msg: TWMMouse ); begin if not FSupported then Exit; FEntered := True; if FDown then Picture := FPicDown else Picture := FPicUp; if Assigned( FOnMouseEnter ) then FOnMouseEnter( Msg ); end; (*******************************************************************************) procedure TImgBtn.WMMouseLeave( var Msg: TWMMouse ); begin if not FSupported then Exit; FEntered := False; Picture := FPic; if Assigned( FOnMouseLeave ) then FOnMouseLeave( Msg ); end; (*******************************************************************************) procedure TImgBtn.WMLButtonDown(var Msg: TWMMouse); begin inherited; if not FSupported then Exit; FDown := True; if FEntered then Picture := FPicDown; if Assigned( FOnMouseDown ) then FOnMouseDown( Msg ); end; (*******************************************************************************) procedure TImgBtn.WMLButtonUp(var Msg: TWMMouse); begin inherited; if not FSupported then Exit; FDown := False; if FEntered then Picture := FPicUp; if Assigned( FOnMouseUp ) then FOnMouseUp( Msg ); end; (*******************************************************************************) procedure TImgBtn.SetPic( Value : TPicture ); begin Picture := Value; FPic.Assign( Value ); end; (*******************************************************************************) procedure TImgBtn.SetPicDown( Value : TPicture ); begin FPicDown.Assign( Value ); end; (*******************************************************************************) procedure TImgBtn.SetPicUp( Value : TPicture ); begin FPicUp.Assign( Value ); end; end. |
Re: Imgbtn with caption?
As I said in the other thread, you have to override the paint-method. Just try it like this:
Delphi-Quellcode:
procedure TImgBtn.Paint;
begin inherited; Canvas.Brush.Style := bsClear; Canvas.TextOut(0,0,'Hello World'); end; |
Re: Imgbtn with caption?
:? I don't quite understand you have to put this in the source code of the imgbtn.
Becouse this draws on the form btw. |
Re: Imgbtn with caption?
Why should it draw on the form when it is a method of TImgBtn?
|
Re: Imgbtn with caption?
Zitat:
|
Re: Imgbtn with caption?
Primarily you paint on the Canvas of the Button. The container control askes then for paint of the child-controls
|
Re: Imgbtn with caption?
I did what you said and i get an error wich says
--------------------------- Debugger Exception Notification --------------------------- Project Project2.exe raised exception class EInvalidOperation with message 'Can only modify an image if it contains a bitmap'. --------------------------- Break Continue Help --------------------------- |
Re: Imgbtn with caption?
Please show us your current source.
|
Re: Imgbtn with caption?
:) Here it is!
Delphi-Quellcode:
unit ImgBtn;
//* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *// //* ImgBtn. Delphi 3, 4 //* //* This component turns 3 images to button with 3 states : normal, MouseOver //* and Pressed. I've also added some importent events. //* //* Writen by Paul Krestol. //* For contacts e-mail me to : [email]paul@mediasonic.co.il[/email] //* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *// interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TOnMouseEvent = procedure( Msg: TWMMouse ) of object; TImgBtn = class( TImage ) protected procedure WMMouseEnter( var Msg : TWMMouse ); message CM_MOUSEENTER; procedure WMMouseLeave( var Msg : TWMMouse ); message CM_MOUSELEAVE; procedure WMLButtonUp( var Msg : TWMLButtonUp ); message WM_LBUTTONUP; procedure WMLButtonDown( var Msg : TWMLButtonUp ); message WM_LBUTTONDOWN; private FEntered : boolean; FDown : boolean; FOnMouseEnter : TOnMouseEvent; FOnMouseLeave : TOnMouseEvent; FOnMouseDown : TOnMouseEvent; FOnMouseUp : TOnMouseEvent; FPic : TPicture; FPicDown : TPicture; FPicUp : TPicture; FSupported : boolean; procedure SetPic( Value : TPicture ); procedure SetPicDown( Value : TPicture ); procedure SetPicUp( Value : TPicture ); public constructor Create( AOwner: TComponent ); override; destructor Destroy; override; published //** Images **// property Pic : TPicture read FPic write SetPic; property PicDown : TPicture read FPicDown write SetPicDown; property PicUp : TPicture read FPicUp write SetPicUp; procedure Paint ; //** Events **// property OnMouseDown : TOnMouseEvent read FOnMouseDown write FOnMouseDown; property OnMouseEnter : TOnMouseEvent read FOnMouseEnter write FOnMouseEnter; property OnMouseLeave : TOnMouseEvent read FOnMouseLeave write FOnMouseLeave; property OnMouseUp : TOnMouseEvent read FOnMouseUp write FOnMouseUp; property Supported : boolean read FSupported write FSupported; end; procedure Register; implementation {$R *.RES} (*******************************************************************************) procedure Register; begin RegisterComponents( 'Plus', [ TImgBtn ] ); end; (*******************************************************************************) constructor TImgBtn.Create; begin inherited; FPic := TPicture.Create; FPicUp := TPicture.Create; FPicDown := TPicture.Create; FEntered := False; FDown := False; FSupported := True; end; procedure TImgBtn.Paint ; begin inherited; Canvas.Brush.Style := bsClear; Canvas.TextOut(0,0,'Hello World'); end; (*******************************************************************************) destructor TImgBtn.Destroy; begin FPic.Free; FPicDown.Free; FPicUp.Free; inherited; end; (*******************************************************************************) procedure TImgBtn.WMMouseEnter( var Msg: TWMMouse ); begin if not FSupported then Exit; FEntered := True; if FDown then Picture := FPicDown else Picture := FPicUp; if Assigned( FOnMouseEnter ) then FOnMouseEnter( Msg ); end; (*******************************************************************************) procedure TImgBtn.WMMouseLeave( var Msg: TWMMouse ); begin if not FSupported then Exit; FEntered := False; Picture := FPic; if Assigned( FOnMouseLeave ) then FOnMouseLeave( Msg ); end; (*******************************************************************************) procedure TImgBtn.WMLButtonDown(var Msg: TWMMouse); begin inherited; if not FSupported then Exit; FDown := True; if FEntered then Picture := FPicDown; if Assigned( FOnMouseDown ) then FOnMouseDown( Msg ); end; (*******************************************************************************) procedure TImgBtn.WMLButtonUp(var Msg: TWMMouse); begin inherited; if not FSupported then Exit; FDown := False; if FEntered then Picture := FPicUp; if Assigned( FOnMouseUp ) then FOnMouseUp( Msg ); end; (*******************************************************************************) procedure TImgBtn.SetPic( Value : TPicture ); begin Picture := Value; FPic.Assign( Value ); end; (*******************************************************************************) procedure TImgBtn.SetPicDown( Value : TPicture ); begin FPicDown.Assign( Value ); end; (*******************************************************************************) procedure TImgBtn.SetPicUp( Value : TPicture ); begin FPicUp.Assign( Value ); end; end. |
Re: Imgbtn with caption?
Zitat:
|
Re: Imgbtn with caption?
Wouldnt be simplier to implement caption of a normal button?
|
Re: Imgbtn with caption?
Perhaps it would be easier to add the ability to show an image to a button
|
Re: Imgbtn with caption?
Zitat:
|
Re: Imgbtn with caption?
Bitte beherrscht euch ein wenig und beschränkt euch auf die Beantwortung des Themas :warn:
|
Re: Imgbtn with caption?
So there is no solution to this?I really didnt understand deddy h comments.
|
Re: Imgbtn with caption?
Just put my suggestions together for testing ;)
|
Re: Imgbtn with caption?
It dosent work?! :shock:
I am thinking of buy some profesional skining components couse this is just nah unit ImgBtn; //* ++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++ *// //* ImgBtn. Delphi 3, 4 //* //* This component turns 3 images to button with 3 states : normal, MouseOver //* and Pressed. I've also added some importent events. //* //* Writen by Paul Krestol. //* For contacts e-mail me to : paul@mediasonic.co.il //* ++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++ *// interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TOnMouseEvent = procedure( Msg: TWMMouse ) of object; TImgBtn = class( TImage ) protected procedure WMMouseEnter( var Msg : TWMMouse ); message CM_MOUSEENTER; procedure WMMouseLeave( var Msg : TWMMouse ); message CM_MOUSELEAVE; procedure WMLButtonUp( var Msg : TWMLButtonUp ); message WM_LBUTTONUP; procedure WMLButtonDown( var Msg : TWMLButtonUp ); message WM_LBUTTONDOWN; private FEntered : boolean; FDown : boolean; FOnMouseEnter : TOnMouseEvent; FOnMouseLeave : TOnMouseEvent; FOnMouseDown : TOnMouseEvent; FOnMouseUp : TOnMouseEvent; FPic : TPicture; FPicDown : TPicture; FPicUp : TPicture; FSupported : boolean; procedure SetPic( Value : TPicture ); procedure SetPicDown( Value : TPicture ); procedure SetPicUp( Value : TPicture ); public constructor Create( AOwner: TComponent ); override; destructor Destroy; override; published //** Images **// property Pic : TPicture read FPic write SetPic; property PicDown : TPicture read FPicDown write SetPicDown; property PicUp : TPicture read FPicUp write SetPicUp; procedure Paint;override; //** Events **// property OnMouseDown : TOnMouseEvent read FOnMouseDown write FOnMouseDown; property OnMouseEnter : TOnMouseEvent read FOnMouseEnter write FOnMouseEnter; property OnMouseLeave : TOnMouseEvent read FOnMouseLeave write FOnMouseLeave; property OnMouseUp : TOnMouseEvent read FOnMouseUp write FOnMouseUp; property Supported : boolean read FSupported write FSupported; end; procedure Register; implementation {$R *.RES} (************************************************* ******************************) procedure Register; begin RegisterComponents( 'Plus', [ TImgBtn ] ); end; (************************************************* ******************************) constructor TImgBtn.Create; begin inherited; FPic := TPicture.Create; FPicUp := TPicture.Create; FPicDown := TPicture.Create; FEntered := False; FDown := False; FSupported := True; end; procedure TImgBtn.Paint ; begin inherited; Canvas.Brush.Style := bsClear; Canvas.TextOut(0,0,'Hello World'); end; (************************************************* ******************************) destructor TImgBtn.Destroy; begin FPic.Free; FPicDown.Free; FPicUp.Free; inherited; end; (************************************************* ******************************) procedure TImgBtn.WMMouseEnter( var Msg: TWMMouse ); begin if not FSupported then Exit; FEntered := True; if FDown then Picture := FPicDown else Picture := FPicUp; if Assigned( FOnMouseEnter ) then FOnMouseEnter( Msg ); end; (************************************************* ******************************) procedure TImgBtn.WMMouseLeave( var Msg: TWMMouse ); begin if not FSupported then Exit; FEntered := False; Picture := FPic; if Assigned( FOnMouseLeave ) then FOnMouseLeave( Msg ); end; (************************************************* ******************************) procedure TImgBtn.WMLButtonDown(var Msg: TWMMouse); begin inherited; if not FSupported then Exit; FDown := True; if FEntered then Picture := FPicDown; if Assigned( FOnMouseDown ) then FOnMouseDown( Msg ); end; (************************************************* ******************************) procedure TImgBtn.WMLButtonUp(var Msg: TWMMouse); begin inherited; if not FSupported then Exit; FDown := False; if FEntered then Picture := FPicUp; if Assigned( FOnMouseUp ) then FOnMouseUp( Msg ); end; (************************************************* ******************************) procedure TImgBtn.SetPic( Value : TPicture ); begin Picture := Value; FPic.Assign( Value ); end; (************************************************* ******************************) procedure TImgBtn.SetPicDown( Value : TPicture ); begin FPicDown.Assign( Value ); end; (************************************************* ******************************) procedure TImgBtn.SetPicUp( Value : TPicture ); begin FPicUp.Assign( Value ); end; end. |
Re: Imgbtn with caption?
Liste der Anhänge anzeigen (Anzahl: 1)
Please edit your last post and add your current source as attachment.
[edit] Ah, I recognized the problem. Therefore I changed this component as a descendant of TGraphicControl instead of TImage. It is not fully functional now, but you can see what I meant in my prior posts. But you can add a Caption- (and maybe a Font-)property on your own now. You only have to edit the paint-method ;). And it is not a bad idea to see if all three pictures contain a graphic before you paint them to your canvas. [/edit] |
Re: Imgbtn with caption?
Liste der Anhänge anzeigen (Anzahl: 1)
I need it becouse i want recreate this thing.DeddyH can this control be made so it contains caption and another iamge for the icon of the program.So i dont have to create 3 controls(panel,imagebtn,caption and another image for the icon).
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:05 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz