在 Delphi XE (Windows 7) 中创建浮动图像弹出窗口

Question

我在 Windows 7 64 位下运行 Delphi XE。

我已加载这些第三方组件： 虚拟树版本 4.8.7 TZip 1.5 版 合资公司 3.45 Graphics32 1.9 最终版 G专家 1.33 DWS DCP 地穴 2.0 版 TeeChart Pro v2011

我想在鼠标悬停在 TListBox 项上时创建 PDF 的弹出“预览”图像。我想我会在我的窗口的 F​​ormCreate 中创建一个 TForm，并将其隐藏，直到我的 TfrmMain.ListBoxMouseMove 例程上的 (ListBox.ItemIndex > -1)。

目前，我只是想掌握使用 JPEG 图像，而不是 PDF。
我注意到使用 TImage 和 OnMouseOver 相当慢。 有没有更快的方法来做到这一点？也许使用 JEDI 组件？

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, PicUnit, jpeg, GraphUtil;

type
  TfrmMain = class(TForm)
    lst: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure lstClick(Sender: TObject);
    procedure lstMouseMove(Sender: TObject; Shift: TShiftState; 
      X, Y: Integer);
    procedure lstMouseLeave(Sender: TObject);
    public
      popPic: TfrmPic;
      ImagePaths: TStringList;
      LastHoover: Integer;
      procedure LoadImages(Item: Integer);
  end;

var
  frmMain: TfrmMain;

Implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  popPic := TfrmPic.Create(nil);
  ImagePaths := TStringList.Create;
  LastHoover := -1;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  popPic.Free;
  ImagePaths.Free;
end;

procedure TfrmMain.lstClick(Sender: TObject);
begin
  if (lst.ItemIndex > -1) then
  begin
    popPic.Show;
  end { ItemIndex > -1 }
  else
    popPic.Hide;
end;

procedure TfrmMain.lstMouseLeave(Sender: TObject);
begin
  frmPic.Hide;
end;

procedure TfrmMain.lstMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  HooverItem : Integer;
begin
  { Returns -1 if the mouse is NOT over a item on the list }
  HooverItem := lst.ItemAtPos (Point (X, Y), True);

  if (HooverItem > -1) and (HooverItem <> LastHoover) then
  begin
    { Match the image onto the screen }
    frmPic.Left := frmMain.ClientToScreen(Point(X, Y)).X;
    frmPic.Top := frmMain.ClientToScreen(Point(X, Y)).Y;

    LoadImages(HooverItem);
    LastHoover := HooverItem;

    if (ImagePaths.Count > 0) then
    begin
      { TImage Method }
      frmPic.imgStd.Stretch := True;
      frmPic.imgStd.Picture.LoadFromFile (ImagePaths [0]);
      frmPic.Show;
      frmMain.SetFocus;
    end
    else
      frmPic.Hide;
  end
  else
  if (HooverItem = -1) then
    frmPic.Hide;
end;

procedure TfrmMain.LoadImages(Item: Integer);
begin
  { Clear off the existing list }
  ImagePaths.Clear;

  if (Item = 0) then
  begin
    ImagePaths.Add ('C:\Floating Image Demo\0.jpeg');
    ImagePaths.Add ('C:\Floating Image Demo\1.jpeg');
  end
  else
  if (Item = 1) then
  begin
    ImagePaths.Add ('C:\Floating Image Demo\1.jpeg');
    ImagePaths.Add ('C:\Floating Image Demo\0.jpeg');
  end;
end;

end.

Answer 1

嗯...我发现 Adob​​e 的 Acrobat Control 组件正是我所需要的。它有点慢，但比 TImage 方法快得多。 这是我修改后的解决方案：

Unit MainUnit;

Interface

Uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  OleCtrls,
  AcroPDFLib_TLB;


Type
  TfrmMain = Class (TForm)
    lst : TListBox;


    Procedure FormCreate    (     Sender: TObject     );
    Procedure FormClose     (     Sender: TObject;
                              Var Action: TCloseAction);
    Procedure lstClick      (     Sender: TObject     );
    Procedure lstMouseMove  (     Sender: TObject;
                                   Shift: TShiftState;
                                       X,
                                       Y: Integer     );
    Procedure lstMouseLeave (     Sender: TObject     );


    Public
      frmPic     : TForm;
      Pdf        : TAcroPDF;
      ImagePaths : TStringList;
      LastHoover : Integer;


      Procedure LoadImages  (       Item: Integer     );

  End;

