Graphischer Hint mit eigenen Bitmap

[Helmi]

Hallo,

bei diesem Schweizer link wird gezeigt, wie man einen graphischen Hint mit Bitmap drin erzeugen kann.

Das funktioniert auch - nur würd ich jetzt gerne dem Hint ein Bitmap mitgeben.
Nicht so wie in dem Beispiel, dass ein festes Bitmap geladen wird.

Mit diesem Code:

Delphi-Quellcode:

procedure TSymboleForm.ShellListView_TastenbilderMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  ListItem: TListItem;
  Zeile   : Integer;
  Hint_alt: String;
  Hint_neu: String;

begin
  //Variablen vordefinieren
  Hint_alt  := '';
  Hint_neu  := '';
  Zeile     := -1;

  with ShellListView_Tastenbilder do
    begin
      ListItem := GetItemAt(X, Y);

      //alter Hint-Text auf Variable schreiben
      Hint_alt := Hint;

      If Assigned(ListItem) then
        begin
          //aktuelle Zeile auslesen
          Zeile := ListItem.Index;

          //neuen Hint auslesen
          Hint_neu := Folders[Zeile].DisplayName;
        end;

      //neue Zeile angewählt? - dann Hint_alt leeren
      If Zeile <> Tag then
        begin
          Hint_alt := '';
          Tag      := Zeile;
        end;

      //Hint-Text neu?
      If Hint_neu <> Hint_alt then
        begin
          //Hinttext anzeigen
          Hint := Hint_neu;

          //Hint anzeigen
          Application.CancelHint;
        end;
    end;
end;

les ich mir in MouseMove das aktuelle Item der ShellListView aus, beschreib den Hint mit dem Dateinamen und zeig dann den Hint an.

Nun würd ich aber dabei auch gerne das Icon des ShellListView-Items in dem Hint mit anzeigen.

Nur wie mach ich das?

[Helmi]

soooo,

ich hab selbst ne Lösung gefunden :-)

ich hab einfach eine function geschrieben, die mir aus der ShellListView das Bitmap ausliest:

Delphi-Quellcode:

function ShellListView_Bitmap(Bitmap_Datei: TFileName): TBitmap;
var
  i: Integer;

begin
  Result := TBitmap.Create;


  try
    with SymboleForm.ShellListView_Tastenbilder do
      begin
        for i := 0 to Pred(Items.Count) do
          If Folders[i].DisplayName = Bitmap_Datei then
            begin
              Result.LoadFromFile(Folders[i].PathName);

              break;
            end;
      end;
  finally
//    FreeAndNil(Result);
  end;
end;

und wird so aufgerufen:

Delphi-Quellcode:

procedure TGraphicHintWindow.Paint;
var
  Rec         : TRect;
  Bitmap      : TBitmap;
  Diff_Height : Integer;

begin
  //ClientRect auf Rec schreiben
  Rec     := ClientRect;

  //
  Inc(Rec.Left, 2);
  Inc(Rec.Top, 2);

  Bitmap  := TBitmap.Create;

  try
    Bitmap.Assign(ShellListView_Bitmap(Caption)); //<-- hier

    with Canvas do
      begin
        Brush.Style := bsSolid;

so erhalt ich das bitmap.

[himitsu]

Wenn du diesen Hint auch in anderen Anwendungen wiederverwenden möchtest, dann übergib doch einfach das BitMap (einen Verweis darauf) im HintText mit.

ich hatte es bei mir mal so gelößt:
meine Bildchen steckten in einer ImageList
und als Hinttext sah es dann so aus "ListIndex:HintText" > "123:der Hinweis"

Statt des ImageIndex könte man auch alles mögliche Andere nutzen.
z.B.: 'ne Objektrefferenz, einen Dateinamen, oder einen Zeiger auf irgendwas (Zahlen in Textform)

und notfalls könnte man sich auch so'ne Art Protokolle erstellen
"IMAGEFILE:{Dateiname}|{Hinttext}"
"IMAGE:{TImage-Refferenz}:{Hinttext}"
"IMAGELIST:{TImageList-Refferenz}:{ListIndex}:{Hinttext}"
"{Hinttext}"

[Helmi]

Danke himitsu für dein Hinweis

