Re: Transparentes Bild soll nur an bestimmten stellen angekl
Eigentlich geht es um eine Ableitung von TImage. Dort ueberschreibt man die Message CM_HITTEST und liefert im Result der TMessage-Struktur
je nachdem ob die Maus ueber einem transparenten Pixel ist 0 oder 1. Die Mausposition ist im LParam der Struktur kodiert. Danach fuehlt sich die Komponente nur angeklickt wenn sie auf einem nicht-transparenten Pixel getroffen wird. Genaugenommen ist sie jetzt auch fuer Klicks transparent. TJvImage der JVCL hat das bereits implementiert. |
Re: Transparentes Bild soll nur an bestimmten stellen angekl
@Robert Marquardt JVCL Schleichwerbung ? :wink:
@Puhbaehr Warum nicht einfach das MousUp- bzw. MouseDown-Ereignis des Images verwenden ?
Delphi-Quellcode:
Ich verwende meistens die Farbe clFuchsia (RGB = 255, 0, 255) für Transparenz, da clFuchsia nicht so oft vorkommt. IMHO ist clWhite ist nicht immer die beste Wahl.
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin if (Shift = [ssRight]) and (Image1.Canvas.Pixels[X, Y] <> clWhite) then begin // Was dann gemacht werden Soll... // ... end; end; // Edit: Zitat:
|
Re: Transparentes Bild soll nur an bestimmten stellen angekl
Weil das die Komponente nicht fuer Klicks durchsichtig macht.
|
Re: Transparentes Bild soll nur an bestimmten stellen angekl
Zitat:
Zitat:
Zitat:
Aber wie wäre es statt FF00FF (255, 0, 255) lieber eine eher seltenere Farbe nimmst. Denn kommt deine Freundin und will das Programm in einem pfiffigem Pink dann musst du auch umbauen. Interessanter wäre da z.B. FE01FE (254, 1, 254) zu verwenden. Aber nun gut :) |
Re: Transparentes Bild soll nur an bestimmten stellen angekl
Zitat:
|
Re: Transparentes Bild soll nur an bestimmten stellen angekl
Zitat:
|
Re: Transparentes Bild soll nur an bestimmten stellen angekl
Zitat:
|
Re: Transparentes Bild soll nur an bestimmten stellen angekl
Hier eine aeltere Komponente von mir. Die ist nicht ideal konstruiert, aber funktioniert.
Wichtig ist, das PicUp und PicDown sich moeglichst nur in der Farbgebung unterscheiden. Es ist sehr unangenehm wenn das Bild sich beim Betreten mit der Maus aendert und sich dabei der Hittest veraendert. Damit ist die Maus wieder draussen und das Bild schaltet zurueck usw usf. Mit CM_MOUSEENTER und CM_MOUSELEAVE gibt es in Delphi ein paar Macken. Manchmal wird das CM_MOUSELEAVE nicht generiert. Man kann beispielsweise ueber ein Kontextmenue das man mit ESC abbricht die Komponente heimlich verlassen.
Delphi-Quellcode:
Die Tests in WMMouseEnter und WMMouseLeave stellen sicher das die Komponente nur auf die Maus reagiert wenn sie auf der aktiven Form ist.
unit MouseImage;
interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TOnMouseEvent = procedure(Msg: TWMMouse) of object; TMouseImage = class(TImage) private FOnMouseEnter: TOnMouseEvent; FOnMouseLeave: TOnMouseEvent; FPicDown: TPicture; FPicUp: TPicture; FDown: Boolean; FEntered: Boolean; procedure SetPicDown(Value: TPicture); procedure SetPicUp(Value: TPicture); procedure SetDown(Value: Boolean); procedure SetEntered(Value: Boolean); protected procedure Loaded; override; procedure WMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER; procedure WMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE; procedure CMHitTest(var Msg: TWMMouse); message CM_HITTEST; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Down: Boolean read FDown write SetDown; property Entered: Boolean read FEntered write SetEntered; property PicDown: TPicture read FPicDown write SetPicDown; property PicUp: TPicture read FPicUp write SetPicUp; property OnMouseEnter: TOnMouseEvent read FOnMouseEnter write FOnMouseEnter; property OnMouseLeave: TOnMouseEvent read FOnMouseLeave write FOnMouseLeave; end; procedure Register; implementation {$R *.RES} (*******************************************************************************) procedure Register; begin RegisterComponents('3rdParty', [TMouseImage]); end; (*******************************************************************************) constructor TMouseImage.Create; begin inherited; FPicDown := TPicture.Create; FPicUp := TPicture.Create; FDown := False; FEntered := False; end; (*******************************************************************************) destructor TMouseImage.Destroy; begin FreeAndNil(FPicDown); FreeAndNil(FPicUp); inherited; end; (*******************************************************************************) procedure TMouseImage.Loaded; begin Picture.Assign(PicUp); end; (*******************************************************************************) procedure TMouseImage.WMMouseEnter(var Msg: TWMMouse); var P: TControl; begin inherited; P := Self; repeat P := P.Parent; until (P = nil) or (P is TForm); if (P = nil) or TForm(P).Active then begin Entered := True; if Assigned(FOnMouseEnter) then FOnMouseEnter(Msg); end; end; (*******************************************************************************) procedure TMouseImage.WMMouseLeave(var Msg: TWMMouse); var P: TControl; begin inherited; P := Self; repeat P := P.Parent; until (P = nil) or (P is TForm); if (P = nil) or TForm(P).Active then begin Entered := False; if Assigned(FOnMouseLeave) then FOnMouseLeave(Msg); end; end; (*******************************************************************************) procedure TMouseImage.CMHitTest(var Msg: TWMMouse); begin inherited; if Assigned(PicUp) and Assigned(PicUp.Bitmap) and Transparent and (Msg.XPos < PicUp.Bitmap.Width) and (Msg.YPos < PicUp.Bitmap.Height) and (PicUp.Bitmap.Canvas.Pixels[Msg.XPos, Msg.YPos] = (Picture.Bitmap.TransparentColor and $FFFFFF)) then Msg.Result := 0; end; (*******************************************************************************) procedure TMouseImage.SetPicUp(Value: TPicture); begin FPicUp.Assign(Value); end; (*******************************************************************************) procedure TMouseImage.SetPicDown(Value: TPicture); begin FPicDown.Assign(Value); end; (*******************************************************************************) procedure TMouseImage.SetDown(Value: Boolean); begin FDown := Value; Entered := Value; end; (*******************************************************************************) procedure TMouseImage.SetEntered(Value: Boolean); begin FEntered := Value; if Down or Entered then Picture.Assign(PicDown) else Picture.Assign(PicUp); end; end. Es ist selten gewuenscht das die komponente reagiert, wenn sie auf einer im Hintergrund liegenden Form liegt. CMHitTest ist das Herz der Komponente. Es wird getestet ob die Maus wirklich ueber dem Komponentenrechteck liegt und ob der Pixel unter dem Cursor transparent ist. inherited; hat bereits dafuer gesorgt, das Msg.Result 1 ist, da dies die Standardantwort eines TImage ist. Die Konsequenz ist, das die Komponente jetzt auch fuer Klicks transparent ist. |
Re: Transparentes Bild soll nur an bestimmten stellen angekl
Liste der Anhänge anzeigen (Anzahl: 1)
@Robert Marquardt
Toll, hab mich jetzt in den letzten Tagen damit beschäftigt, da ich mit den selbstgemachten Komponenten noch nich so auskenne, vom Grundgerüst her, würdch sagen, isses genau das was ich suche. Nun zu meiner Frage wie schon gesagt, mein wissen über eigene Komonenten ist noch nicht so gross.Also hab ich sie wie folft verucht einzubinden:
Delphi-Quellcode:
Das klappt auch so weit, nur leider soll das Bildchen ja nicht beim darüberfahren nach unten gedrückt werden, sondern nur so ne Art OnMouseDown Eigenschaft.
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); private { Private-Deklarationen } Haus: TBitmap; Bild: TMouseImage; public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin Haus := TBitmap.create; Haus.LoadFromFile(ExtractFilePath(ParamStr(0)) + '\Bilder\aktiv.bmp'); end; procedure TForm1.FormDestroy(Sender: TObject); begin Haus.Free; end; procedure TForm1.FormShow(Sender: TObject); begin Bild := TMouseImage.create(self); Bild.parent := self; Bild.Autosize := True; Bild.Transparent := True; Bild.Picture.Assign(Haus); Bild.Top := 10; Bild.Left := 10; Bild.PicUp.create; Bild.PicDown.create; Bild.PicUp.Assign(Haus); Bild.PicDown.LoadFromFile(ExtractFilePath(ParamStr(0)) + '\Bilder\unten.bmp'); end; end. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:56 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