Author: Lou Adler
I need to get image thumbnails (not icons) from Windows, using IExtractImage. How
can I do that?
Answer:
Very few namespaces actually implement this interface.
1
2 {Encapsulates IExtractImage, ASCI and Unicode}
3
4 TExtractImage = class
5 private
6 FFlags: Longword; {Sets how the image is to be handled see IEIFLAG_xxxx}
7 FPriority: Longword; {Returns from GetLocation call the priority
8 if IEIFLAG_ASYNC is used above}
9 FHeight: Longword; {Desired image height}
10 FWidth: Longword; {Desired image width}
11 FColorDepth: Longword; {Desired color depth}
12 FExtractImageInterface: IExtractImage; {The interface}
13 FExtractImage2Interface: IExtractImage2; {The interface for image2}
14 FOwner: TNamespace; {The Owner namespace}
15 FPathExtracted: Boolean;
16 function GetImage: TBitmap;
17 function GetImagePath: WideString;
18 function GetExtractImageInterface: IExtractImage;
19 function GetExtractImageInterface2: IExtractImage2;
20 protected
21 property PathExtracted: Boolean read FPathExtracted write FPathExtracted;
22 public
23 constructor Create;
24 property ColorDepth: Longword read FColorDepth write FColorDepth;
25 property ImagePath: WideString read GetImagePath;
26 property Image: TBitmap read GetImage;
27 property ExtractImageInterface: IExtractImage read GetExtractImageInterface;
28 property ExtractImage2Interface: IExtractImage2 read GetExtractImageInterface2;
29 property Flags: Longword read FFlags write FFlags;
30 property Height: Longword read FHeight write FHeight;
31 property Owner: TNamespace read FOwner write FOwner;
32 property Priority: Longword read FPriority;
33 property Width: Longword read FWidth write FWidth;
34 end;
35
36 {TExtractImage}
37
38 {Encapsulation of IExtractImage and IExtractImage2}
39 constructor TExtractImage.Create;
40 begin
41 FWidth := 200;
42 FHeight := 200;
43 FColorDepth := 32;
44 FFlags := IEIFLAG_SCREEN;
45 end;
46
47
48 function TExtractImage.GetImage: TBitmap;
49 var
50 Bits: HBITMAP;
51 begin
52 Bits := 0;
53 Result := nil;
54 if Assigned(ExtractImageInterface) then
55 if ExtractImageInterface.Extract(Bits) = NOERROR then
56 begin
57 Result := TBitmap.Create;
58 Result.Handle := Bits;
59 end
60 end;
61
62
63 function TExtractImage.GetExtractImageInterface2: IExtractImage2;
64 var
65 Found: Boolean;
66 begin
67 if not Assigned(FExtractImage2Interface) then
68 begin
69 Found := False;
70 if Assigned(ExtractImageInterface) then
71 Found := ExtractImageInterface.QueryInterface(IID_IExtractImage2,
72 Pointer(FExtractImage2Interface)) <> E_NOINTERFACE;
73 if not Found then
74 FExtractImage2Interface := nil
75 end;
76 Result := FExtractImage2Interface
77 end;
78
79
80 function TExtractImage.GetExtractImageInterface: IExtractImage;
81 var
82 Found: Boolean;
83 begin
84 if not Assigned(FExtractImageInterface) then
85 begin
86 Found := False;
87 if Assigned(Owner.ParentShellFolder) then
88 begin
89 Found := Owner.ParentShellFolder.GetUIObjectOf(0, 1, Owner.FRelativePIDL,
90 IExtractImage, nil, Pointer(FExtractImageInterface)) =
91 NOERROR;
92 end;
93 if not Found and Assigned(Owner.ShellFolder) then
94 begin
95 Found := Owner.ShellFolder.CreateViewObject(0, IExtractImage,
96 Pointer(FExtractImageInterface)) = NOERROR;
97 end;
98 if not Found then
99 FExtractImageInterface := nil
100 end;
101 Result := FExtractImageInterface
102 end;
103
104
105 function TExtractImage.GetImagePath: WideString;
106 var
107 Size: TSize;
108 Buffer: PWideChar;
109 begin
110 if Assigned(ExtractImageInterface) then
111 begin
112 GetMem(Buffer, MAX_PATH * 4);
113 try
114 try
115 Size.cx := Width;
116 Size.cy := Height;
117 if ExtractImageInterface.GetLocation(Buffer, MAX_PATH, FPriority, Size,
118 ColorDepth, FFlags) = NOERROR then
119 begin
120 Result := Buffer;
121 PathExtracted := True
122 end
123 else
124 Result := '';
125 finally
126 FreeMem(Buffer);
127 end
128 except
129 Result := ''
130 end;
131 end;
132 end;
|
