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

zusammenfalten · markieren

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.

**DeddyH**

As I said in the other thread, you have to override the paint-method. Just try it like this:

markieren

Delphi-Quellcode:

			procedure TImgBtn.Paint;

begin

  inherited;

  Canvas.Brush.Style := bsClear;

  Canvas.TextOut(0,0,'Hello World');

end;

I don't quite understand you have to put this in the source code of the imgbtn.
Becouse this draws on the form btw.

**DeddyH**

Why should it draw on the form when it is a method of TImgBtn?

Zitat von DeddyH:

As I said in the other thread, you have to override the paint-method. Just try it like this:

markieren

Delphi-Quellcode:

			procedure TImgBtn.Paint;

begin

  inherited;

  Canvas.Brush.Style := bsClear;

  Canvas.TextOut(0,0,'Hello World');

end;

Und nur weil der Fragende "english" ist, sollte man ihm nicht alles durchgehen lassen.

**mkinzler**

Primarily you paint on the Canvas of the Button. The container control askes then for paint of the child-controls

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
---------------------------

**DeddyH**

Please show us your current source.

Here it is!

zusammenfalten · markieren

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.

Zitat von mkinzler:

Primarily you paint on the Canvas of the Button. The container control askes then for paint of the child-controls

Und eine 1:1 Übersetzung (by GoogleTranslate) ist echt 1:1 ...

Imgbtn with caption?

Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Re: Imgbtn with caption?

Forumregeln

Razor (Gast) n/a Beiträge	#3 Re: Imgbtn with caption? 25. Jan 2009, 12:04 I don't quite understand you have to put this in the source code of the imgbtn. Becouse this draws on the form btw.
	Zitat

DeddyH Registriert seit: 17. Sep 2006 Ort: Barchfeld 27.542 Beiträge Delphi 11 Alexandria	#4 Re: Imgbtn with caption? 25. Jan 2009, 12:06 Why should it draw on the form when it is a method of TImgBtn? Detlef *"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen."* (Albert Einstein) Dieser Tag ist längst gekommen
	Zitat

mkinzler (Moderator) Registriert seit: 9. Dez 2005 Ort: Heilbronn 39.851 Beiträge Delphi 11 Alexandria	#6 Re: Imgbtn with caption? 25. Jan 2009, 12:08 Primarily you paint on the Canvas of the Button. The container control askes then for paint of the child-controls Markus Kinzler
	Zitat

Razor (Gast) n/a Beiträge	#7 Re: Imgbtn with caption? 25. Jan 2009, 12:08 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 ---------------------------
	Zitat

DeddyH Registriert seit: 17. Sep 2006 Ort: Barchfeld 27.542 Beiträge Delphi 11 Alexandria	#8 Re: Imgbtn with caption? 25. Jan 2009, 12:10 Please show us your current source. Detlef *"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen."* (Albert Einstein) Dieser Tag ist längst gekommen
	Zitat

invalid_operation (Gast) n/a Beiträge	#10 Re: Imgbtn with caption? 25. Jan 2009, 12:14 Zitat von mkinzler: Primarily you paint on the Canvas of the Button. The container control askes then for paint of the child-controls Und eine 1:1 Übersetzung (by GoogleTranslate) ist echt 1:1 ...
	Zitat

	25. Jan 2009, 12:15 Erstellt von DeddyH
	Dieser Beitrag wurde von MrSpock gelöscht. - Grund: Da voriges Posting gelöscht, ist dieser Beitrag auch nicht mehr notwendig.