Solved

Vista DWM thumbnail with Delphi 7 - how?

Posted on 2009-06-29
5
1,335 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Firemonkey webbrowser scrollbars ? 1 70
Delphi Seattle StructureView color 1 34
IP without any Dots 1 99
Firemonkey Tcameracomponent resultion 1 48
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
How to Install VMware Tools in Red Hat Enterprise Linux 6.4 (RHEL 6.4) Step-by-Step Tutorial

739 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