Solved

Vista DWM thumbnail with Delphi 7 - how?

Posted on 2009-06-29
5
1,283 Views
Last Modified: 2012-08-13
Hello!

Some days ago i did find an article "Programming the Windows Vista DWM in C#" You can read it under this link: http://bartdesmet.net/blogs/bart/archive/2006/10/05/4495.aspx

I decided that i'd like to realize this method with Delphi Win32 (Delphi 7). Delphi 7 is installed under my Vista Ultimate.

I linked a dwm.pas into my project (you can download it from this site:
http://www.box.net/index.php?rm=box_v2_download_shared_file&file_id=f_83304197
the zip file is containing the dwm unit...)

but i don't how can i apply it in my program...? I tried to "copy" the original source but...
Is there any way to show a live thumbnail in my form? What is the destination handle? An image canvas or bitmap handle? I don't know....

Any help will be appreciated! Thanks in advance!

My attampt is the following:



unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, dwm, StdCtrls, ExtCtrls;

 

type

  TForm1 = class(TForm)

    Button1: TButton;

    Image1: TImage;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

    thumb: ^integer;

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

function UpdateThumb():boolean;

var

 size: PSize;

 props: PDWM_THUMBNAIL_PROPERTIES;

begin

    result:=true;

    if form1.thumb <> nil then

    begin

      DwmQueryThumbnailSourceSize(form1.thumb^, size);

      props.dwFlags:=DWM_TNP_VISIBLE and DWM_TNP_RECTDESTINATION and DWM_TNP_OPACITY;

      props.fVisible:=true;

      props.opacity:=50;

      props.fSourceClientAreaOnly:=false;

      props.rcDestination:=Rect(form1.Image1.left,form1.image1.Top,form1.Image1.Left+form1.Image1.Width,form1.Image1.Top+form1.Image1.Height);

 

      if (size.cx<form1.Image1.Width) then props.rcDestination.Right:=props.rcDestination.Left+size.cx;

      if (size.cy<form1.Image1.Height) then props.rcDestination.Top:=props.rcDestination.Left+size.cy;

 

      DwmUpdateThumbnailProperties(form1.thumb^,Pointer(props));

    end;

 

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

 h: Hwnd;

 r: TRect;

 wwidth, wheight: integer;

 i: integer;

begin

 h:=FindWindow(nil,'Untitled - Notepad');

 

   if h<>0 then

   begin

   GetWindowRect(h,r);

   wwidth:=r.Right-r.Left;

   wheight:=r.Bottom-r.Top;

 

   if thumb <> nil then DwmUnregisterThumbnail(thumb^);

 

   i:=DwmRegisterThumbnail(image1.canvas.Handle,h,Ptr(thumb^));

   if i=0 then UpdateThumb();

   end;

 

end;

 

end.

Open in new window

0
Comment
Question by:rogerrr
  • 2
5 Comments
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24742825
nice attempt ...

i would provide some parameters to your updatethumb (make it independant of form1)

if that don't work,
first assign a bitmap in the picture property, best is a ordinary white bitmap

or use a TPanel instead of a TImage

I don't have Vista, so can't test, just trying to help
unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, dwm, StdCtrls, ExtCtrls;

 

type

  TForm1 = class(TForm)

    Button1: TButton;

    Image1: TImage;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

    thumb: PHTHUMBNAIL;

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

function UpdateThumb(aThumb: PHTHUMBNAIL; aDestRect: TRect):boolean;

var

 size: PSize;

 props: PDWM_THUMBNAIL_PROPERTIES;

begin

    result:=true;

    if aThumb <> nil then

    begin

      DwmQueryThumbnailSourceSize(aThumb^, size);

      props.dwFlags:=DWM_TNP_VISIBLE and DWM_TNP_RECTDESTINATION and DWM_TNP_OPACITY;

      props.fVisible:=true;

      props.opacity:=50;

      props.fSourceClientAreaOnly:=false;

      props.rcDestination:=;

 

      if (size.cx < aDestRect.Right - aDestRect.Left) then props.rcDestination.Right:=props.rcDestination.Left+size.cx;

      if (size.cy < aDestRect.Bottom - aDestRect.Top) then props.rcDestination.Top:=props.rcDestination.Left+size.cy;

 

      DwmUpdateThumbnailProperties(aThumb^,Pointer(props));

    end;

 

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

 h: Hwnd;

 r: TRect;

 wwidth, wheight: integer;

 i: integer;

begin

 h:=FindWindow(nil,'Untitled - Notepad');

 

   if h<>0 then

   begin

   GetWindowRect(h,r);

   wwidth:=r.Right-r.Left;

   wheight:=r.Bottom-r.Top;

 

   if thumb <> nil then 

   begin

     DwmUnregisterThumbnail(thumb^);

     thumb := nil;

   end;

 

   i:=DwmRegisterThumbnail(image1.canvas.Handle,h,thumb);

   if i=0 then UpdateThumb(thumb, Rect(Image1.left,image1.Top, 

     Image1.Left  + Image1.Width, Image1.Top + Image1.Height));

   end;

 

end;

 

end.

Open in new window

0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24742828
wouldn't it be more like this for the destination ?

UpdateThumb(thumb, Rect(0,0,Image1.Width, Image1.Height));
0
 

Accepted Solution

by:
rogerrr earned 0 total points
ID: 24995818
Thanks, but your suggestion is unusable...

I solved it.

function UpdateThumbnail(Window: HWND): HRESULT;
var
  HR: HRESULT;
  Thumbnail: HTHUMBNAIL;
  HwndSource: HWND;
  r, DestRect: TRect;
  DskThumbProps: DWM_THUMBNAIL_PROPERTIES;
begin
  HwndSource := FindWindow('MozillaUIWindowClass',nil);
  if HwndSource = 0 then
  begin
    Result := E_HANDLE;
    Exit;
  end;

  // Register Thumbnail.
  HR := DwmRegisterThumbnail(Window, HwndSource, Thumbnail);
  if FAILED(HR) then
  begin
    Result := HR;
    Exit;
  end;

  ZeroMemory(@DskThumbProps, SizeOf(DWM_THUMBNAIL_PROPERTIES));
  // Destination rectangle size.
  //GetWindowRect(HwndSource,r); //Rect(0, 50, 100, 150);
  DestRect:=Rect(0,150,250,300);
  // Set thumbnail properties for use.
  DskThumbProps.dwFlags := DWM_TNP_RECTDESTINATION or
    DWM_TNP_VISIBLE or DWM_TNP_SOURCECLIENTAREAONLY;
  // Use window frame and client area.
  DskThumbProps.fSourceClientAreaOnly := False;
  DskThumbProps.fVisible := True;
  DskThumbProps.opacity := 100;
  DskThumbProps.rcDestination := DestRect;

  // Display the thumbnail.
  HR := DwmUpdateThumbnailProperties(Thumbnail, DskThumbProps);
  if FAILED(HR) then
  begin
    Result := HR;
    Exit;
  end;

  Result := HR;
end;


(TO ADMIN: Please don't reduce my points...)


 Thanks!
0
 
LVL 100

Expert Comment

by:mlmcc
ID: 34376096
This question has been classified as abandoned and is being closed as part of the Cleanup Program.  See my comment at the end of the question for more details.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Suggested Solutions

Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now