Probleme mit einer eigenen Komponente

[Wal]

Habe Probleme mit dem Click und MouseDown Ereignis, hier der Code :

Delphi-Quellcode:

unit cPOSCompo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TOnMouseEvent = procedure( Msg: TWMMouse ) of object;

  TcPOSCompo = class(TCustomControl)
  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
    FImage: TImage;
    FLabel: TLabel;
    FEntered : boolean;
    FDown : boolean;
    FPic : TPicture;
    FPicDown : TPicture;
    FPicUp : TPicture;
    FOnMouseEnter : TOnMouseEvent;
    FOnMouseLeave : TOnMouseEvent;
    FOnMouseDown  : TOnMouseEvent;
    FOnMouseUp    : TOnMouseEvent;
    procedure setCaption(Value: String);
    function getCaption: String;
    procedure setFont(Value: TFont);
    function getFont: TFont;
    procedure SetPic( Value : TPicture );
    procedure SetPicDown( Value : TPicture );
    procedure SetPicUp( Value : TPicture );
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Resize; override;
  published
    property Caption: String read getCaption write setCaption;
    property Font: TFont read getFont write setFont;
    property Pic : TPicture read FPic write SetPic;
    property PicDown : TPicture read FPicDown write SetPicDown;
    property PicUp : TPicture read FPicUp write SetPicUp;
    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 OnClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('cPos_Live', [TcPOSCompo]);
end;

constructor TcPOSCompo.Create(AOwner: TComponent);
begin
  Inherited;
  FImage := TImage.Create(self);
  FImage.Parent := self;
  FLabel:= TLabel.create(self);
  FLabel.Parent := self;
  FPic := TPicture.Create;
  FPicUp := TPicture.Create;
  FPicDown := TPicture.Create;
  FLabel.Visible := False;
  FLabel.Transparent := True;
  Self.AutoSize := True;
  FImage.AutoSize := True;
  FEntered := False;
  FDown := False;
end;

destructor TcPOSCompo.Destroy;
begin
  FPic.Free;
  FPicDown.Free;
  FPicUp.Free;
  Inherited;
end;

procedure TcPOSCompo.Resize;
begin
  FImage.Picture := FPic;
End;

procedure TcPOSCompo.WMMouseEnter( var Msg: TWMMouse );
begin
  FEntered := True;
  if FDown then FImage.Picture := FPicDown else FImage.Picture := FPicUp;
  if Assigned( FOnMouseEnter ) then FOnMouseEnter( Msg );
end;

procedure TcPOSCompo.WMMouseLeave( var Msg: TWMMouse );
begin
  FEntered := False;
  FImage.Picture := FPic;
  if Assigned( FOnMouseLeave ) then FOnMouseLeave( Msg );
end;

procedure TcPOSCompo.WMLButtonDown(var Msg: TWMMouse);
begin
  inherited;
  FDown := True;
  if FEntered then FImage.Picture := FPicDown;
  if Assigned( FOnMouseDown ) then FOnMouseDown( Msg );
end;

procedure TcPOSCompo.WMLButtonUp(var Msg: TWMMouse);
begin
  inherited;
  FDown := False;
  if FEntered then FImage.Picture := FPicUp;
  if Assigned( FOnMouseUp ) then FOnMouseUp( Msg );
end;

procedure TcPOSCompo.setCaption(Value: String);
begin
  FLabel.Caption := Value;
  If FLabel.Caption = '' then FLabel.Visible := False
  else FLabel.Visible := True;
end;

function TcPOSCompo.getCaption: String;
begin
  result := FLabel.Caption;
end;

procedure TcPOSCompo.setFont(Value: TFont);
begin
  FLabel.Font := Value;
end;

function TcPOSCompo.getFont: TFont;
begin
  result := FLabel.Font;
end;

procedure TcPOSCompo.SetPic( Value : TPicture );
begin
  FPic.Assign( Value );
end;

procedure TcPOSCompo.SetPicDown( Value : TPicture );
begin
  FPicDown.Assign( Value );
end;

procedure TcPOSCompo.SetPicUp( Value : TPicture );
begin
  FPicUp.Assign( Value );
end;

end.

