Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Imgbtn with caption? (https://www.delphipraxis.net/128157-imgbtn-caption.html)

Razor 25. Jan 2009 12:50


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.

DeddyH 25. Jan 2009 12:59

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;

Razor 25. Jan 2009 13:04

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.

DeddyH 25. Jan 2009 13:06

Re: Imgbtn with caption?
 
Why should it draw on the form when it is a method of TImgBtn?

invalid_operation 25. Jan 2009 13:08

Re: Imgbtn with caption?
 
Zitat:

Zitat von DeddyH
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;

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

mkinzler 25. Jan 2009 13:08

Re: Imgbtn with caption?
 
Primarily you paint on the Canvas of the Button. The container control askes then for paint of the child-controls

Razor 25. Jan 2009 13:08

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

DeddyH 25. Jan 2009 13:10

Re: Imgbtn with caption?
 
Please show us your current source.

Razor 25. Jan 2009 13:11

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.

invalid_operation 25. Jan 2009 13:14

Re: Imgbtn with caption?
 
Zitat:

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

Razor 25. Jan 2009 13:20

Re: Imgbtn with caption?
 
Wouldnt be simplier to implement caption of a normal button?

mkinzler 25. Jan 2009 13:22

Re: Imgbtn with caption?
 
Perhaps it would be easier to add the ability to show an image to a button

invalid_operation 25. Jan 2009 13:23

Re: Imgbtn with caption?
 
Zitat:

Zitat von DeddyH
Delphi-Quellcode:
type TImgBtn = class(TImage)
...
protected
  procedure Paint;override;
...
end;
@invalid_operation: Wenn Du nichts Konstruktives beisteuern kannst, lass es doch einfach :?

@DeddyH: GENAU meine Rede seit mehr als zehn Jahren! Wo hast Du Denken gelernt?

mkinzler 25. Jan 2009 13:28

Re: Imgbtn with caption?
 
Bitte beherrscht euch ein wenig und beschränkt euch auf die Beantwortung des Themas :warn:

Razor 25. Jan 2009 13:36

Re: Imgbtn with caption?
 
So there is no solution to this?I really didnt understand deddy h comments.

DeddyH 25. Jan 2009 13:43

Re: Imgbtn with caption?
 
Just put my suggestions together for testing ;)

Razor 25. Jan 2009 13:57

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.

DeddyH 25. Jan 2009 13:58

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]

Razor 7. Feb 2009 13:48

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