source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntDB.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

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.