Mausbotschaften in Package geht nicht [gelöst]

Rund um die LCL und andere Komponenten
Antworten
Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 4146
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Niederösterreich
Kontaktdaten:

Mausbotschaften in Package geht nicht [gelöst]

Beitrag von af0815 »

Ich möchte ein TImage als Button Ersatz verwenden, es soll sich aber mehr als Button anfühlen. Deswegen habe ich eine Komponente von TCustomImage abgeleitet.

Die Images für den Button hole ich mir aus einer Imagelist. Wenn der ImageButton gedrückt wird, so sende ich auf das Image eine etwas verkleinerte Version des Image. Soweit so gut, das funktioniert grundlegend, wenn ich das ganze nicht als Komponente mache und mich direkt auf die entsprechnenden OnXXX Handler lege.

Jetzt in der Komponente will ich die OnXXX Handler nicht blockieren, sondern wollte mich per Vererbung in die aufrufende procedure einklinken.
zB. stellt TControl (in der Vererbung) die

Code: Alles auswählen

procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
zur Verfügung. Also habe ich mir gedacht, ich überschreibe diese Routine, weil die sollte vom Ereignishandler aufgerufen werden.

Nur irgendwie funktioniert das nicht, wie sich der kleine Andi das vorstellt. Wo habe ich da den Knoten in der Überlegung ?

Die Komponente mit einem Testprogramm ist angehängt und ich arbeite aktuell mit Lazarus 2.0.9 r63081 FPC 3.2.0 i386-win32-win32/win64
Dateianhänge
ImageButton.zip
(33.01 KiB) 17-mal heruntergeladen
Zuletzt geändert von af0815 am Do 28. Mai 2020, 11:41, insgesamt 2-mal geändert.
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

wennerer
Beiträge: 152
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 19.3 Cinnamon, Lazarus 2.1.0, FPC 3.3.1 ,Lazarus Stable 2.0.6,
CPU-Target: x86_64

Re: Mausbotschaften in Paket geht nicht

Beitrag von wennerer »

Hallo Andreas,
ich weiß nicht ob ich dein Problem richtig verstanden habe.
Aber wenn ich das Zeichnen in die Paint Methode packe reagiert bei mir der Button auf den Klick.

Code: Alles auswählen

unit ImgButton;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls;
const
  nothing = 0;
  down    = 1;
  up      = 2;
type

  { TImgButton }

  TImgButton = class(TCustomImage)
  private
    FBorder: integer;
    FColor: TColor;
    FImageIndex: integer;
    FImageList: TImageList;
    modus      : byte;
    procedure InMouseDown;
    procedure InMouseEnter;
    procedure InMouseLeave;
    procedure InMouseUp;
  protected
    procedure Click; override;
    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure Paint;override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Border: integer read FBorder write FBorder default 3;
    property Color: TColor read FColor write FColor default clDefault;
    property ImageIndex: integer read FImageIndex write FImageIndex default -1;
    property ImageList: TImageList read FImageList write FImageList default nil;
    // stolen from TImage in ExtCtrl
    property AntialiasingMode;
    property Align;
    property Anchors;
    property AutoSize;
    property BorderSpacing;
    property Center;
    property KeepOriginXWhenClipped;
    property KeepOriginYWhenClipped;
    property Constraints;
    property DragCursor;
    property DragMode;
    property Enabled;
    property OnChangeBounds;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnPaint;
    property OnPictureChanged;
    property OnPaintBackground;
    property OnResize;
    property OnStartDrag;
    property ParentShowHint;
    property Picture;
    property PopupMenu;
    property Proportional;
    property ShowHint;
    property Stretch;
    property StretchOutEnabled;
    property StretchInEnabled;
    property Transparent;
    property Visible;
  end;

procedure Register;

implementation
uses
  Types;

procedure Register;
begin
  {$I imgbutton_icon.lrs}
  RegisterComponents('AF',[TImgButton]);
end;

{ TImgButton }

procedure TImgButton.Click;
begin
  InMouseDown;
  inherited Click;
  Invalidate;
end;

procedure TImgButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  InMouseDown;
  inherited MouseDown(Button, Shift, X, Y);
  Invalidate;
end;

procedure TImgButton.InMouseDown;
begin
  if (ImageList <> nil) and (ImageIndex >= 0) then begin
    if  (ImageIndex < ImageList.Count) then begin
      modus:=down;
      //ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(0, 0, self.Width, self.Height),true);
      self.Invalidate;
    end;
  end;
  Invalidate;
end;

procedure TImgButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  InMouseUp;
  inherited MouseUp(Button, Shift, X, Y);
  Invalidate;
end;

procedure TImgButton.InMouseUp;
begin
  if PtInRect(self.BoundsRect, ScreenToClient(Mouse.CursorPos)) then
     InMouseEnter

   else
     InMouseLeave;
   Invalidate;
