Vortex
Vortex

Reputation: 125

Create Floating Image Popup Window in Delphi XE (Windows 7)

I'm running Delphi XE, under Windows 7 64 bit.

I have these third party components loaded: Virtual Trees Version 4.8.7 TZip Version 1.5 JVCL 3.45 Graphics32 1.9 Final GExperts 1.33 DWS DCP Crypt Version 2.0 TeeChart Pro v2011

I want to create a popup "preview" image of a PDF when the mouse is hoovering over a TListBox Item. I'd figure I would create a TForm within my my window's FormCreate, and hide it, until (ListBox.ItemIndex > -1) on my TfrmMain.ListBoxMouseMove routine.

For now, I'm just trying to master using a JPEG image, instead of a PDF.
I noticed that using the TImage and OnMouseOver is rather SLOW. Is there a faster way of doing this? Maybe using a JEDI component?

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.

Upvotes: 1

Views: 2161

Answers (1)

Vortex
Vortex

Reputation: 125

Well...I found that the Adobe's Acrobat Control component to be just what I needed. It's a little slow, but it's MUCH faster than the TImage method. Here's my revised solution:

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.

Upvotes: 1

Related Questions