source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Design/TntWideStringProperty_Design.pas

Last change on this file was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 11.4 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntWideStringProperty_Design;
13
14{$INCLUDE ..\Source\TntCompilers.inc}
15
16interface
17
18{*****************************************************}
19{ TWideCharProperty-editor implemented by Maël Hörz }
20{*****************************************************}
21
22{$IFDEF COMPILER_9_UP}
23 {$MESSAGE FATAL 'The Object Inspector in Delphi 9 is already Unicode enabled.'}
24{$ENDIF}
25
26uses
27 Classes, Messages, Windows, Graphics, TypInfo, TntDesignEditors_Design,
28 DesignIntf, DesignEditors, VCLEditors;
29
30type
31 TWideStringProperty = class(TPropertyEditor, ICustomPropertyDrawing)
32 private
33 FActivateWithoutGetValue: Boolean;
34 FPropList: PInstPropList;
35 protected
36 procedure SetPropEntry(Index: Integer; AInstance: TPersistent; APropInfo: PPropInfo); override;
37 function GetWideStrValueAt(Index: Integer): WideString; dynamic;
38 function GetWideStrValue: WideString;
39 procedure SetWideStrValue(const Value: WideString); dynamic;
40 function GetWideVisualValue: WideString;
41 public
42 constructor Create(const ADesigner: ITntDesigner; APropCount: Integer); override;
43 destructor Destroy; override;
44 procedure Activate; override;
45 procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
46 procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
47 function AllEqual: Boolean; override;
48 function GetEditLimit: Integer; override;
49 function GetValue: AnsiString; override;
50 procedure SetValue(const Value: AnsiString); override;
51 {$IFDEF MULTI_LINE_STRING_EDITOR}
52 function GetAttributes: TPropertyAttributes; override;
53 procedure Edit; override;
54 {$ENDIF}
55 end;
56
57 TWideCaptionProperty = class(TWideStringProperty)
58 public
59 function GetAttributes: TPropertyAttributes; override;
60 end;
61
62 TWideCharProperty = class(TWideStringProperty)
63 protected
64 {$IFDEF COMPILER_7_UP}
65 function GetIsDefault: Boolean; override;
66 {$ENDIF}
67 function GetWideStrValueAt(Index: Integer): WideString; override;
68 procedure SetWideStrValue(const Value: WideString); override;
69 public
70 function GetAttributes: TPropertyAttributes; override;
71 function GetEditLimit: Integer; override;
72 end;
73
74procedure Register;
75
76implementation
77
78uses
79 Controls, Forms, SysUtils, StdCtrls, TntGraphics, TntControls,
80 TntSysUtils, TntSystem, Consts,
81 RTLConsts;
82
83procedure Register;
84begin
85 RegisterPropertyEditor(TypeInfo(WideString), nil, '', TWideStringProperty);
86 RegisterPropertyEditor(TypeInfo(TWideCaption), nil, '', TWideCaptionProperty);
87 RegisterPropertyEditor(TypeInfo(WideChar), nil, '', TWideCharProperty);
88end;
89
90function GetOIInspListBox: TWinControl;
91var
92 ObjectInspectorForm: TCustomForm;
93 Comp: TComponent;
94begin
95 Result := nil;
96 ObjectInspectorForm := GetObjectInspectorForm;
97 if ObjectInspectorForm <> nil then begin
98 Comp := ObjectInspectorForm.FindComponent('PropList');
99 if Comp is TWinControl then
100 Result := TWinControl(Comp);
101 end;
102end;
103
104function GetOIPropInspEdit: TCustomEdit{TNT-ALLOW TCustomEdit};
105var
106 OIInspListBox: TWinControl;
107 Comp: TComponent;
108begin
109 Result := nil;
110 OIInspListBox := GetOIInspListBox;
111 if OIInspListBox <> nil then begin
112 Comp := OIInspListBox.FindComponent('EditControl');
113 if Comp is TCustomEdit{TNT-ALLOW TCustomEdit} then
114 Result := TCustomEdit{TNT-ALLOW TCustomEdit}(Comp);
115 end;
116end;
117//------------------------------
118
119type TAccessWinControl = class(TWinControl);
120
121{ TWideStringProperty }
122
123var
124 WideStringPropertyCount: Integer = 0;
125
126constructor TWideStringProperty.Create(const ADesigner: ITntDesigner; APropCount: Integer);
127begin
128 inherited;
129 Inc(WideStringPropertyCount);
130 GetMem(FPropList, APropCount * SizeOf(TInstProp));
131end;
132
133procedure ConvertObjectInspectorBackToANSI;
134var
135 Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
136begin
137 if (Win32PlatformIsUnicode) then begin
138 Edit := GetOIPropInspEdit;
139 if Assigned(Edit)
140 and IsWindowUnicode(Edit.Handle) then
141 TAccessWinControl(Edit).RecreateWnd;
142 end;
143end;
144
145destructor TWideStringProperty.Destroy;
146begin
147 Dec(WideStringPropertyCount);
148 if (WideStringPropertyCount = 0) then
149 ConvertObjectInspectorBackToANSI;
150 if FPropList <> nil then
151 FreeMem(FPropList, PropCount * SizeOf(TInstProp));
152 inherited;
153end;
154
155{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
156type
157 THackPropertyEditor = class
158 FDesigner: IDesigner;
159 FPropList: PInstPropList;
160 end;
161{$ENDIF}
162
163procedure TWideStringProperty.Activate;
164var
165 Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
166begin
167 FActivateWithoutGetValue := True;
168 if (Win32PlatformIsUnicode) then begin
169 Edit := GetOIPropInspEdit;
170 if Assigned(Edit)
171 and (not IsWindowUnicode(Edit.Handle)) then
172 ReCreateUnicodeWnd(Edit, 'EDIT', True);
173 end;
174end;
175
176procedure TWideStringProperty.SetPropEntry(Index: Integer;
177 AInstance: TPersistent; APropInfo: PPropInfo);
178begin
179 inherited;
180 with FPropList^[Index] do
181 begin
182 Instance := AInstance;
183 PropInfo := APropInfo;
184 end;
185end;
186
187function TWideStringProperty.GetWideStrValueAt(Index: Integer): WideString;
188begin
189 with FPropList^[Index] do Result := GetWideStrProp(Instance, PropInfo);
190end;
191
192function TWideStringProperty.GetWideStrValue: WideString;
193begin
194 Result := GetWideStrValueAt(0);
195end;
196
197procedure TWideStringProperty.SetWideStrValue(const Value: WideString);
198var
199 I: Integer;
200begin
201 for I := 0 to PropCount - 1 do
202 with FPropList^[I] do SetWideStrProp(Instance, PropInfo, Value);
203 Modified;
204end;
205
206function TWideStringProperty.GetWideVisualValue: WideString;
207begin
208 if AllEqual then
209 Result := GetWideStrValue
210 else
211 Result := '';
212end;
213
214procedure TWideStringProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
215begin
216 DefaultPropertyDrawName(Self, ACanvas, ARect);
217end;
218
219procedure TWideStringProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
220begin
221 WideCanvasTextRect(ACanvas, ARect, ARect.Left + 1, ARect.Top + 1, GetWideVisualValue);
222end;
223
224function TWideStringProperty.AllEqual: Boolean;
225var
226 I: Integer;
227 V: WideString;
228begin
229 Result := False;
230 if PropCount > 1 then
231 begin
232 V := GetWideStrValue;
233 for I := 1 to PropCount - 1 do
234 if GetWideStrValueAt(I) <> V then Exit;
235 end;
236 Result := True;
237end;
238
239function TWideStringProperty.GetEditLimit: Integer;
240var
241 Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
242begin
243 Result := MaxInt;
244 // GetEditLimit is called right before the inplace editor text has been set
245 if Win32PlatformIsUnicode then begin
246 Edit := GetOIPropInspEdit;
247 if Assigned(Edit) then begin
248 TntControl_SetText(Edit, GetWideStrValue);
249 TntControl_SetHint(Edit, GetWideStrValue);
250 end;
251 end;
252end;
253
254function TWideStringProperty.GetValue: AnsiString;
255begin
256 FActivateWithoutGetValue := False;
257 Result := WideStringToStringEx(GetWideStrValue, CP_ACP{TNT-ALLOW CP_ACP}); // use the same code page as the inplace editor
258end;
259
260procedure TWideStringProperty.SetValue(const Value: AnsiString);
261var
262 Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
263begin
264 if (not FActivateWithoutGetValue) then begin
265 Edit := GetOIPropInspEdit;
266 if Assigned(Edit) and Win32PlatformIsUnicode then
267 SetWideStrValue(TntControl_GetText(Edit))
268 else
269 SetWideStrValue(StringToWideStringEx(Value, CP_ACP{TNT-ALLOW CP_ACP})); // use the same code page as the inplace editor
270 end;
271end;
272
273{$IFDEF MULTI_LINE_STRING_EDITOR}
274function TWideStringProperty.GetAttributes: TPropertyAttributes;
275begin
276 Result := inherited GetAttributes + [paDialog];
277end;
278
279procedure TWideStringProperty.Edit;
280var
281 Temp: WideString;
282begin
283 with TTntStrEditDlg.Create(Application) do
284 try
285 PrepareForWideStringEdit;
286 Memo.Text := GetWideStrValue;
287 UpdateStatus(nil);
288 if ShowModal = mrOk then begin
289 Temp := Memo.Text;
290 while (Length(Temp) > 0) and (Temp[Length(Temp)] < ' ') do
291 System.Delete(Temp, Length(Temp), 1); { trim control characters from end }
292 SetWideStrValue(Temp);
293 end;
294 finally
295 Free;
296 end;
297end;
298{$ENDIF}
299
300{ TWideCaptionProperty }
301
302function TWideCaptionProperty.GetAttributes: TPropertyAttributes;
303begin
304 Result := inherited GetAttributes + [paAutoUpdate];
305end;
306
307{ TWideCharProperty }
308
309function TWideCharProperty.GetAttributes: TPropertyAttributes;
310begin
311 Result := [paMultiSelect, paRevertable];
312end;
313
314function TWideCharProperty.GetEditLimit: Integer;
315begin
316 inherited GetEditLimit;
317 Result := 63;
318end;
319
320{$IFDEF COMPILER_7_UP}
321function TWideCharProperty.GetIsDefault: Boolean;
322var
323 i: Integer;
324 OldPropList: PInstPropList;
325begin
326 Result := True;
327 if PropCount > 0 then
328 begin
329 OldPropList := THackPropertyEditor(Self).FPropList;
330 // The memory FPropList points to is write-protected.
331 // In the constructor we dynamically allocated our own PropList,
332 // which can be written, so point there instead.
333 THackPropertyEditor(Self).FPropList := FPropList;
334
335 // Delphi can't handle WideChar-type, but does well with Word-type,
336 // which has exactly the same size as WideChar (i.e. 2 Bytes)
337 for i := 0 to PropCount - 1 do
338 FPropList^[i].PropInfo^.PropType^ := TypeInfo(Word);
339
340 Result := inherited GetIsDefault;
341
342 for i := 0 to PropCount - 1 do
343 FPropList^[i].PropInfo^.PropType^ := TypeInfo(WideChar);
344
345 THackPropertyEditor(Self).FPropList := OldPropList;
346 end;
347end;
348{$ENDIF}
349
350function IsCharGraphic(C: WideChar): Boolean;
351begin
352 if Win32PlatformIsUnicode then
353 Result := not IsWideCharCntrl(C) and not IsWideCharSpace(C)
354 else // representation as charcode avoids corruption on ANSI-systems
355 Result := (C >= #33) and (C <= #127);
356end;
357
358function TWideCharProperty.GetWideStrValueAt(Index: Integer): WideString;
359var
360 C: WideChar;
361begin
362 with FPropList^[Index] do
363 C := WideChar(GetOrdProp(Instance, PropInfo));
364
365 if IsCharGraphic(C) then
366 Result := C
367 else
368 Result := WideFormat('#%d', [Ord(C)]);
369end;
370
371procedure TWideCharProperty.SetWideStrValue(const Value: WideString);
372var
373 C: Longint;
374 I: Integer;
375begin
376 if Length(Value) = 0 then
377 C := 0
378 else if Length(Value) = 1 then
379 C := Ord(Value[1])
380 else if Value[1] = '#' then
381 C := StrToInt(Copy(Value, 2, Maxint))
382 else
383 raise EPropertyError.Create(SInvalidPropertyValue);
384
385 with GetTypeData(GetPropType)^ do
386 if (C < MinValue) or (C > MaxValue) then
387 raise EPropertyError.CreateFmt(SOutOfRange, [MinValue, MaxValue]);
388
389 for I := 0 to PropCount - 1 do
390 with FPropList^[I] do SetOrdProp(Instance, PropInfo, C);
391
392 Modified;
393end;
394
395initialization
396
397finalization
398 ConvertObjectInspectorBackToANSI;
399
400end.
Note: See TracBrowser for help on using the repository browser.