Здравствуйте, <Аноним>, Вы писали:

А>Всем привет. Помогите с решением такого вопроса. Список ихображений загружен в Listbox-e и мне нужно чтобы в ballon hint-e отображалось то изображение над именем которым в данный момент находится мышка. У меня этот hint реализован в виде отдельной формы на которой можно установить и Label, и Image. Но главное, как вызвать эту форму (подсказку) при перемещении мыши над Listbox-oм и выдернуть из него пути к этим изображениям?

Вот простейший пример реализации hint-а, показывающего изображение вместо текста:

unit ImageHint;

interface

uses Controls, Jpeg, Classes, Windows;

type
    TImageHint = class(THintWindow)
    private
        FJpegImage: TJPEGImage;
    protected
        procedure Paint; override;
    public
        function CalcHintRect(MaxWidth: Integer; const AHint: string;
            AData: Pointer): TRect; override;
        procedure ActivateHint(Rect: TRect; const AHint: string); override;

        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
    end;

implementation

{ TImageHint }

procedure TImageHint.ActivateHint(Rect: TRect; const AHint: string);
begin
    inherited;
    try
        FJpegImage.LoadFromFile(AHint);
    except
        on EFOpenError do begin
            FJpegImage.Width := 0;
            FJpegImage.Height := 0;
        end;
    end;
end;

function TImageHint.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
var
    JpegImage: TJPEGImage;
begin
    Result.TopLeft := inherited CalcHintRect(MaxWidth, '_', nil).TopLeft;
    JpegImage := TJPEGImage.Create;
    try
        try
            JpegImage.LoadFromFile(AHint);
        except
            on EFOpenError do ;
        end;
        Result.Right := Result.Left + JpegImage.Width;
        Result.Bottom := Result.Top + JpegImage.Height;
    finally
        JpegImage.Free;
    end;
end;

constructor TImageHint.Create(AOwner: TComponent);
begin
    inherited;
    FJpegImage := TJPEGImage.Create;
end;

destructor TImageHint.Destroy;
begin
    FJpegImage.Free;
    inherited;
end;

procedure TImageHint.Paint;
begin
    Canvas.Draw(ClientRect.Left, ClientRect.Top + 1, FJpegImage);
end;

end.

Работает только с Jpeg, но легко можно добавить поддержку bmp и возможно других форматов, воспользовавшись например классом TImage (создавая его как дочерний контрол по отношению к TImageHint).

Из минусов можно назвать загрузку jpeg из файла каждый раз, когда отображается подсказка. Возможно здесь следует подумать о кешировании. Кроме того, вычисление размеров jpeg через его загрузку тоже не фонтан, нужно рассмотреть другие варианты.

Пример использования:

unit Main;

interface

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

type
  TTestForm = class(TForm)
    ListBox: TListBox;
    AppEvents: TApplicationEvents;
    procedure AppEventsShowHint(var HintStr: String; var CanShow: Boolean;
      var HintInfo: THintInfo);
    procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  end;

var
  TestForm: TTestForm;

implementation

uses ImageHint;

{$R *.DFM}

procedure TTestForm.AppEventsShowHint(var HintStr: String;
  var CanShow: Boolean; var HintInfo: THintInfo);
var
    Index: Integer;
begin
    if HintInfo.HintControl = ListBox then begin
        HintInfo.HintWindowClass := TImageHint;
        Index := ListBox.ItemAtPos(HintInfo.CursorPos, True);
        if Index >= 0 then
             HintStr := ListBox.Items[Index]
        else HintStr := '';
    end;
end;

procedure TTestForm.ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    Index: Integer;
begin
    Index := ListBox.ItemAtPos(Point(X, Y), True);
    if (Index >= 0) and (Index <> ListBox.Tag) then begin
        Application.ActivateHint(Mouse.CursorPos);
        ListBox.Tag := Index;
    end;
end;

end.

Здесь предполагается, что строками ListBox-а являются полные пути к файлам, содержащим изображения.

Удачи!