tntdb.pas

TNTUniCtrlsWithExceptions UniCode 国际化语言

var
  i: TTntStringFieldCodePageEnum;
begin
  Result := fcpOther;
  for i := Low(TntStringFieldCodePageEnumMap) to High(TntStringFieldCodePageEnumMap) do begin
    if TntStringFieldCodePageEnumMap[i] = FixedCodePage then begin
      Result := i;
      Break; {found it}
    end;
  end;
end;

procedure TTntStringField.SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
begin
  if (Value <> fcpOther) then
    FixedCodePage := TntStringFieldCodePageEnumMap[Value];
end;

function TTntStringField.GetAsVariant: Variant;
begin
  if RawVariantAccess then
    Result := inherited GetAsVariant
  else if IsNull then
    Result := Null
  else
    Result := GetAsWideString;
end;

procedure TTntStringField.SetVarValue(const Value: Variant);
begin
  if RawVariantAccess then
    inherited
  else
    SetAsWideString(Value);
end;

function TTntStringField.GetAsWideString: WideString;
begin
  case EncodingMode of
    emNone:               Result := (inherited GetAsString);
    emUTF8:               Result := UTF8ToWideString(inherited GetAsString);
    emUTF7:             try
                          Result := UTF7ToWideString(inherited GetAsString);
                        except
                          Result := inherited GetAsString;
                        end;
    emFixedCodePage:      Result := StringToWideStringEx(inherited GetAsString, FixedCodePage);
    emFixedCodePage_Safe: Result := SafeStringToWideStringEx(inherited GetAsString, FixedCodePage);
    else
      raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
  end;
end;

procedure TTntStringField.SetAsWideString(const Value: WideString);
begin
  case EncodingMode of
    emNone:               inherited SetAsString(Value);
    emUTF8:               inherited SetAsString(WideStringToUTF8(Value));
    emUTF7:               inherited SetAsString(WideStringToUTF7(Value));
    emFixedCodePage:      inherited SetAsString(WideStringToStringEx(Value, FixedCodePage));
    emFixedCodePage_Safe: inherited SetAsString(SafeWideStringToStringEx(Value, FixedCodePage));
    else
      raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
  end;
end;

function TTntStringField.GetAsString: string{TNT-ALLOW string};
begin
  if EncodingMode = emNone then
    Result := inherited GetAsString
  else
    Result := GetAsWideString;
end;

procedure TTntStringField.SetAsString(const Value: string{TNT-ALLOW string});
begin
  if EncodingMode = emNone then
    inherited SetAsString(Value)
  else
    SetAsWideString(Value);
end;

procedure TTntStringField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
  DoDisplayText: Boolean);
begin
  TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
end;

procedure TTntStringField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
begin
  TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
end;

procedure TTntStringField.SetOnGetText(const Value: TFieldGetWideTextEvent);
begin
  FOnGetText := Value;
  if Assigned(OnGetText) then
    inherited OnGetText := LegacyGetText
  else
    inherited OnGetText := nil;
end;

procedure TTntStringField.SetOnSetText(const Value: TFieldSetWideTextEvent);
begin
  FOnSetText := Value;
  if Assigned(OnSetText) then
    inherited OnSetText := LegacySetText
  else
    inherited OnSetText := nil;
end;

function TTntStringField.GetWideDisplayText: WideString;
begin
  Result := TntWideStringField_GetWideDisplayText(Self, OnGetText)
end;

function TTntStringField.GetWideEditText: WideString;
begin
  Result := TntWideStringField_GetWideEditText(Self, OnGetText);
end;

procedure TTntStringField.SetWideEditText(const Value: WideString);
begin
  TntWideStringField_SetWideEditText(Self, OnSetText, Value);
end;

function TTntStringField.IsFixedCodePageStored: Boolean;
begin
  Result := EncodingMode = emFixedCodePage;
end;

//---------------------------------------------------------------------------------------------
{ TTntMemoField }

constructor TTntMemoField.Create(AOwner: TComponent);
begin
  inherited;
  FEncodingMode := emUTF8;
  FFixedCodePage := TntStringFieldCodePageEnumMap[fcpLatinWestern]
end;

function TTntMemoField.GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
var
  i: TTntStringFieldCodePageEnum;
begin
  Result := fcpOther;
  for i := Low(TntStringFieldCodePageEnumMap) to High(TntStringFieldCodePageEnumMap) do begin
    if TntStringFieldCodePageEnumMap[i] = FixedCodePage then begin
      Result := i;
      Break; {found it}
    end;
  end;