end;

procedure TImgButton.MouseEnter;
begin
  InMouseEnter;
  inherited MouseEnter;
  Invalidate;
end;

procedure TImgButton.InMouseEnter;
begin
  if (ImageList <> nil) and (ImageIndex >= 0) then begin
    if  (ImageIndex < ImageList.Count) then begin
       modus:=up;
      {
      Self.Canvas.Brush.Color:= Color;
      Self.Canvas.FillRect(Rect(0, 0, self.Width, self.Height));
      ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(Border, Border, self.Width-Border, self.Height-Border),true);
      }
      end;
  end;
  Invalidate;
end;

procedure TImgButton.MouseLeave;
begin
  inherited MouseLeave;
  InMouseLeave;
end;

constructor TImgButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  modus:=nothing;
  InMouseLeave;
end;

procedure TImgButton.InMouseLeave;
begin
  if (ImageList <> nil) and (ImageIndex >= 0) then begin
    if  (ImageIndex < ImageList.Count) then begin
      //ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(Border div 2, Border div 2, self.Width-(Border div 2), self.Height-(Border div 2)),true);
    end;
  end;
  Invalidate;
end;

procedure TImgButton.Paint;
begin
 inherited;
 self.Canvas.Brush.Color:=clwhite;
 self.Canvas.Rectangle(0,0,self.Width,self.Height);
 if modus=down then
 ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(0, 0, self.Width, self.Height),true);
 if modus= up then
 begin
 Self.Canvas.Brush.Color:= cllime;
 Self.Canvas.FillRect(Rect(0, 0, self.Width, self.Height));
 ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(20, 20, self.Width-20, self.Height-20),true);
 end;
end;

end.
Vielleicht bringt dich das auf die richtige Idee.
Viele Grüße
Bernd

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 4146
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Niederösterreich
Kontaktdaten:

Re: Mausbotschaften in Paket geht nicht

Beitrag von af0815 »

Danke für die Idee.

Ja es ist logisch das in Paint zu machen, allerdings bekomme ich jetzt eine Loop in Paint. Das Zeichnen innerhalb von paint löst scheinbar ein paint-kommando aus. Aktuell loopt das ganze.

Code: Alles auswählen

procedure TImgButton.Paint;
begin
  if FInPaint then exit;
  FInPaint:=true;
  try
    inherited Paint;
    if (ImageList <> nil) and (ImageIndex >= 0) then begin
      if  (ImageIndex < ImageList.Count) then begin
        case BuState of
          buHover:
            begin
              Self.Canvas.Brush.Color:= Color;
              Self.Canvas.FillRect(Rect(0, 0, self.Width, self.Height));
              ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(Border div 2, Border div 2, self.Width-(Border div 2), self.Height-(Border div 2)),true);
            end;
          buClicked:
            begin
              Self.Canvas.Brush.Color:= Color;
              Self.Canvas.FillRect(Rect(0, 0, self.Width, self.Height));
              ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(Border, Border, self.Width-Border, self.Height-Border),true);
            end
        else
          ImageList.StretchDraw(self.Canvas,ImageIndex, Rect(0, 0, self.Width, self.Height),true);
        end;
      end;
    end;
  finally
    FInPaint:= false;
  end;
end;
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

theo
Beiträge: 8318
Registriert: Mo 11. Sep 2006, 19:01

Re: Mausbotschaften in Paket geht nicht

Beitrag von theo »

af0815 hat geschrieben:
Di 26. Mai 2020, 15:28
Nur irgendwie funktioniert das nicht, wie sich der kleine Andi das vorstellt. Wo habe ich da den Knoten in der Überlegung ?
Könntest du vielleicht mal etwas genauer schildern "wie sich der kleine Andi das vorstellt" bzw. wo du ein Problem siehst?
Ich habe es gerade auf Lazarus 2.1.0 r63214 FPC 3.0.4 x86_64-linux-gtk2 getestet und sehe kein Problem.
Was geht nicht? Ist es nur ein Problem auf Windows?

wp_xyz
Beiträge: 3251
Registriert: Fr 8. Apr 2011, 09:01

Re: Mausbotschaften in Paket geht nicht

Beitrag von wp_xyz »

Ich sehe da auf Anhieb nichts, was ein Neuzeichnen triggern könnte. Höchstens vielleicht als Vorsichtsmaßnahme würde ich das boolean FInPaint durch einen Integer ersetzen, der rauf/runtergezählt wird und nur beim Zählerstand 0 erlaubt, die Paint-Routine zu betreten. Falls nämlich Paint mehrmals aufgerufen wird, kann man mit einer einfachen boolschen-Variablen leicht außer Takt geraten, gerade wenn man nicht überschauen kann, wann eine Routine aufgerufen wird.