Im Grunde genommen (ok - weit gesehen) mach ich es ja so wie du
nur dass ich eben gleich das Bitmap suche und lade.

[lbccaleb]

wenn du lust und nen bissel zeit hast, dann kannst das ja noch in eine komponente packen, und vllt anderen zugängig machen, gibt bestimmt welche die sich über sowas freuen würden..

[Schwedenbitter]

Ich habe mich auch mal daran versucht.

Leider komme ich mit der Implementierung einer neuen Eigenschaft nicht weiter. Ich wollte - allgemein gültig - die Eigenschaft Picture vom Typ TPicture einfügen, damit man das Bild jeweils übergeben kann.Ich bekomme aber immer die Fehlermeldung

Zitat:

Feld- oder Methodenbezeichner erwartet

Den Code habe ich beigefügt.

Was mache ich falsch?

Alex

[Helmi]

Hallo,

deine "SetPicture"-Procedure ist unter private nicht definiert....

[toms]

Hallo !

Delphi-Quellcode:

    property Picture: TPicture read FPicture write SetPicture;

Ich musste den Code zuerst mal du DelForEx jagen, da der Code äussert ungewöhlich formatiert ist.
Habe auch ein paar Änderungen vorgenommen. (ist jedoch noch nicht fertig und könnten noch Fehler vorhanden sein!)

Delphi-Quellcode:

{*********************************************************

 Mit Hilfe des folgendes Codes lassen sich leicht beliebige
 Hints erstellen. Dazu muss nur dir Prozedur "Paint" den
 Wünschen entsprechend angepasst werden.

 With the following Code you can simply create custom hints.
 You just have to change the procedur "Paint".

 *********************************************************}
unit GraphicHint;

interface

uses
  Windows, Classes, Graphics, Controls, Forms, SysUtils;

type
  TGraphicHintWindow = class(THintWindow)
  private
    FPicture: TPicture;
    FActivating: Boolean;
    procedure SetPicture(Value: TPicture);
  public
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  protected
    procedure Paint; override;
  published
    property Caption;
    property Picture: TPicture read FPicture write SetPicture;
  end;

procedure Register;

implementation


constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  with Canvas.Font do
  begin
    Name := 'Arial';
    Style := Style + [fsBold];
    Color := clBlack;
  end;
end;

destructor TGraphicHintWindow.Destroy;
begin
  if FPicture <> nil then
    FreeAndNil(FPicture);
  inherited;
end;

procedure TGraphicHintWindow.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  bmp: TBitmap;
begin
  R := ClientRect;
  Inc(R.Left, 2);
  Inc(R.Top, 2);
  bmp := TBitmap.Create;
//   bmp.LoadfromFile('D:\hint.bmp');
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clsilver;
    Pen.Color := clgray;
    Rectangle(0, 0, 18, R.Bottom + 1);
    Draw(2, (R.Bottom div 2) - (bmp.Height div 2), bmp);
  end;
  bmp.Free;
  Color := clWhite;
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(20, (R.Bottom div 2) - (Canvas.Textheight(Caption) div 2), Caption);
end;

procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
  FActivating := True;
  try
    Caption := AHint;
    Inc(Rect.Bottom, 14); // Höhe des Hint
    Rect.Right := Rect.Right + 20; // Breite des Hint
    UpdateBoundsRect(Rect);
    if (Rect.Top + Height) > Screen.DesktopHeight then
      Rect.Top := Screen.DesktopHeight - Height;
    if (Rect.Left + Width) > Screen.DesktopWidth then
      Rect.Left := Screen.DesktopWidth - Width;
    if Rect.Left < Screen.DesktopLeft then
      Rect.Left := Screen.DesktopLeft;
    if Rect.Bottom < Screen.DesktopTop then
      Rect.Bottom := Screen.DesktopTop;
    SetWindowPos(Handle, HWND_TOPMOST,
      Rect.Left, Rect.Top, Width, Height,
      SWP_SHOWWINDOW or SWP_NOACTIVATE);
    Invalidate;
  finally
    FActivating := False;
  end;
end;



{procedure TForm1.FormCreate(Sender: TObject);
begin
 HintWindowClass := TGraphicHintWindow;
 Application.ShowHint := False;
 Application.ShowHint := True;
end;}