Das MouseDown für die PicDown-Umschaltung und das Click für das reagieren auf den Button im Programm funzt nicht, ich gehe mal davon aus, da ich ja auf das Image oder Label Klicke und nicht auf das Kompo. Wie könnte ich das lösen ?
Vielen Dank im vorraus.

Wal

[xaromz]

Hallo,

erst mal:
Statt alles neu zu programmieren, solltest Du lieber die Methoden MouseDown und MouseUp überschreiben.

Jetzt zu Deiner Frage:
Wie wäre es, statt zig Pictures einfach Bitmaps zu nehmen, und diese in der Paint-Methode je nach Status zu zeichnen? Das ist wesentlich sauberer und ressourcenschonender. Außerdem erledigen sich Deine Probleme damit wie von selbst.

Gruß
xaromz

[Wal]

Die Bilder sind Jpeg's. Ich denke 10k Jpeg's sind doch bestimmt Ressorcenschonender als 200k BMP's. Habe allerdings auch die TPictures mal mit TBitmaps getauscht, bleibt aber das gleiche Problem.

Wal

[DGL-luke]

Du kannst auch JPEGs laden und zeichnen.

[Khabarakh]

Zitat:

Zitat von Wal

Die Bilder sind Jpeg's. Ich denke 10k Jpeg's sind doch bestimmt Ressorcenschonender als 200k BMP's.

Sind sie. Aber egal ob TPicture oder TBitmap, die JPEGs werden als reine Bitmaps in den Speicher gelegt, du gewinnst also keinen Vorteil.

Zitat:

Habe allerdings auch die TPictures mal mit TBitmaps getauscht, bleibt aber das gleiche Problem.

Zeichne die Bitmaps und den Text direkt auf die Komponentencanvas, dann benötigst du überhaupt keine anderen Komponenten mehr und der Mausklick kommt auf jeden Fall durch.

[Wal]

Danke.

Wal

[Wal]

So habe das Teil soweit fertig, evtl. könnte ein Profi mal drüberschauen ob noch was zu verbessern ist.
Ich möchte noch ein paar Kleinigkeiten einbauen, da wäre es gut wenn ich nicht mehr so viel ändern müßte. :stupid:

Delphi-Quellcode:

unit cPosCompo;

interface

uses
  Classes, Graphics, Controls, Messages, Jpeg;

type
  TcPosCompo = class(TGraphicControl)
  private
    FUpPic       : TJpegImage;
    FDownPic     : TJpegImage;
    FOverPic     : TJpegImage;
    FBoolTruePic : TBitmap;
    FBoolFalsePic : TBitmap;
    FShowBoolPic : Boolean;
    FButtonDown  : Boolean;
    FLabelXPos    : Integer;
    FLabelYPos    : Integer;
    FEntered     : Boolean;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMouseEnter( var Message : TWMMouse ); message CM_MOUSEENTER;
    procedure WMMouseLeave( var Message : TWMMouse ); message CM_MOUSELEAVE;
    procedure SetDownPic(const Value: TJpegImage);
    procedure SetUpPic(const Value: TJpegImage);
    procedure SetOverPic(const Value: TJpegImage);
    procedure SetBoolTruePic(const Value: TBitmap);
    procedure SetBoolFalsePic(const Value: TBitmap);
    procedure SetText(const Value: TCaption); reintroduce;
    procedure SetShowBoolPic(const Value: Boolean);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property Caption write SetText;
    property UpPicture: TJpegImage read FUpPic write SetUpPic;
    property DownPicture: TJpegImage read FDownPic write SetDownPic;
    property OverPicture: TJpegImage read FOverPic write SetOverPic;
    property BoolTruePicture: TBitmap read FBoolTruePic write SetBoolTruePic;
    property BoolFalsePicture: TBitmap read FBoolFalsePic write SetBoolFalsePic;
    property ShowBoolPic: Boolean read FShowBoolPic write SetShowBoolPic;
    property OnMouseDown;
    property OnMouseUp;
    property OnClick;
  end;

procedure Register;

implementation

  procedure Register;
begin
  RegisterComponents('cPOS_Live', [TcPosCompo]);
end;