Nachdem deine Paint-Routine den ganzen Client-Bereich übermalt, brauchst du "inherited Paint" wahrscheinlich gar nicht mehr. Und wenn es dieses nicht mehr gibt, kann man sich auch die Frage stellen, ob der Button unbedingt von TCustomImage abgeleitet sein muss - das Ding ist viel zu kompliziert um nur ein Bild aus einer Imagelist anzuzeigen.

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 4146
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Niederösterreich
Kontaktdaten:

Re: Mausbotschaften in Paket geht nicht

Beitrag von af0815 »

@Theo: Was will ich -> Einen mit einer beliebigen Bild tapezierten Button OHNE weitere Bibliotheken (zB. BGRA.. ) einzuschleppen. Also LCL only. Loopen tut das ganze auch unter Linux-gtk2. Indirekt ist auch der Unterschied zwischen den Widgetsets schuld. Ein Button unter Windows lässt sich nicht gut einfärben, unter GTK2 schon und so Kleinigkeiten.

Grundlegend stellt sich hier das Problem, das ich durch eine Änderung am Bild (Picture von TImage) wieder das Paint auslöse. Soweit so klar.

Ich bin gerade dabei das ganze logischer zu machen und es sieht mal im ersten Versuch gut aus. Mal ein wenig testen.
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 4146
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Niederösterreich
Kontaktdaten:

Re: Mausbotschaften in Paket geht nicht

Beitrag von af0815 »

So jetzt läuft es. Ein wenig anders als gedacht, dafür aber logischer :-)

Was mir die Tests auch gezeigt haben ist, das die ImageLists erst später geladen werden können. Damit sind im Create die Bilder nicht verfügbar. Damit muss ich das Laden des initalen Bildes verzögern.
Bei Programmen mache ich das gerne im OnActivate, das geht hier in der Komponente nicht. So warte ich auf das die erste Paint-Message und initialisiere dann erst das Bild.

Scheint mal sauber zu funktionieren. Danke an alle für den Input und Gedankenanstösse.

Wenn es wer ausprobieren will. Man muss alle 3 ImageLists befüllen (1x Normal, 1x für HOver, 1x für Clicked) und die Index dazu einstellen. Damit kann man schöne Grafiken einbinden und das Drücken bzw. Überfahren mit der Maus visuell rückmelden. Für mich ist das ganze deswegen interessant, weil ich es sowohl unter Windows als auch unter dem RasPi benötige. Damit zwickt es manchmal mit den BGRA Komponenten und den zusätzlich verwendeten Bibliotheken. Ich wollte nicht mit Kanonen auf einen Spatz schiessen.

Andi
Dateianhänge
ImageButton.zip
(161.6 KiB) 17-mal heruntergeladen
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

theo
Beiträge: 8318
Registriert: Mo 11. Sep 2006, 19:01

Re: Mausbotschaften in Paket geht nicht [gelöst]

Beitrag von theo »

@Andi: Könntest du bitte noch die "Auflösung" bezüglich des Titels dazu schreiben?
Was hatte das jetzt mit "Paket" zu tun?

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 4146
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Niederösterreich
Kontaktdaten:

Re: Mausbotschaften in Package geht nicht [gelöst]

Beitrag von af0815 »

habe den Titel geändert, ich habe den deutschen Namen Paket statt Package verwendet gehabt.
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

theo
Beiträge: 8318
Registriert: Mo 11. Sep 2006, 19:01

Re: Mausbotschaften in Package geht nicht [gelöst]

Beitrag von theo »

af0815 hat geschrieben:
Do 28. Mai 2020, 11:43
habe den Titel geändert, ich habe den deutschen Namen Paket statt Package verwendet gehabt.
Danke, aber das macht mich auch nicht schlauer. :wink:
Was hat es mit "Package" zu tun? Oder meinst du Komponente?

wp_xyz
Beiträge: 3251
Registriert: Fr 8. Apr 2011, 09:01

Re: Mausbotschaften in Paket geht nicht

Beitrag von wp_xyz »

af0815 hat geschrieben:
Mi 27. Mai 2020, 15:52
Man muss alle 3 ImageLists befüllen (1x Normal, 1x für Hover, 1x für Clicked) und die Index dazu einstellen.
Warum eigentlich drei ImageLists? Nachdem für jeden Zustand (Normal, Hover, Click) ein separater ImageIndex vorgesehen ist, würde doch auch eine einzige ImageList reichen. Und würde im Extremfall nicht auch der Normal-ImageIndex reichen, für den Fall, dass man die Hover/Click-Effekte nicht braucht/will?

