2012-04-25 89 views
1

我在Windows 7 64位下运行Delphi XE。在Delphi XE中创建浮动图像弹出窗口(Windows 7)

我有这些第三方组件加载: 虚拟树木版本4.8.7 TZip 1.5版 JVCL 3.45 Graphics32 1.9最终 GExperts 1.33 DWS DCP地穴2.0版 的TeeChart Pro的V2011

我当鼠标悬停在TListBox项目上时,希望创建PDF的弹出式“预览”图像。我想我会创建一个TForm在我的窗口的FormCreate,并隐藏它,直到(ListBox.ItemIndex> -1)在我的TfrmMain.ListBoxMouseMove例程。

现在,我只是想要掌握使用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. 
+5

一个更好的方法是创建一个自定义提示窗口。 – 2012-04-25 14:26:40

+0

是否能够显示图像或PDF的自定义提示窗口? – 2012-04-25 21:19:06

+0

你是否想仅显示一个带有PDF预览的窗口(例如用第一个文档页面),或者你想创建一个*提示窗口*哪里可能还需要关注和处理文档(例如AdobeReader )? – TLama 2012-04-25 23:13:40

回答

1

那么......我发现Adobe的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. 
+0

+1,很好!我从来没有注意到'AdobeReader'类型的库可以被包装到组件中(我甚至懒得去尝试:-) – TLama 2012-04-26 20:25:41