procedure Register;
begin
  RegisterComponents('Eigene', [TGraphicHintWindow]);
end;

end.

[Schwedenbitter]

Zitat:

Zitat von toms

Delphi-Quellcode:

    property Picture: TPicture read FPicture write SetPicture;

Ich meine, es verstanden zu haben.

Zitat:

Zitat von toms

Ich musste den Code zuerst mal du DelForEx jagen, da der Code äussert ungewöhlich formatiert ist.
Habe auch ein paar Änderungen vorgenommen. (ist jedoch noch nicht fertig und könnten noch Fehler vorhanden sein!)

Das tut mir wirklich leid. Bei mir ist alles mit Tabulatoren eingerückt. Möglicherweise verzerrt es das Bild, wenn andere Editoren das nicht eingestellt haben. Sieht hier im Forum aber Top aus :-D

Ich habe jetzt NEU angefangen. Ich konnte mich erinnern, dass ich mir vor Jahren mal den kurzen aber sehr wirkungsvollen Quellcode für mehrzeilige Hints besorgt hatte.
Darauf aufbauen haben ich zwei weitere Properties definiert. Allerdings habe ich nun Probleme mit dem Lesen und Schreiben der von mir definierten HGraphic vom Typ Bitmap. Ich habe das absichtlich genommen, weil man im Grunde alles nach Bitmap konvertieren kann. Wenn ich z.B. auf dem Formular ein TImage anlege, bestücke und mit Assign hin-und-herkopiere, dann bekomme ich nur eine leeres Formular.

Was mache ich falsch?

Delphi-Quellcode:

Constructor THHint.Create(AOwner:TComponent);
Begin
   Inherited Create(AOwner);
   FActive:=True;
   FSeparator:='@';
   FGraphicTag:='@Graphic@';
   FHGraphic:=nil;
   Application.OnShowHint:=NewHintInfo;
   ScreenSize:=GetSystemMetrics(Sm_CyScreen);
End;

...

// Grafik
Function THHint.GetHGraphic:TBitmap;
Begin
   Result:=TBitmap.Create;
   Result.Assign(FHGraphic);
   Result.Free;
End;

Procedure THHint.SetHGraphic(IsGraphic: TBitmap);
Begin
   FHGraphic.Assign(IsGraphic);
End;

Den Aufruf mache ich (vorerst bis zur Installation in der IDE) so:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
   HH:=THHint.Create(Form1);
   HH.HGraphic.Assign(Image1.Picture.Bitmap);
   Image1.Picture.Bitmap.Assign(HH.HGraphic);
end;

Für alle die mehr wollen, habe ich den Code nebst Beispiel angefügt...

Gute Nacht wünscht Alex

[Helmi]

Hallo,

dein Fehler liegt in der funtion:

Delphi-Quellcode:

Function THHint.GetHGraphic:TBitmap; 
Begin 
   Result:=TBitmap.Create; 
   Result.Assign(FHGraphic); 
   Result.Free; 
End;

Du darfst kein "Result.Free" aufrufen.
Der Rückgabewert, hier Result als Bitmap, ist beim Beenden
der function nicht mehr vorhanden (free), deswegen bekommst
du kein Bitmap.

Entfernst du die genannte Zeile, so bekommst du auch das
Bild ruckgeliefert, verursachst aber ein Speicherleck.

[Schwedenbitter]

@Helmi
Zuerst mal danke für den Hinweis.
Vermutlich war es gestern Abend/heute Morgen wohl doch etwas zu spät. Ich habe jetzt den Quellcode aus 2 Komponenten übernommen, die sich auch mit Grafik beschäftigen. Dort wird jeweils nur eine Methode für das Schreiben des TPicture angelegt. Das Lesen geht irgendwie auch so.
Ich behaupte nicht, es verstanden zu haben. Aber es funktioniert so:

Delphi-Quellcode:

Type
   THHint   = Class(TComponent)
               private
                  Screensize   : Integer;
                  Factive      : Boolean;        // Aktiv
                  Fseparator   : Char;           // Normaler Separator
                  FGraphicTag   : String;        // Grafik-TAG
                  FPicture    : TPicture;        // Grafik
                  FOnShowHint   : TShowHintEvent;// Anzeigen des Hint
               Protected
                  // Aktiv
                  Function GetActive:boolean;
                  Procedure SetActive(IsActive:Boolean);
                  // Normaler Separator
                  Function GetSeparator:Char;
                  Procedure SetSeparator(IsSep:Char);
                  // Grafik-TAG
                  Function GetGraphicTag:String;
                  Procedure SetGraphicTag(IsGraphTag:String);
                  // Grafik
                  Procedure SetPicture(IsGraphic:TPicture);
                  // Procedure zum Anzeigen des Hint
                  Procedure NewHintInfo(Var HintStr   : String;
                                        Var CanShow   : Boolean;
                                        Var HintInfo   : THintInfo);
               Public
                  Constructor Create(AOwner:Tcomponent);Override;
               Published
                  Property Active: Boolean Read GetActive Write SetActive;
                  Property Separator: Char Read GetSeparator Write SetSeparator;
                  Property GraphicTag: String Read GetGraphicTag Write SetGraphicTag;
                  Property Picture: TPicture Read FPicture Write SetPicture;
              End;

und hier die Methoden:

Delphi-Quellcode:

// Grafik
Procedure THHint.SetPicture(IsGraphic: TPicture);
Begin
  FPicture.Assign(IsGraphic);
End;

So dürfte es auch kein Speicherleck mehr geben, oder? Das Bild bekomme ich jedenfalls zurück. Ich mache mich dann mal (bei Gelegenheit) an das Bauen der Bildausgabe.

Nebenfrage: Warum werden manche Methoden zum Lesen beschrieben und andere nicht bzw. wonach richtet sich die Notwendigkeit? Ich nehme gern auch Links zum Nachlesen.

Gruß, Alex

[Schwedenbitter]

Ich bekomme kein Bitmap zu sehen :wall:

Ich hatte zunächst gesehen, dass der von mir veränderte Quellcode THHint zunächst von TComponent abgeleitet hat.
Letzteres kann aber von Hause aus nicht per Canvas zeichnen. Deshalb habe ich dann wie im Beispielcode die Ableitung von THintWindow vorgenommen.

Ich war deshalb davon ausgegangen, dass mein Problem vom Constructor her rührt

Delphi-Quellcode:

Constructor Create(AOwner: TComponent); Override;

Der ist aber im Beispielcode auch so; und er funktioniert. Der Compiler meckert ja auch nicht rum, das auf die Eigenschaft Canvas nicht zugegriffen werden könne.

Ich habe mir einen zusätzlichen Button auf das Formular gelegt. Beim Click wird mittels Canvas das Bild in THHint auf das Formular gemalt. Das klappt und ich habe den Code 1:1 in die Komponente übernommen.

Warum klappt es dort nicht mehr?

[edit]
Dateianhang vergessen!
[/edit]

[Schwedenbitter]

Ich bin jetzt schon soweit, dass ich die Ausgabe der Grafik hinbekomme, wobei FRect und Picture Eigenschaften der Komponente sind:

Delphi-Quellcode:

Var
   DesktopDC      : HDC;            // Handle auf irgendeinen Desktop
   DesktopCanvas   : TControlCanvas;// Leinwand zum Malen
   ...
Begin
   ...
         DesktopDC:=GetDC(0);
         If DesktopDC<>0 Then
         Try
            DesktopCanvas:=TControlCanvas.Create;
            Try
               DesktopCanvas.Handle:=DesktopDC;
               DesktopCanvas.Draw(FRect.Left,FRect.Top,Picture.Bitmap);
            Finally
               DesktopCanvas.Free;                  End;
         Finally
            ReleaseDC(0, DesktopDC);
         End;

Ich weiß zwar, wie ich den Bereich unter dem Bitmap wieder in den ursprünglichen Zustand zurückversetzen kann. Leider gibt es bei TApplication kein Ereignis wie z.B. OnHideHint. Die Procedure HideHint bringt mich nicht weiter. Ich möchte auch nicht TApplication ändern und um ein Ereignis erweitern...

Gibt es eine Möglichkeit herauszubekommen, wann der Hint wieder ausgeblendet werden muss?
Ich bin so kurz vor dem Ziel :|

Bei Bedarf gebe ich den Quelltext wieder mit. Ich habe aber Angst verhauden zu werden, wenn ich zig Versionen meines Programm hier einstelle...