Was mir noch aufgefallen ist: es gibt hier keine Caption, aber auch keinen Hint. Woher weiß der User, was er da eigentlich anklickt?
af0815 hat geschrieben:
Mi 27. Mai 2020, 15:52
Damit zwickt es manchmal mit den BGRA Komponenten und den zusätzlich verwendeten Bibliotheken. Ich wollte nicht mit Kanonen auf einen Spatz schiessen.
Sehr vernünftige Einstellung. Mir tut es jedesmal weh, wenn die Leute wegen eines winzigen Features riesige Bibliotheken installieren müssen.

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 4146
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Niederösterreich
Kontaktdaten:

Re: Mausbotschaften in Package geht nicht [gelöst]

Beitrag von af0815 »

Warum 3x ImageList. Ganz einfach, damit es einfacher ist zu verstehen und man nicht herumrechnen muss welcher Indexwert jetzt der richtige ist. Ist aber reine Geschmackssache. Bei OpenSource kann ja jeder das ändern :-) Aktuell ist es so, das du keine ImageList angeben musst für das was du nicht willst.

Das ist sehr für meine Zwecke zusammen komprimiert. Deswegen keine Caption und Hint. Bei mir ist die Caption im Image fixiert. Ich habe bei Gimp eine Vorlage im xcf Format und von dem werden alle 'Buttons' tapeziert. Genaugenommen verwende ich Produktbilder und Beschriftung und füge die zusammen. Das ginge noch flexibler, an das habe ich schon gedacht, ist aber was für den nächsten Leerlauf und kalte Winterabende :mrgreen:

Bezüglich externe Komponenten ist es bei mir so, das ich normalerweise soweit wie möglich auf Windows die Basisentwicklung mache und dann auf Ubuntu/Debian/Raspbian ausrollen darf/muss. Mein Arbeitsrechner muss Windows in der aktuellsten Version sein, da viele industrielle Entwicklungstool nur nativ drauf laufen (Simatik, Designstudios für Displays, Tools für Profibus und andere). Vor allen ein Bugfix muss immer unter Lazarus (Cross) zu kompileren sein und ich habe es schon erlebt das Komponenten plötzlich unter RaspBian nicht funktioniert haben. Das ist der Grund warum ich die Abhängigkeiten reduziere und für jede externe Komponente auch einen eigenen GIT lokal vorhalte.
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

wennerer
Beiträge: 152
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 19.3 Cinnamon, Lazarus 2.1.0, FPC 3.3.1 ,Lazarus Stable 2.0.6,
CPU-Target: x86_64

Re: Mausbotschaften in Package geht nicht [gelöst]

Beitrag von wennerer »

Hallo in die Runde,
ich möchte noch eine kleine Frage stellen. Andreas führt in seiner Komponente die geerbten Eigenschaft alle mit auf.
Ich hab das auch schon anders wo gesehen. Warum macht man das? Ich konnte im Verhalten der Komponente keinen Unterschied feststellen.

Code: Alles auswählen

 // stolen from TImage in ExtCtrl
    property AntialiasingMode;
    property Align;
    property Anchors;
    property AutoSize;
    property BorderSpacing;
    property Center;
    property KeepOriginXWhenClipped;
    property KeepOriginYWhenClipped;
    property Constraints;
    property DragCursor;
    property DragMode;
    property Enabled;
    property OnChangeBounds;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnPaint;
    property OnPictureChanged;
    property OnPaintBackground;
    property OnResize;
    property OnStartDrag;
    property ParentShowHint;
    property Picture;
    property PopupMenu;
    property Proportional;
    property ShowHint;
    property Stretch;
    property StretchOutEnabled;
    property StretchInEnabled;
    property Transparent;
    property Visible;
  end;

Viele Grüße
Bernd

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 4146
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Niederösterreich
Kontaktdaten:

Re: Mausbotschaften in Package geht nicht [gelöst]

Beitrag von af0815 »

Ganz einfach, die sind in den Basiskompomponente (TCustomXXXX) nicht in der richtigen Sichtbarkeit - das ist so gewünscht - und hier werden die Sichtbarkeiten richtig gesetzt. Man muss sich AUgen halten, mann kann die Sichtbarkeit immer erhöhen, umgekehrt geht es nicht.

Deswegen leitet man seine Komponente von der Basisversion ab (TCustomXXXX stattt TXXXX). Dann kann man die Sichtbarkeiten nach seinen wünschen setzen. Vereinfacht gesagt, alles was nicht published ist, fehlt später im ObjektInspektor.
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

wennerer
Beiträge: 152
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 19.3 Cinnamon, Lazarus 2.1.0, FPC 3.3.1 ,Lazarus Stable 2.0.6,
CPU-Target: x86_64

Re: Mausbotschaften in Package geht nicht [gelöst]

Beitrag von wennerer »

Danke für die Antwort.
hab's kapiert. Musste eben nur nochmal testen um sicher zu gehen.

Viele Grüße
Bernd

Antworten