end;

procedure TTntMemoField.SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
begin
  if (Value <> fcpOther) then
    FixedCodePage := TntStringFieldCodePageEnumMap[Value];
end;

function TTntMemoField.GetAsVariant: Variant;
begin
  if RawVariantAccess then
    Result := inherited GetAsVariant
  else if IsNull then
    Result := Null
  else
    Result := GetAsWideString;
end;

procedure TTntMemoField.SetVarValue(const Value: Variant);
begin
  if RawVariantAccess then
    inherited
  else
    SetAsWideString(Value);
end;

function TTntMemoField.GetAsWideString: WideString;
begin
  case EncodingMode of
    emNone:               Result := (inherited GetAsString);
    emUTF8:               Result := UTF8ToWideString(inherited GetAsString);
    emUTF7:             try
                          Result := UTF7ToWideString(inherited GetAsString);
                        except
                          Result := inherited GetAsString;
                        end;
    emFixedCodePage:      Result := StringToWideStringEx(inherited GetAsString, FixedCodePage);
    emFixedCodePage_Safe: Result := SafeStringToWideStringEx(inherited GetAsString, FixedCodePage);
    else
      raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
  end;
end;

procedure TTntMemoField.SetAsWideString(const Value: WideString);
begin
  case EncodingMode of
    emNone:               inherited SetAsString(Value);
    emUTF8:               inherited SetAsString(WideStringToUTF8(Value));
    emUTF7:               inherited SetAsString(WideStringToUTF7(Value));
    emFixedCodePage:      inherited SetAsString(WideStringToStringEx(Value, FixedCodePage));
    emFixedCodePage_Safe: inherited SetAsString(SafeWideStringToStringEx(Value, FixedCodePage));
    else
      raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
  end;
end;

function TTntMemoField.GetAsString: string{TNT-ALLOW string};
begin
  if EncodingMode = emNone then
    Result := inherited GetAsString
  else
    Result := GetAsWideString;
end;

procedure TTntMemoField.SetAsString(const Value: string{TNT-ALLOW string});
begin
  if EncodingMode = emNone then
    inherited SetAsString(Value)
  else
    SetAsWideString(Value);
end;

procedure TTntMemoField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
  DoDisplayText: Boolean);
begin
  TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
end;

procedure TTntMemoField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
begin
  TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
end;

procedure TTntMemoField.SetOnGetText(const Value: TFieldGetWideTextEvent);
begin
  FOnGetText := Value;
  if Assigned(OnGetText) then
    inherited OnGetText := LegacyGetText
  else
    inherited OnGetText := nil;
end;

procedure TTntMemoField.SetOnSetText(const Value: TFieldSetWideTextEvent);
begin
  FOnSetText := Value;
  if Assigned(OnSetText) then
    inherited OnSetText := LegacySetText
  else
    inherited OnSetText := nil;
end;

function TTntMemoField.GetWideDisplayText: WideString;
begin
  Result := TntWideStringField_GetWideDisplayText(Self, OnGetText)
end;

function TTntMemoField.GetWideEditText: WideString;
begin
  Result := TntWideStringField_GetWideEditText(Self, OnGetText);
end;

procedure TTntMemoField.SetWideEditText(const Value: WideString);
begin
  TntWideStringField_SetWideEditText(Self, OnSetText, Value);
end;

function TTntMemoField.IsFixedCodePageStored: Boolean;
begin
  Result := EncodingMode = emFixedCodePage;
end;
//==================================================================
procedure RegisterTntFields;
begin
  RegisterFields([TTntDateTimeField]);
  RegisterFields([TTntDateField]);
  RegisterFields([TTntTimeField]);
  RegisterFields([TTntWideStringField]);
  RegisterFields([TTntStringField]);
  RegisterFields([TTntMemoField]);
end;

type PFieldClass = ^TFieldClass;

initialization
{$IFDEF TNT_FIELDS}
  PFieldClass(@DefaultFieldClasses[ftDate])^ := TTntDateField;
  PFieldClass(@DefaultFieldClasses[ftTime])^ := TTntTimeField;
  PFieldClass(@DefaultFieldClasses[ftDateTime])^ := TTntDateTimeField;
  PFieldClass(@DefaultFieldClasses[ftWideString])^ := TTntWideStringField;
  PFieldClass(@DefaultFieldClasses[ftString])^ := TTntStringField;
  PFieldClass(@DefaultFieldClasses[ftFixedChar])^ := TTntStringField;
{$ENDIF}

finalization

end.