Var
  frmMain: TfrmMain;

Implementation

{$R *.dfm}




Procedure TfrmMain.FormCreate      (             Sender: TObject              );
Begin

  frmPic     := TForm.Create (Nil);
  ImagePaths := TStringList.Create;
  LastHoover := -1;

  { Create the "popup" form, and the PDF viewer object }
  frmPic.Height      := 160;
  frmPic.Width       := 200;
  frmPic.BorderStyle := bsNone;
  Pdf                := TAcroPDF.Create (frmPic);
  Pdf.Parent         := frmPic;
  Pdf.Name           := 'AcroPDF';
  Pdf.Align          := alClient;
  Pdf.setShowToolbar (False);

End;


Procedure TfrmMain.FormClose       (             Sender: TObject;
                                             Var Action: TCloseAction         );
Begin

  { Free the objects }
  Try
    FreeAndNil (Pdf);
    frmPic.Free;
    ImagePaths.Free;

  Finally
    { Stop ALL threads-If this is removed some fonts within the drawings cause Adobe a screw up and keep running, thus causing an AV }
    Application.Terminate;
  End;

End;


Procedure TfrmMain.lstClick        (             Sender: TObject              );
Var
  CurrentPos : TPoint;

Begin

  If (lst.ItemIndex > -1) Then Begin

    { Match the image onto the screen }
    Windows.GetCursorPos (CurrentPos);
    frmPic.Left := CurrentPos.X + 20;
    frmPic.Top  := CurrentPos.Y + 20;

    { Load the PDFs }
    LoadImages (lst.ItemIndex);


    If (ImagePaths.Count > 0) Then Begin
      { Adobe Acrobat Control ActiveX Component }
      PDF.LoadFile (WideString (ImagePaths [0]));
      PDF.setShowToolbar (False);
      PDF.gotoFirstPage;


      frmPic.Show;
      frmPic.SetFocus;
    End;

  End { ItemIndex > -1 }
  Else
    frmPic.Hide;

End;


Procedure TfrmMain.lstMouseLeave   (   Sender: TObject   );
Begin

  frmPic.Hide;

End;

Procedure TfrmMain.lstMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer);
Var
  HooverItem : Integer;

Begin

  { Returns -1 if the mouse is NOT over a item on the list }
  HooverItem := lst.ItemAtPos (Point (X, Y), True);

  If (HooverItem > -1) Then Begin

    { Match the image onto the screen }
    frmPic.Left := frmMain.ClientToScreen (Point (X, Y)).X + 20;
    frmPic.Top  := frmMain.ClientToScreen (Point (X, Y)).Y + 20;

  End;

End;
{ ---------------------------------------------------------------------------- }








{ ---------------------------------------------------------------------------- }
{ --------------------------- PRIVATE METHODS -------------------------------- }
{ ---------------------------------------------------------------------------- }

Procedure TfrmMain.LoadImages                    (        Item: Integer       );
Begin

  { Clear off the existing list }
  ImagePaths.Clear;

  If (Item = 0) Then Begin
    ImagePaths.Add ('C:\Project_Files\SVN\Local\EXAMPLES, TEMPLATES, MISC\Floating Image Demo\0.pdf');
    ImagePaths.Add ('C:\Project_Files\SVN\Local\EXAMPLES, TEMPLATES, MISC\Floating Image Demo\1.pdf');
  End
  Else if (Item = 1) Then Begin
    ImagePaths.Add ('C:\Project_Files\SVN\Local\EXAMPLES, TEMPLATES, MISC\Floating Image Demo\1.pdf');
    ImagePaths.Add ('C:\Project_Files\SVN\Local\EXAMPLES, TEMPLATES, MISC\Floating Image Demo\0.pdf');
  End;

End; { LoadImages Procedure }
{ ---------------------------------------------------------------------------- }

End.