Author: Tomas Rutkauskas
How to implement autocompletion in a TEdit
Answer:
Solve 1:
Here is a procedure using the OnKeyDown that will autocomplete an edit box using a
lookup source table. Change it to suit your needs but it should give you an idea of
how to do the selections and stuff with an edit control. This will work with just
about any type of edit control and I use it for combo boxes as well. You just need
to change the typecasting.
1
2 procedure TForm1.EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
3 var
4 s1: string;
5 s2: string;
6 begin
7 if TEdit(Sender).Text = '' then
8 exit;
9 s1 := TEdit(Sender).Text;
10 s2 := s1;
11 with mtDM.LookTable do {change here for your own lookup stuff...}
12 begin
13 if not Locate(LookField, TEdit(Sender).Text, [loPartialKey]) then
14 begin
15 Key := 0;
16 if length(s2) = 1 then
17 begin
18 TEdit(Sender).Text := '';
19 exit;
20 end;
21 System.delete(s2, length(s2), 1);
22 TEdit(Sender).Text := s2;
23 s1 := s2;
24 Locate(LookField, TEdit(Sender).Text, [loPartialKey]);
25 end;
26 s1 := FieldByName(LookField).AsString;
27 TEdit(Sender).Text := copy(s1, 1, length(s2)) + copy(s1, length(s2) + 1,
28 length(s1));
29 TEdit(Sender).SelStart := Length(s2);
30 TEdit(Sender).SelLength := length(s1) - length(s2);
31 end;
32 inherited;
33 end;
Solve 2:
34 unit AutoEdit;
35
36 interface
37
38 uses
39 Windows, Messages, SysUtils, Classes, Graphics, StdCtrls, Controls,
40 Dialogs, Forms;
41
42 type
43 TAutoEdit = class(TEdit)
44 private
45 fList: TListBox;
46 fItems: TStringList;
47 fLabel: TLabel;
48 fCaption: string;
49 fBackColor: TColor;
50 fCaptionColor: TColor;
51 fAutoComplete: Boolean;
52 fListCount: Integer;
53 fOldText: string;
54 procedure SetCaption(S: string);
55 procedure SetCaptionColor(const Color: TColor);
56 procedure SetBackColor(const Color: TColor);
57 procedure SetAutoComplete(AutoCompleteOn: Boolean);
58 procedure ShowList;
59 protected
60 procedure CreateWnd; override;
61 procedure CreateParams(var params: TCreateParams); override;
62 procedure SetParent(AParent: TWinControl); override;
63 procedure SetName(const Value: TComponentName); override;
64 public
65 constructor Create(AOwner: TComponent); override;
66 destructor Destroy; override;
67 procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
68 procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift:
69 TShiftState; X, Y: Integer);
70 procedure HideList;
71 procedure DoExit; override;
72 property Items: TStringList read fItems write fItems;
73 published
74 procedure KeyPress(var Key: Char); override;
75 procedure KeyDown(var Key: Word; Shift: TShiftState); override;
76 property Caption: string read fCaption write SetCaption;
77 property CaptionColor: TColor read fCaptionColor write SetCaptionColor;
78 property BackColor: TColor read fBackColor write SetBackColor;
79 property AutoComplete: Boolean read fAutoComplete write SetAutoComplete;
80 property ListCount: Integer read fListCount write fListCount default 5;
81 end;
82
83 procedure register;
84
85 implementation
86
87 procedure register;
88 begin
89 RegisterComponents('Freeware', [TAutoEdit]);
90 end;
91
92 { TAutoEdit }
93
94 constructor TAutoEdit.Create(AOwner: TComponent);
95 begin
96 inherited;
97 fItems := TStringList.Create;
98 fList := TListBox.Create(Self);
99 fLabel := TLabel.Create(Self);
100 fLabel.ParentColor := True;
101 fLabel.AutoSize := False;
102 fLabel.FocusControl := Self;
103 fCaptionColor := fLabel.Font.Color;
104 fBackColor := fLabel.Color;
105 fList.Parent := Self;
106 fList.IntegralHeight := True;
107 fList.ParentCtl3D := False;
108 fList.Ctl3D := False;
109 fList.TabStop := False;
110 fList.Visible := False;
111 fListCount := 5;
112 end;
113
114 destructor TAutoEdit.Destroy;
115 begin
116 {fList.Free;}
117 fItems.Free;
118 fLabel.Free;
119 inherited;
120 end;
121
122 procedure TAutoEdit.SetParent(AParent: TWinControl);
123 var
124 FirstSetting: Boolean;
125 begin
126 if Parent = nil then
127 FirstSetting := True
128 else
129 FirstSetting := False;
130 inherited;
131 if Parent <> nil then
132 begin
133 fList.Parent := Self.Parent;
134 fLabel.Parent := Self.Parent;
135 if FirstSetting then
136 begin
137 fLabel.ParentColor := True;
138 SetBounds(Left, Top, Width, Height);
139 end;
140 end;
141 end;
142
143 procedure TAutoEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
144 begin
145 inherited SetBounds(ALeft, ATop, AWidth, AHeight);
146 if Parent <> nil then
147 begin
148 if (fCaption > '') and (fLabel.Parent <> nil) then
149 begin
150 fLabel.Top := ATop - (1 + fLabel.Canvas.TextHeight('lj'));
151 fLabel.Height := AHeight + 4 + fLabel.Canvas.TextHeight('lj');
152 end
153 else
154 begin
155 fLabel.Top := ATop - 2;
156 fLabel.Height := AHeight + 4;
157 end;
158 fLabel.Left := ALeft - 2;
159 fLabel.Width := AWidth + 4;
160 if csDesigning in ComponentState then
161 begin
162 fList.Parent := Self;
163 HideList;
164 end
165 else if fList.Visible then
166 ShowList;
167 end;
168 end;
169
170 procedure TAutoEdit.SetName(const Value: TComponentName);
171 begin
172 if Name > '' then
173 if fCaption = Name then
174 Caption := Value;
175 inherited SetName(Value);
176 if Text = Name then
177 begin
178 Text := '';
179 Caption := Value;
180 end;
181 end;
182
183 procedure TAutoEdit.CreateWnd;
184 begin
185 inherited;
186 end;
187
188 procedure TAutoEdit.CreateParams(var params: TCreateParams);
189 begin
190 inherited;
191 fList.Color := Self.Color;
192 fList.Font := Self.Font;
193 fList.OnMouseUp := ListMouseUp;
194 HideList;
195 end;
196
197 procedure TAutoEdit.SetCaption(S: string);
198 begin
199 fCaption := S;
200 fLabel.Caption := ' ' + S;
201 SetBounds(Left, Top, Width, Height)
202 end;
203
204 procedure TAutoEdit.SetCaptionColor(const Color: TColor);
205 begin
206 if fCaptionColor <> Color then
207 begin
208 fCaptionColor := Color;
209 fLabel.Font.Color := Color;
210 SetBounds(Left, Top, Width, Height)
211 end;
212 end;
213
214 procedure TAutoEdit.SetBackColor(const Color: TColor);
215 begin
216 if fBackColor <> Color then
217 begin
218 fBackColor := Color;
219 fLabel.Color := Color;
220 SetBounds(Left, Top, Width, Height)
221 end;
222 end;
223
224 procedure TAutoEdit.SetAutoComplete(AutoCompleteOn: Boolean);
225 begin
226 fAutoComplete := AutoCompleteOn;
227 end;
228
229 procedure TAutoEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
230 Shift: TShiftState; X, Y: Integer);
231 begin
232 Text := fList.Items[fList.ItemIndex];
233 SelStart := Length(Text);
234 HideList;
235 fList.Clear;
236 PostMessage(Handle, WM_KEYDOWN, VK_TAB, 0);
237 PostMessage(Handle, WM_KEYUP, VK_TAB, 0);
238 end;
239
240 procedure TAutoEdit.DoExit;
241 begin
242 if not fList.Focused then
243 HideList;
244 inherited;
245 end;
246
247 procedure TAutoEdit.KeyPress(var Key: Char);
248 var
249 K, T: string;
250 I, S: Integer;
251 begin
252 if ReadOnly then
253 begin
254 inherited;
255 Exit;
256 end;
257 K := Key;
258 if (Key = #27) and (fList.Visible) then
259 begin
260 Key := #0;
261 Text := Copy(Text, 1, SelStart);
262 SelStart := Length(Text);
263 fList.Clear;
264 HideList;
265 end
266 else if fAutoComplete then
267 if ((K > #27) and (K < #129)) or (K = #8) then
268 begin
269 if (K = #8) then
270 T := Copy(Text, 1, SelStart - 1)
271 else
272 T := Copy(Text, 1, SelStart) + K;
273 K := Uppercase(T);
274 fList.Clear;
275 if fItems.Count > 0 then
276 for I := 0 to fItems.Count - 1 do
277 begin
278 if (Pos(K, Uppercase(fItems[I])) = 1) then
279 fList.Items.Add(fItems[I]);
280 if fList.Items.Count > fListCount - 1 then
281 Break;
282 end;
283 S := Length(T);
284 if (fList.Items.Count > 0) and (Key <> #8) then
285 begin
286 Text := Copy(T, 1, S) + Copy(fList.Items[0], S + 1, Length(fList.Items[0]));
287 end
288 else
289 Text := T;
290 Key := #0;
291 SelStart := S;
292 SelLength := Length(Text) - S;
293 fOldText := Copy(Text, 1, SelStart);
294 end;
295 if fList.Items.Count > 0 then
296 ShowList
297 else
298 HideList;
299 inherited;
300 end;
301
302 procedure TAutoEdit.KeyDown(var Key: Word; Shift: TShiftState);
303 var
304 I, S: Integer;
305 begin
306 if Key = VK_DELETE then
307 begin
308 fList.Clear;
309 HideList;
310 end
311 else if fList.Visible then
312 if (Key = VK_DOWN) or (Key = VK_UP) then
313 begin
314 S := SelStart;
315 if Key = VK_DOWN then
316 I := fList.ItemIndex + 1
317 else
318 I := fList.ItemIndex - 1;
319 if I < -1 then
320 I := fList.Items.Count - 1;
321 if I > fList.Items.Count - 1 then
322 I := -1;
323 fList.ItemIndex := I;
324 if I = -1 then
325 begin
326 Text := fOldText;
327 SelStart := Length(Text);
328 SelLength := 0;
329 end
330 else
331 begin
332 Text := fList.Items[fList.ItemIndex];
333 SelStart := S;
334 SelLength := Length(Text) - S;
335 end;
336 Key := 0;
337 end;
338 if (not fList.Visible) and ((Key = VK_LEFT) or (Key = VK_RIGHT)) then
339 if SelLength = Length(Text) then
340 if (Shift = []) and (Length(Text) > 0) then
341 begin
342 SelLength := 0;
343 {if (Key = VK_LEFT) and (SelStart > 1) then
344 SelStart := SelStart - 1
345 else
346 if (Key = VK_RIGHT) and (SelStart < Length(Text)) then
347 SelStart := SelStart + 1;}
348 Key := 0;
349 end;
350 inherited;
351 end;
352
353 procedure TAutoEdit.ShowList;
354 begin
355 if Parent <> nil then
356 begin
357 fList.Top := Top + ClientHeight;
358 fList.Left := Left;
359 fList.Width := Width;
360 fList.Height := fList.ItemHeight * (fList.Items.Count + 1);
361 fList.BringToFront;
362 fList.Show;
363 end;
364 end;
365
366 procedure TAutoEdit.HideList;
367 var
368 I: Integer;
369 begin
370 if (Text > '') then
371 for I := 0 to fList.Items.Count - 1 do
372 if Uppercase(fList.Items[I]) = Uppercase(Text) then
373 begin
374 Text := fList.Items[I];
375 Break;
376 end;
377 fList.Hide;
378 fList.Top := Top;
379 fList.Height := 0;
380 fList.Left := Left;
381 fList.Width := 0;
382 end;
383
384 initialization
385 begin
386 RegisterClass(TLabel);
387 end;
388
389 end.
|
