[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1437
  • Last Modified:

Vista DWM thumbnail with Delphi 7 - how?

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
rogerrr
Asked:
rogerrr
  • 2
1 Solution
 
Geert GruwezOracle dbaCommented:
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
 
Geert GruwezOracle dbaCommented:
wouldn't it be more like this for the destination ?

UpdateThumb(thumb, Rect(0,0,Image1.Width, Image1.Height));
0
 
rogerrrAuthor Commented:
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
 
mlmccCommented:
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

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now