Author: William Gerbert
I'm looking for a Delphi translation of the IAutoComplete interface in Microsofts
shldisp.h. Can anyone point me in the right direction, please?
Answer:
Here is the translation and a TEdit decendant I wrote a while back:
1 unit uAutoComplete;
2
3 interface
4
5 uses
6 Windows, SysUtils, Controls, Classes, ActiveX, ComObj, stdctrls, Forms, Messages;
7
8 const
9 IID_IAutoComplete: TGUID = '{00bb2762-6a77-11d0-a535-00c04fd7d062}';
10 IID_IAutoComplete2: TGUID = '{EAC04BC0-3791-11d2-BB95-0060977B464C}';
11 CLSID_IAutoComplete: TGUID = '{00BB2763-6A77-11D0-A535-00C04FD7D062}';
12 IID_IACList: TGUID = '{77A130B0-94FD-11D0-A544-00C04FD7d062}';
13 IID_IACList2: TGUID = '{470141a0-5186-11d2-bbb6-0060977b464c}';
14 CLSID_ACLHistory: TGUID = '{00BB2764-6A77-11D0-A535-00C04FD7D062}';
15 CLSID_ACListISF: TGUID = '{03C036F1-A186-11D0-824A-00AA005B4383}';
16 CLSID_ACLMRU: TGUID = '{6756a641-de71-11d0-831b-00aa005b4383}';
17
18 type
19 IACList = interface(IUnknown)
20 ['{77A130B0-94FD-11D0-A544-00C04FD7d062}']
21 function Expand(pszExpand: POLESTR): HResult; stdcall;
22 end;
23
24 const
25 {Options for IACList2}
26 ACLO_NONE = 0; {don't enumerate anything}
27 ACLO_CURRENTDIR = 1; {enumerate current directory}
28 ACLO_MYCOMPUTER = 2; {enumerate MyComputer}
29 ACLO_DESKTOP = 4; {enumerate Desktop Folder}
30 ACLO_FAVORITES = 8; {enumerate Favorites Folder}
31 ACLO_FILESYSONLY = 16; {enumerate only the file system}
32
33 type
34
35 IACList2 = interface(IACList)
36 ['{470141a0-5186-11d2-bbb6-0060977b464c}']
37 function SetOptions(dwFlag: DWORD): HResult; stdcall;
38 function GetOptions(var pdwFlag: DWORD): HResult; stdcall;
39 end;
40
41 IAutoComplete = interface(IUnknown)
42 ['{00bb2762-6a77-11d0-a535-00c04fd7d062}']
43 function Init(hwndEdit: HWND; const punkACL: IUnknown; pwszRegKeyPath,
44 pwszQuickComplete: POLESTR): HResult; stdcall;
45 function Enable(fEnable: BOOL): HResult; stdcall;
46 end;
47
48 const
49 {Options for IAutoComplete2}
50 ACO_NONE = 0;
51 ACO_AUTOSUGGEST = $1;
52 ACO_AUTOAPPEND = $2;
53 ACO_SEARCH = $4;
54 ACO_FILTERPREFIXES = $8;
55 ACO_USETAB = $10;
56 ACO_UPDOWNKEYDROPSLIST = $20;
57 ACO_RTLREADING = $40;
58
59 type
60
61 IAutoComplete2 = interface(IAutoComplete)
62 ['{EAC04BC0-3791-11d2-BB95-0060977B464C}']
63 function SetOptions(dwFlag: DWORD): HResult; stdcall;
64 function GetOptions(out pdwFlag: DWORD): HResult; stdcall;
65 end;
66
67 TEnumString = class(TInterfacedObject, IEnumString)
68 private
69 FStrings: TStringList;
70 FCurrIndex: integer;
71 public
72 {IEnumString}
73 function Next(celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall;
74 function Skip(celt: Longint): HResult; stdcall;
75 function Reset: HResult; stdcall;
76 function Clone(out enm: IEnumString): HResult; stdcall;
77 {VCL}
78 constructor Create;
79 destructor Destroy; override;
80 end;
81
82 TACOption = (acAutoAppend, acAutoSuggest, acUseArrowKey);
83 TACOptions = set of TACOption;
84
85 TACSource = (acsList, acsHistory, acsMRU, acsShell);
86
87 TACEdit = class(TEdit)
88 private
89 FACList: TEnumString;
90 FAutoComplete: IAutoComplete;
91 FACEnabled: boolean;
92 FACOptions: TACOptions;
93 FACSource: TACSource;
94 function GetACStrings: TStringList;
95 procedure SetACEnabled(const Value: boolean);
96 procedure SetACOptions(const Value: TACOptions);
97 procedure SetACSource(const Value: TACSource);
98 protected
99 procedure CreateWnd; override;
100 procedure DestroyWnd; override;
101 public
102 constructor Create(AOwner: TComponent); override;
103 destructor Destroy; override;
104 published
105 property ACStrings: TStringList read GetACStrings;
106 property ACEnabled: boolean read FACEnabled write SetACEnabled;
107 property ACOptions: TACOptions read FACOptions write SetACOptions;
108 property ACSource: TACSource read FACSource write SetACSource;
109 end;
110
111 implementation
112
113 { IUnknownInt }
114
115 function TEnumString.Clone(out enm: IEnumString): HResult;
116 begin
117 Result := E_NOTIMPL;
118 pointer(enm) := nil;
119 end;
120
121 constructor TEnumString.Create;
122 begin
123 inherited Create;
124 FStrings := TStringList.Create;
125 FCurrIndex := 0;
126 end;
127
128 destructor TEnumString.Destroy;
129 begin
130 FStrings.Free;
131 inherited;
132 end;
133
134 function TEnumString.Next(celt: Integer; out elt; pceltFetched: PLongint): HResult;
135 var
136 I: Integer;
137 wStr: WideString;
138 begin
139 I := 0;
140 while (I < celt) and (FCurrIndex < FStrings.Count) do
141 begin
142 wStr := FStrings[FCurrIndex];
143 TPointerList(elt)[I] := CoTaskMemAlloc(2 * (Length(wStr) + 1));
144 StringToWideChar(wStr, TPointerList(elt)[I], 2 * (Length(wStr) + 1));
145 Inc(I);
146 Inc(FCurrIndex);
147 end;
148 if pceltFetched <> nil then
149 pceltFetched^ := I;
150 if I = celt then
151 Result := S_OK
152 else
153 Result := S_FALSE;
154 end;
155
156 function TEnumString.Reset: HResult;
157 begin
158 FCurrIndex := 0;
159 Result := S_OK;
160 end;
161
162 function TEnumString.Skip(celt: Integer): HResult;
163 begin
164 if (FCurrIndex + celt) <= FStrings.Count then
165 begin
166 Inc(FCurrIndex, celt);
167 Result := S_OK;
168 end
169 else
170 begin
171 FCurrIndex := FStrings.Count;
172 Result := S_FALSE;
173 end;
174 end;
175
176 { TACEdit }
177
178 constructor TACEdit.Create(AOwner: TComponent);
179 begin
180 inherited;
181 FACList := TEnumString.Create;
182 FACEnabled := true;
183 FACOptions := [acAutoAppend, acAutoSuggest, acUseArrowKey];
184 end;
185
186 procedure TACEdit.CreateWnd;
187 var
188 Dummy: IUnknown;
189 Strings: IEnumString;
190 begin
191 inherited;
192 if HandleAllocated then
193 begin
194 try
195 Dummy := CreateComObject(CLSID_IAutoComplete);
196 if (Dummy <> nil) and (Dummy.QueryInterface(IID_IAutoComplete, FAutoComplete)
197 =
198 S_OK) then
199 begin
200 case FACSource of
201 acsHistory:
202 Strings := CreateComObject(CLSID_ACLHistory) as IEnumString;
203 acsMRU:
204 Strings := CreateComObject(CLSID_ACLMRU) as IEnumString;
205 acsShell:
206 Strings := CreateComObject(CLSID_ACListISF) as IEnumString;
207 else
208 Strings := FACList as IEnumString;
209 end;
210 if S_OK = FAutoComplete.Init(Handle, Strings, nil, nil) then
211 begin
212 SetACEnabled(FACEnabled);
213 SetACOptions(FACOptions);
214 end;
215 end;
216 except
217 {CLSID_IAutoComplete is not available}
218 end;
219 end;
220 end;
221
222 destructor TACEdit.Destroy;
223 begin
224 FACList := nil;
225 inherited;
226 end;
227
228 procedure TACEdit.DestroyWnd;
229 begin
230 if (FAutoComplete <> nil) then
231 begin
232 FAutoComplete.Enable(false);
233 FAutoComplete := nil;
234 end;
235 inherited;
236 end;
237
238 function TACEdit.GetACStrings: TStringList;
239 begin
240 Result := FACList.FStrings;
241 end;
242
243 procedure TACEdit.SetACEnabled(const Value: boolean);
244 begin
245 if (FAutoComplete <> nil) then
246 begin
247 FAutoComplete.Enable(FACEnabled);
248 end;
249 FACEnabled := Value;
250 end;
251
252 procedure TACEdit.SetACOptions(const Value: TACOptions);
253 const
254 Options: array[TACOption] of integer = (ACO_AUTOAPPEND, ACO_AUTOSUGGEST,
255 ACO_UPDOWNKEYDROPSLIST);
256 var
257 Option: TACOption;
258 Opt: DWORD;
259 AC2: IAutoComplete2;
260 begin
261 if (FAutoComplete <> nil) then
262 begin
263 if S_OK = FAutoComplete.QueryInterface(IID_IAutoComplete2, AC2) then
264 begin
265 Opt := ACO_NONE;
266 for Option := Low(Options) to High(Options) do
267 begin
268 if (Option in FACOptions) then
269 Opt := Opt or DWORD(Options[Option]);
270 end;
271 AC2.SetOptions(Opt);
272 end;
273 end;
274 FACOptions := Value;
275 end;
276
277 procedure TACEdit.SetACSource(const Value: TACSource);
278 begin
279 if FACSource <> Value then
280 begin
281 FACSource := Value;
282 RecreateWnd;
283 end;
284 end;
285
286 initialization
287 finalization
288 end.
|
