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 !

    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 von toms:

    property Picture: TPicture read FPicture write SetPicture;

Ich meine, es verstanden zu haben.

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

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.