{ TcPosCompo }

constructor TcPosCompo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUpPic       := TJpegImage.Create();
  FDownPic     := TJpegImage.Create();
  FOverPic     := TJpegImage.Create();
  FBoolTruePic     := TBitmap.Create();
  FboolTruePic.TransparentColor := clblack;
  FboolTruePic.Transparent := True;
  FBoolFalsePic     := TBitmap.Create();
  FboolFalsePic.TransparentColor := clblack;
  FboolFalsePic.Transparent := True;
  FButtonDown    := False;
  FEntered     := False;
  FShowBoolPic := False;
  FLabelXPos    := 0;
  FLabelYPos    := 0;
  Canvas.Brush.Style := bsClear;
end;

destructor TcPosCompo.Destroy;
begin
  FUpPic.Free();
  FDownPic.Free();
  FOverPic.Free();
  FBoolTruePic.Free();
  FBoolFalsePic.Free();
  inherited;
end;

procedure TcPosCompo.Paint;
begin
  if FButtonDown then
  begin
    Canvas.Draw(0, 0, FDownPic);
    if FShowBoolPic then Canvas.Draw(5, 4, FBoolTruePic) else Canvas.Draw(5, 4, FBoolFalsePic);
    Canvas.Font.Color := clWhite;
    Canvas.TextOut(FLabelXPos + 1, FLabelYPos + 1, Caption);
    Canvas.Font.Color := clBlack;
    Canvas.TextOut(FLabelXPos, FLabelYPos, Caption);
  end else
  begin
    if FEntered then Canvas.Draw(0, 0, FOverPic) else
    Canvas.Draw(0, 0, FUpPic);
    if FShowBoolPic then Canvas.Draw(5, 4, FBoolTruePic) else Canvas.Draw(5, 4, FBoolFalsePic);
    Canvas.Font.Color := clBlack;
    Canvas.TextOut(FLabelXPos + 1, FLabelYPos + 1, Caption);
    Canvas.Font.Color := clWhite;
    Canvas.TextOut(FLabelXPos, FLabelYPos, Caption);
  end;
end;

procedure TcPosCompo.SetBoolTruePic(const Value: TBitmap);
begin
  FBoolTruePic.Assign(Value);
end;

procedure TcPosCompo.SetBoolFalsePic(const Value: TBitmap);
begin
  FBoolFalsePic.Assign(Value);
end;

procedure TcPosCompo.SetOverPic(const Value: TJpegImage);
begin
  FOverPic.Assign(Value);
end;

procedure TcPosCompo.SetDownPic(const Value: TJpegImage);
begin
  FDownPic.Assign(Value);
end;

procedure TcPosCompo.SetUpPic(const Value: TJpegImage);
begin
  FUpPic.Assign(Value);
end;

procedure TcPosCompo.WMLButtonDown(var Message: TWMLButtonDown);
begin
  FButtonDown := True;
  Repaint();
  inherited;
end;

procedure TcPosCompo.WMLButtonUp(var Message: TWMLButtonUp);
begin
  FButtonDown := False;
  Repaint();
  inherited;
end;

procedure TcPosCompo.WMMouseEnter( var Message: TWMMouse );
begin
  FEntered := True;
  Repaint();
  inherited;
end;

procedure TcPosCompo.WMMouseLeave( var Message: TWMMouse );
begin
  FEntered := False;
  Repaint();
  inherited;
end;

procedure TcPosCompo.SetText(const Value: TCaption);
begin
  if Caption <> Value then
  begin
    SetTextBuf(PChar(Value));
    Repaint();
  end;
end;

procedure TcPosCompo.SetShowBoolPic(const Value: Boolean);
begin
  if ShowBoolPic <> Value then
  begin
    FShowBoolPic := Value;
    Repaint();
  end;
end;

end.

Funktion:
Es sollen 3 Jpeg-Bilder eingebunden werden, für: up,down,over. Eine Bitmap für den Status des Buttons, wenn er als Schalter und nicht als Taster benutzt wird.
Eine Beschriftung soll angezeigt werden.
Das ganze funzt auch soweit.
Die Status und Beschriftungskoordinaten muß ich noch einbinden.

Wal