source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntDB.pas@ 1806

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 30.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 TntDB;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19 Classes, DB;
20
21type
22{TNT-WARN TDateTimeField}
23 TTntDateTimeField = class(TDateTimeField{TNT-ALLOW TDateTimeField})
24 protected
25 procedure SetAsString(const Value: AnsiString); override;
26 end;
27
28{TNT-WARN TDateField}
29 TTntDateField = class(TDateField{TNT-ALLOW TDateField})
30 protected
31 procedure SetAsString(const Value: AnsiString); override;
32 end;
33
34{TNT-WARN TTimeField}
35 TTntTimeField = class(TTimeField{TNT-ALLOW TTimeField})
36 protected
37 procedure SetAsString(const Value: AnsiString); override;
38 end;
39
40 TFieldGetWideTextEvent = procedure(Sender: TField; var Text: WideString;
41 DoDisplayText: Boolean) of object;
42 TFieldSetWideTextEvent = procedure(Sender: TField; const Text: WideString) of object;
43
44 IWideStringField = interface
45 ['{679C5F1A-4356-4696-A8F3-9C7C6970A9F6}']
46 {$IFNDEF COMPILER_10_UP}
47 function GetAsWideString: WideString;
48 procedure SetAsWideString(const Value: WideString);
49 {$ENDIF}
50 function GetWideDisplayText: WideString;
51 function GetWideEditText: WideString;
52 procedure SetWideEditText(const Value: WideString);
53 //--
54 {$IFNDEF COMPILER_10_UP}
55 property AsWideString: WideString read GetAsWideString write SetAsWideString{inherited};
56 {$ENDIF}
57 property WideDisplayText: WideString read GetWideDisplayText;
58 property WideText: WideString read GetWideEditText write SetWideEditText;
59 end;
60
61{TNT-WARN TWideStringField}
62 TTntWideStringField = class(TWideStringField{TNT-ALLOW TWideStringField}, IWideStringField)
63 private
64 FOnGetText: TFieldGetWideTextEvent;
65 FOnSetText: TFieldSetWideTextEvent;
66 procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
67 procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
68 procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
69 procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
70 function GetWideDisplayText: WideString;
71 function GetWideEditText: WideString;
72 procedure SetWideEditText(const Value: WideString);
73 protected
74 {$IFNDEF COMPILER_10_UP}
75 function GetAsWideString: WideString;
76 {$ENDIF}
77 public
78 property Value: WideString read GetAsWideString write SetAsWideString;
79 property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
80 property Text: WideString read GetWideEditText write SetWideEditText;
81 {$IFNDEF COMPILER_10_UP}
82 property AsWideString: WideString read GetAsWideString write SetAsWideString;
83 {$ENDIF}
84 property WideDisplayText: WideString read GetWideDisplayText;
85 property WideText: WideString read GetWideEditText write SetWideEditText;
86 published
87 property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
88 property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
89 end;
90
91 TTntStringFieldEncodingMode = (emNone, emUTF8, emUTF7, emFixedCodePage, emFixedCodePage_Safe);
92
93 //-------------------------------------------------------------------------------------------
94 // Comments on TTntStringFieldEncodingMode:
95 //
96 // emNone - Works like TStringField.
97 // emUTF8 - Should work well most databases.
98 // emUTF7 - Almost guaranteed to work with any database. Wasteful in database space.
99 // emFixedCodePage - Only tested it with Access 97, which doesn't support Unicode.
100 // emFixedCodePage_Safe - Like emFixedCodePage but uses char<=#128. Wasteful in database space.
101 //
102 // Only emUTF8 and emUTF7 fully support Unicode.
103 //-------------------------------------------------------------------------------------------
104
105 TTntStringFieldCodePageEnum = (fcpOther,
106 fcpThai, fcpJapanese, fcpSimplifiedChinese, fcpTraditionalChinese, fcpKorean,
107 fcpCentralEuropean, fcpCyrillic, fcpLatinWestern, fcpGreek, fcpTurkish,
108 fcpHebrew, fcpArabic, fcpBaltic, fcpVietnamese);
109
110const
111 TntStringFieldCodePageEnumMap: array[TTntStringFieldCodePageEnum] of Word = (0,
112 874, 932, 936, 950, 949,
113 1250, 1251, 1252, 1253, 1254,
114 1255, 1256, 1257, 1258);
115
116type
117{TNT-WARN TStringField}
118 TTntStringField = class(TStringField{TNT-ALLOW TStringField},IWideStringField)
119 private
120 FOnGetText: TFieldGetWideTextEvent;
121 FOnSetText: TFieldSetWideTextEvent;
122 FEncodingMode: TTntStringFieldEncodingMode;
123 FFixedCodePage: Word;
124 FRawVariantAccess: Boolean;
125 procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
126 procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
127 procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
128 procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
129 function GetWideDisplayText: WideString;
130 function GetWideEditText: WideString;
131 procedure SetWideEditText(const Value: WideString);
132 function GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
133 procedure SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
134 function IsFixedCodePageStored: Boolean;
135 protected
136 {$IFDEF COMPILER_10_UP}
137 function GetAsWideString: WideString; override;
138 procedure SetAsWideString(const Value: WideString); override;
139 {$ELSE}
140 function GetAsWideString: WideString; virtual;
141 procedure SetAsWideString(const Value: WideString); virtual;
142 {$ENDIF}
143 function GetAsVariant: Variant; override;
144 procedure SetVarValue(const Value: Variant); override;
145 function GetAsString: string{TNT-ALLOW string}; override;
146 procedure SetAsString(const Value: string{TNT-ALLOW string}); override;
147 public
148 constructor Create(AOwner: TComponent); override;
149 property Value: WideString read GetAsWideString write SetAsWideString;
150 property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
151 property Text: WideString read GetWideEditText write SetWideEditText;
152 {$IFNDEF COMPILER_10_UP}
153 property AsWideString: WideString read GetAsWideString write SetAsWideString;
154 {$ENDIF}
155 property WideDisplayText: WideString read GetWideDisplayText;
156 property WideText: WideString read GetWideEditText write SetWideEditText;
157 published
158 property EncodingMode: TTntStringFieldEncodingMode read FEncodingMode write FEncodingMode default emUTF8;
159 property FixedCodePageEnum: TTntStringFieldCodePageEnum read GetFixedCodePageEnum write SetFixedCodePageEnum stored False;
160 property FixedCodePage: Word read FFixedCodePage write FFixedCodePage stored IsFixedCodePageStored;
161 property RawVariantAccess: Boolean read FRawVariantAccess write FRawVariantAccess default False;
162 property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
163 property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
164 end;
165
166//======================
167type
168{TNT-WARN TMemoField}
169 TTntMemoField = class(TMemoField{TNT-ALLOW TMemoField}, IWideStringField)
170 private
171 FOnGetText: TFieldGetWideTextEvent;
172 FOnSetText: TFieldSetWideTextEvent;
173 FEncodingMode: TTntStringFieldEncodingMode;
174 FFixedCodePage: Word;
175 FRawVariantAccess: Boolean;
176 procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
177 procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
178 procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
179 procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
180 function GetWideDisplayText: WideString;
181 function GetWideEditText: WideString;
182 procedure SetWideEditText(const Value: WideString);
183 function GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
184 procedure SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
185 function IsFixedCodePageStored: Boolean;
186 protected
187 {$IFDEF COMPILER_10_UP}
188 function GetAsWideString: WideString; override;
189 procedure SetAsWideString(const Value: WideString); override;
190 {$ELSE}
191 function GetAsWideString: WideString; virtual;
192 procedure SetAsWideString(const Value: WideString); virtual;
193 {$ENDIF}
194 function GetAsVariant: Variant; override;
195 procedure SetVarValue(const Value: Variant); override;
196 function GetAsString: string{TNT-ALLOW string}; override;
197 procedure SetAsString(const Value: string{TNT-ALLOW string}); override;
198 public
199 constructor Create(AOwner: TComponent); override;
200 property Value: WideString read GetAsWideString write SetAsWideString;
201 property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
202 property Text: WideString read GetWideEditText write SetWideEditText;
203 {$IFNDEF COMPILER_10_UP}
204 property AsWideString: WideString read GetAsWideString write SetAsWideString;
205 {$ENDIF}
206 property WideDisplayText: WideString read GetWideDisplayText;
207 property WideText: WideString read GetWideEditText write SetWideEditText;
208 published
209 property EncodingMode: TTntStringFieldEncodingMode read FEncodingMode write FEncodingMode default emUTF8;
210 property FixedCodePageEnum: TTntStringFieldCodePageEnum read GetFixedCodePageEnum write SetFixedCodePageEnum stored False;
211 property FixedCodePage: Word read FFixedCodePage write FFixedCodePage stored IsFixedCodePageStored;
212 property RawVariantAccess: Boolean read FRawVariantAccess write FRawVariantAccess default False;
213 property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
214 property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
215 end;
216
217//======================
218function GetTntFieldClass(FieldClass: TFieldClass): TFieldClass;
219
220function GetWideDisplayName(Field: TField): WideString; deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
221function GetWideDisplayLabel(Field: TField): WideString; deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
222procedure SetWideDisplayLabel(Field: TField; const Value: WideString); deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
223
224{TNT-WARN AsString}
225{TNT-WARN DisplayText}
226
227function GetAsWideString(Field: TField): WideString;
228procedure SetAsWideString(Field: TField; const Value: WideString);
229
230function GetWideDisplayText(Field: TField): WideString;
231
232function GetWideText(Field: TField): WideString;
233procedure SetWideText(Field: TField; const Value: WideString);
234
235procedure RegisterTntFields;
236
237{ TTntWideStringField / TTntStringField common handlers }
238procedure TntWideStringField_GetWideText(Field: TField;
239 var Text: WideString; DoDisplayText: Boolean);
240function TntWideStringField_GetWideDisplayText(Field: TField;
241 OnGetText: TFieldGetWideTextEvent): WideString;
242function TntWideStringField_GetWideEditText(Field: TField;
243 OnGetText: TFieldGetWideTextEvent): WideString;
244procedure TntWideStringField_SetWideText(Field: TField;
245 const Value: WideString);
246procedure TntWideStringField_SetWideEditText(Field: TField;
247 OnSetText: TFieldSetWideTextEvent; const Value: WideString);
248
249
250implementation
251
252uses
253 SysUtils, MaskUtils, Variants, Contnrs, TntSystem, TntSysUtils;
254
255function GetTntFieldClass(FieldClass: TFieldClass): TFieldClass;
256begin
257 if FieldClass = TDateTimeField{TNT-ALLOW TDateTimeField} then
258 Result := TTntDateTimeField
259 else if FieldClass = TDateField{TNT-ALLOW TDateField} then
260 Result := TTntDateField
261 else if FieldClass = TTimeField{TNT-ALLOW TTimeField} then
262 Result := TTntTimeField
263 else if FieldClass = TWideStringField{TNT-ALLOW TWideStringField} then
264 Result := TTntWideStringField
265 else if FieldClass = TStringField{TNT-ALLOW TStringField} then
266 Result := TTntStringField
267 else
268 Result := FieldClass;
269end;
270
271function GetWideDisplayName(Field: TField): WideString;
272begin
273 Result := Field.DisplayName;
274end;
275
276function GetWideDisplayLabel(Field: TField): WideString;
277begin
278 Result := Field.DisplayLabel;
279end;
280
281procedure SetWideDisplayLabel(Field: TField; const Value: WideString);
282begin
283 Field.DisplayLabel := Value;
284end;
285
286function GetAsWideString(Field: TField): WideString;
287{$IFDEF COMPILER_10_UP}
288begin
289 if (Field.ClassType = TMemoField{TNT-ALLOW TMemoField}) then
290 Result := VarToWideStr(Field.AsVariant) { works for NexusDB BLOB Wide }
291 else
292 Result := Field.AsWideString
293end;
294{$ELSE}
295var
296 WideField: IWideStringField;
297begin
298 if Field.GetInterface(IWideStringField, WideField) then
299 Result := WideField.AsWideString
300 else if (Field is TWideStringField{TNT-ALLOW TWideStringField}) then
301 begin
302 if Field.IsNull then
303 // This fixes a bug in TWideStringField.GetAsWideString which does not handle Null at all.
304 Result := ''
305 else
306 Result := TWideStringField{TNT-ALLOW TWideStringField}(Field).Value
307 end else if (Field is TMemoField{TNT-ALLOW TMemoField}) then
308 Result := VarToWideStr(Field.AsVariant) { works for NexusDB BLOB Wide }
309 else
310 Result := Field.AsString{TNT-ALLOW AsString};
311end;
312{$ENDIF}
313
314procedure SetAsWideString(Field: TField; const Value: WideString);
315{$IFDEF COMPILER_10_UP}
316begin
317 if (Field.ClassType = TMemoField{TNT-ALLOW TMemoField}) then
318 Field.AsVariant := Value { works for NexusDB BLOB Wide }
319 else
320 Field.AsWideString := Value;
321end;
322{$ELSE}
323var
324 WideField: IWideStringField;
325begin
326 if Field.GetInterface(IWideStringField, WideField) then
327 WideField.AsWideString := Value
328 else if (Field is TWideStringField{TNT-ALLOW TWideStringField}) then
329 TWideStringField{TNT-ALLOW TWideStringField}(Field).Value := Value
330 else if (Field is TMemoField{TNT-ALLOW TMemoField}) then
331 Field.AsVariant := Value { works for NexusDB BLOB Wide }
332 else
333 Field.AsString{TNT-ALLOW AsString} := Value;
334end;
335{$ENDIF}
336
337function GetWideDisplayText(Field: TField): WideString;
338var
339 WideField: IWideStringField;
340begin
341 if Field.GetInterface(IWideStringField, WideField) then
342 Result := WideField.WideDisplayText
343 else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
344 and (not Assigned(Field.OnGetText)) then
345 Result := GetAsWideString(Field)
346 else
347 Result := Field.DisplayText{TNT-ALLOW DisplayText};
348end;
349
350function GetWideText(Field: TField): WideString;
351var
352 WideField: IWideStringField;
353begin
354 if Field.GetInterface(IWideStringField, WideField) then
355 Result := WideField.WideText
356 else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
357 and (not Assigned(Field.OnGetText)) then
358 Result := GetAsWideString(Field)
359 else
360 Result := Field.Text;
361end;
362
363procedure SetWideText(Field: TField; const Value: WideString);
364var
365 WideField: IWideStringField;
366begin
367 if Field.GetInterface(IWideStringField, WideField) then
368 WideField.WideText := Value
369 else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
370 and (not Assigned(Field.OnSetText)) then
371 SetAsWideString(Field, Value)
372 else
373 Field.Text := Value
374end;
375
376{ TTntDateTimeField }
377
378procedure TTntDateTimeField.SetAsString(const Value: AnsiString);
379begin
380 if Value = '' then
381 inherited
382 else
383 SetAsDateTime(TntStrToDateTime(Value));
384end;
385
386{ TTntDateField }
387
388procedure TTntDateField.SetAsString(const Value: AnsiString);
389begin
390 if Value = '' then
391 inherited
392 else
393 SetAsDateTime(TntStrToDate(Value));
394end;
395
396{ TTntTimeField }
397
398procedure TTntTimeField.SetAsString(const Value: AnsiString);
399begin
400 if Value = '' then
401 inherited
402 else
403 SetAsDateTime(TntStrToTime(Value));
404end;
405
406{ TTntWideStringField / TTntStringField common handlers }
407
408procedure TntWideStringField_LegacyGetText(Sender: TField; OnGetText: TFieldGetWideTextEvent;
409 var AnsiText: AnsiString; DoDisplayText: Boolean);
410var
411 WideText: WideString;
412begin
413 if Assigned(OnGetText) then begin
414 WideText := AnsiText;
415 OnGetText(Sender, WideText, DoDisplayText);
416 AnsiText := WideText;
417 end;
418end;
419
420procedure TntWideStringField_LegacySetText(Sender: TField; OnSetText: TFieldSetWideTextEvent;
421 const AnsiText: AnsiString);
422begin
423 if Assigned(OnSetText) then
424 OnSetText(Sender, AnsiText);
425end;
426
427procedure TntWideStringField_GetWideText(Field: TField;
428 var Text: WideString; DoDisplayText: Boolean);
429var
430 WideStringField: IWideStringField;
431begin
432 Field.GetInterface(IWideStringField, WideStringField);
433 Assert(WideStringField <> nil);
434 if DoDisplayText and (Field.EditMaskPtr <> '') then
435 { to gain the mask, we lose Unicode! }
436 Text := FormatMaskText(Field.EditMaskPtr, GetAsWideString(Field))
437 else
438 Text := GetAsWideString(Field);
439end;
440
441function TntWideStringField_GetWideDisplayText(Field: TField;
442 OnGetText: TFieldGetWideTextEvent): WideString;
443begin
444 Result := '';
445 if Assigned(OnGetText) then
446 OnGetText(Field, Result, True)
447 else if Assigned(Field.OnGetText) then
448 Result := Field.DisplayText{TNT-ALLOW DisplayText} {we lose Unicode to handle this event}
449 else
450 TntWideStringField_GetWideText(Field, Result, True);
451end;
452
453function TntWideStringField_GetWideEditText(Field: TField;
454 OnGetText: TFieldGetWideTextEvent): WideString;
455begin
456 Result := '';
457 if Assigned(OnGetText) then
458 OnGetText(Field, Result, False)
459 else if Assigned(Field.OnGetText) then
460 Result := Field.Text {we lose Unicode to handle this event}
461 else
462 TntWideStringField_GetWideText(Field, Result, False);
463end;
464
465procedure TntWideStringField_SetWideText(Field: TField;
466 const Value: WideString);
467{$IFDEF COMPILER_10_UP}
468begin
469 Field.AsWideString := Value;
470end;
471{$ELSE}
472var
473 WideStringField: IWideStringField;
474begin
475 Field.GetInterface(IWideStringField, WideStringField);
476 Assert(WideStringField <> nil);
477 WideStringField.SetAsWideString(Value);
478end;
479{$ENDIF}
480
481procedure TntWideStringField_SetWideEditText(Field: TField;
482 OnSetText: TFieldSetWideTextEvent; const Value: WideString);
483begin
484 if Assigned(OnSetText) then
485 OnSetText(Field, Value)
486 else if Assigned(Field.OnSetText) then
487 Field.Text := Value {we lose Unicode to handle this event}
488 else
489 TntWideStringField_SetWideText(Field, Value);
490end;
491
492{ TTntWideStringField }
493
494{$IFNDEF COMPILER_10_UP}
495function TTntWideStringField.GetAsWideString: WideString;
496begin
497 if not GetData(@Result, False) then
498 Result := ''; {fixes a bug in inherited which has unpredictable results for NULL}
499end;
500{$ENDIF}
501
502procedure TTntWideStringField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
503 DoDisplayText: Boolean);
504begin
505 TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
506end;
507
508procedure TTntWideStringField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
509begin
510 TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
511end;
512
513procedure TTntWideStringField.SetOnGetText(const Value: TFieldGetWideTextEvent);
514begin
515 FOnGetText := Value;
516 if Assigned(OnGetText) then
517 inherited OnGetText := LegacyGetText
518 else
519 inherited OnGetText := nil;
520end;
521
522procedure TTntWideStringField.SetOnSetText(const Value: TFieldSetWideTextEvent);
523begin
524 FOnSetText := Value;
525 if Assigned(OnSetText) then
526 inherited OnSetText := LegacySetText
527 else
528 inherited OnSetText := nil;
529end;
530
531function TTntWideStringField.GetWideDisplayText: WideString;
532begin
533 Result := TntWideStringField_GetWideDisplayText(Self, OnGetText);
534end;
535
536function TTntWideStringField.GetWideEditText: WideString;
537begin
538 Result := TntWideStringField_GetWideEditText(Self, OnGetText);
539end;
540
541procedure TTntWideStringField.SetWideEditText(const Value: WideString);
542begin
543 TntWideStringField_SetWideEditText(Self, OnSetText, Value);
544end;
545
546(* This stuffing method works with CJK codepages - intended to store accented characters in Access 97 *)
547
548function SafeStringToWideStringEx(const S: AnsiString; Codepage: Word): WideString;
549var
550 R: AnsiString;
551 i: Integer;
552begin
553 R := '';
554 i := 1;
555 while i <= Length(S) do
556 begin
557 if (S[i] = #128) then
558 begin
559 Inc(i);
560 if S[i] = #128 then
561 R := R + #128
562 else
563 R := R + Chr(Ord(S[i]) + 128);
564 Inc(i);
565 end
566 else
567 begin
568 R := R + S[I];
569 Inc(i);
570 end;
571 end;
572 Result := StringToWideStringEx(R, CodePage);
573end;
574
575function SafeWideStringToStringEx(const W: WideString; CodePage: Word): AnsiString;
576var
577 TempS: AnsiString;
578 i: integer;
579begin
580 TempS := WideStringToStringEx(W, CodePage);
581 Result := '';
582 for i := 1 to Length(TempS) do
583 begin
584 if TempS[i] > #128 then
585 Result := Result + #128 + Chr(Ord(TempS[i]) - 128)
586 else if TempS[i] = #128 then
587 Result := Result + #128 + #128
588 else
589 Result := Result + TempS[i];
590 end;
591end;
592
593{ TTntStringField }
594
595constructor TTntStringField.Create(AOwner: TComponent);
596begin
597 inherited;
598 FEncodingMode := emUTF8;
599 FFixedCodePage := TntStringFieldCodePageEnumMap[fcpLatinWestern]
600end;
601
602function TTntStringField.GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
603var
604 i: TTntStringFieldCodePageEnum;
605begin
606 Result := fcpOther;
607 for i := Low(TntStringFieldCodePageEnumMap) to High(TntStringFieldCodePageEnumMap) do begin
608 if TntStringFieldCodePageEnumMap[i] = FixedCodePage then begin
609 Result := i;
610 Break; {found it}
611 end;
612 end;
613end;
614
615procedure TTntStringField.SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
616begin
617 if (Value <> fcpOther) then
618 FixedCodePage := TntStringFieldCodePageEnumMap[Value];
619end;
620
621function TTntStringField.GetAsVariant: Variant;
622begin
623 if RawVariantAccess then
624 Result := inherited GetAsVariant
625 else if IsNull then
626 Result := Null
627 else
628 Result := GetAsWideString;
629end;
630
631procedure TTntStringField.SetVarValue(const Value: Variant);
632begin
633 if RawVariantAccess then
634 inherited
635 else
636 SetAsWideString(Value);
637end;
638
639function TTntStringField.GetAsWideString: WideString;
640begin
641 case EncodingMode of
642 emNone: Result := (inherited GetAsString);
643 emUTF8: Result := UTF8ToWideString(inherited GetAsString);
644 emUTF7: try
645 Result := UTF7ToWideString(inherited GetAsString);
646 except
647 Result := inherited GetAsString;
648 end;
649 emFixedCodePage: Result := StringToWideStringEx(inherited GetAsString, FixedCodePage);
650 emFixedCodePage_Safe: Result := SafeStringToWideStringEx(inherited GetAsString, FixedCodePage);
651 else
652 raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
653 end;
654end;
655
656procedure TTntStringField.SetAsWideString(const Value: WideString);
657begin
658 case EncodingMode of
659 emNone: inherited SetAsString(Value);
660 emUTF8: inherited SetAsString(WideStringToUTF8(Value));
661 emUTF7: inherited SetAsString(WideStringToUTF7(Value));
662 emFixedCodePage: inherited SetAsString(WideStringToStringEx(Value, FixedCodePage));
663 emFixedCodePage_Safe: inherited SetAsString(SafeWideStringToStringEx(Value, FixedCodePage));
664 else
665 raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
666 end;
667end;
668
669function TTntStringField.GetAsString: string{TNT-ALLOW string};
670begin
671 if EncodingMode = emNone then
672 Result := inherited GetAsString
673 else
674 Result := GetAsWideString;
675end;
676
677procedure TTntStringField.SetAsString(const Value: string{TNT-ALLOW string});
678begin
679 if EncodingMode = emNone then
680 inherited SetAsString(Value)
681 else
682 SetAsWideString(Value);
683end;
684
685procedure TTntStringField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
686 DoDisplayText: Boolean);
687begin
688 TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
689end;
690
691procedure TTntStringField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
692begin
693 TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
694end;
695
696procedure TTntStringField.SetOnGetText(const Value: TFieldGetWideTextEvent);
697begin
698 FOnGetText := Value;
699 if Assigned(OnGetText) then
700 inherited OnGetText := LegacyGetText
701 else
702 inherited OnGetText := nil;
703end;
704
705procedure TTntStringField.SetOnSetText(const Value: TFieldSetWideTextEvent);
706begin
707 FOnSetText := Value;
708 if Assigned(OnSetText) then
709 inherited OnSetText := LegacySetText
710 else
711 inherited OnSetText := nil;
712end;
713
714function TTntStringField.GetWideDisplayText: WideString;
715begin
716 Result := TntWideStringField_GetWideDisplayText(Self, OnGetText)
717end;
718
719function TTntStringField.GetWideEditText: WideString;
720begin
721 Result := TntWideStringField_GetWideEditText(Self, OnGetText);
722end;
723
724procedure TTntStringField.SetWideEditText(const Value: WideString);
725begin
726 TntWideStringField_SetWideEditText(Self, OnSetText, Value);
727end;
728
729function TTntStringField.IsFixedCodePageStored: Boolean;
730begin
731 Result := EncodingMode = emFixedCodePage;
732end;
733
734//---------------------------------------------------------------------------------------------
735{ TTntMemoField }
736
737constructor TTntMemoField.Create(AOwner: TComponent);
738begin
739 inherited;
740 FEncodingMode := emUTF8;
741 FFixedCodePage := TntStringFieldCodePageEnumMap[fcpLatinWestern]
742end;
743
744function TTntMemoField.GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
745var
746 i: TTntStringFieldCodePageEnum;
747begin
748 Result := fcpOther;
749 for i := Low(TntStringFieldCodePageEnumMap) to High(TntStringFieldCodePageEnumMap) do begin
750 if TntStringFieldCodePageEnumMap[i] = FixedCodePage then begin
751 Result := i;
752 Break; {found it}
753 end;
754 end;
755end;
756
757procedure TTntMemoField.SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
758begin
759 if (Value <> fcpOther) then
760 FixedCodePage := TntStringFieldCodePageEnumMap[Value];
761end;
762
763function TTntMemoField.GetAsVariant: Variant;
764begin
765 if RawVariantAccess then
766 Result := inherited GetAsVariant
767 else if IsNull then
768 Result := Null
769 else
770 Result := GetAsWideString;
771end;
772
773procedure TTntMemoField.SetVarValue(const Value: Variant);
774begin
775 if RawVariantAccess then
776 inherited
777 else
778 SetAsWideString(Value);
779end;
780
781function TTntMemoField.GetAsWideString: WideString;
782begin
783 case EncodingMode of
784 emNone: Result := (inherited GetAsString);
785 emUTF8: Result := UTF8ToWideString(inherited GetAsString);
786 emUTF7: try
787 Result := UTF7ToWideString(inherited GetAsString);
788 except
789 Result := inherited GetAsString;
790 end;
791 emFixedCodePage: Result := StringToWideStringEx(inherited GetAsString, FixedCodePage);
792 emFixedCodePage_Safe: Result := SafeStringToWideStringEx(inherited GetAsString, FixedCodePage);
793 else
794 raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
795 end;
796end;
797
798procedure TTntMemoField.SetAsWideString(const Value: WideString);
799begin
800 case EncodingMode of
801 emNone: inherited SetAsString(Value);
802 emUTF8: inherited SetAsString(WideStringToUTF8(Value));
803 emUTF7: inherited SetAsString(WideStringToUTF7(Value));
804 emFixedCodePage: inherited SetAsString(WideStringToStringEx(Value, FixedCodePage));
805 emFixedCodePage_Safe: inherited SetAsString(SafeWideStringToStringEx(Value, FixedCodePage));
806 else
807 raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
808 end;
809end;
810
811function TTntMemoField.GetAsString: string{TNT-ALLOW string};
812begin
813 if EncodingMode = emNone then
814 Result := inherited GetAsString
815 else
816 Result := GetAsWideString;
817end;
818
819procedure TTntMemoField.SetAsString(const Value: string{TNT-ALLOW string});
820begin
821 if EncodingMode = emNone then
822 inherited SetAsString(Value)
823 else
824 SetAsWideString(Value);
825end;
826
827procedure TTntMemoField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
828 DoDisplayText: Boolean);
829begin
830 TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
831end;
832
833procedure TTntMemoField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
834begin
835 TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
836end;
837
838procedure TTntMemoField.SetOnGetText(const Value: TFieldGetWideTextEvent);
839begin
840 FOnGetText := Value;
841 if Assigned(OnGetText) then
842 inherited OnGetText := LegacyGetText
843 else
844 inherited OnGetText := nil;
845end;
846
847procedure TTntMemoField.SetOnSetText(const Value: TFieldSetWideTextEvent);
848begin
849 FOnSetText := Value;
850 if Assigned(OnSetText) then
851 inherited OnSetText := LegacySetText
852 else
853 inherited OnSetText := nil;
854end;
855
856function TTntMemoField.GetWideDisplayText: WideString;
857begin
858 Result := TntWideStringField_GetWideDisplayText(Self, OnGetText)
859end;
860
861function TTntMemoField.GetWideEditText: WideString;
862begin
863 Result := TntWideStringField_GetWideEditText(Self, OnGetText);
864end;
865
866procedure TTntMemoField.SetWideEditText(const Value: WideString);
867begin
868 TntWideStringField_SetWideEditText(Self, OnSetText, Value);
869end;
870
871function TTntMemoField.IsFixedCodePageStored: Boolean;
872begin
873 Result := EncodingMode = emFixedCodePage;
874end;
875//==================================================================
876procedure RegisterTntFields;
877begin
878 RegisterFields([TTntDateTimeField]);
879 RegisterFields([TTntDateField]);
880 RegisterFields([TTntTimeField]);
881 RegisterFields([TTntWideStringField]);
882 RegisterFields([TTntStringField]);
883 RegisterFields([TTntMemoField]);
884end;
885
886type PFieldClass = ^TFieldClass;
887
888initialization
889{$IFDEF TNT_FIELDS}
890 PFieldClass(@DefaultFieldClasses[ftDate])^ := TTntDateField;
891 PFieldClass(@DefaultFieldClasses[ftTime])^ := TTntTimeField;
892 PFieldClass(@DefaultFieldClasses[ftDateTime])^ := TTntDateTimeField;
893 PFieldClass(@DefaultFieldClasses[ftWideString])^ := TTntWideStringField;
894 PFieldClass(@DefaultFieldClasses[ftString])^ := TTntStringField;
895 PFieldClass(@DefaultFieldClasses[ftFixedChar])^ := TTntStringField;
896{$ENDIF}
897
898finalization
899
900end.
Note: See TracBrowser for help on using the repository browser.