tntdb.pas

TNT Components Source

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink ([e-mail])       }
{                                                                             }
{*****************************************************************************}

unit TntDB;

{$INCLUDE TntCompilers.inc}

interface

uses
  Classes, DB;

type
{TNT-WARN TDateTimeField}
  TTntDateTimeField = class(TDateTimeField{TNT-ALLOW TDateTimeField})
  protected
    procedure SetAsString(const Value: AnsiString); override;
  end;

{TNT-WARN TDateField}
  TTntDateField = class(TDateField{TNT-ALLOW TDateField})
  protected
    procedure SetAsString(const Value: AnsiString); override;
  end;

{TNT-WARN TTimeField}
  TTntTimeField = class(TTimeField{TNT-ALLOW TTimeField})
  protected
    procedure SetAsString(const Value: AnsiString); override;
  end;

  TFieldGetWideTextEvent = procedure(Sender: TField; var Text: WideString;
    DoDisplayText: Boolean) of object;
  TFieldSetWideTextEvent = procedure(Sender: TField; const Text: WideString) of object;

  IWideStringField = interface
    ['{679C5F1A-4356-4696-A8F3-9C7C6970A9F6}']
    {$IFNDEF COMPILER_10_UP}
    function GetAsWideString: WideString;
    procedure SetAsWideString(const Value: WideString);
    {$ENDIF}
    function GetWideDisplayText: WideString;
    function GetWideEditText: WideString;
    procedure SetWideEditText(const Value: WideString);
    //--
    {$IFNDEF COMPILER_10_UP}
    property AsWideString: WideString read GetAsWideString write SetAsWideString{inherited};
    {$ENDIF}
    property WideDisplayText: WideString read GetWideDisplayText;
    property WideText: WideString read GetWideEditText write SetWideEditText;
  end;

{TNT-WARN TWideStringField}
  TTntWideStringField = class(TWideStringField{TNT-ALLOW TWideStringField}, IWideStringField)
  private
    FOnGetText: TFieldGetWideTextEvent;
    FOnSetText: TFieldSetWideTextEvent;
    procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
    procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
    procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
    procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
    function GetWideDisplayText: WideString;
    function GetWideEditText: WideString;
    procedure SetWideEditText(const Value: WideString);
  protected
    {$IFNDEF COMPILER_10_UP}
    function GetAsWideString: WideString;
    {$ENDIF}
  public
    property Value: WideString read GetAsWideString write SetAsWideString;
    property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
    property Text: WideString read GetWideEditText write SetWideEditText;
    {$IFNDEF COMPILER_10_UP}
    property AsWideString: WideString read GetAsWideString write SetAsWideString;
    {$ENDIF}
    property WideDisplayText: WideString read GetWideDisplayText;
    property WideText: WideString read GetWideEditText write SetWideEditText;
  published
    property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
    property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
  end;

  TTntStringFieldEncodingMode = (emNone, emUTF8, emUTF7, emFixedCodePage, emFixedCodePage_Safe);

  //-------------------------------------------------------------------------------------------
  // Comments on TTntStringFieldEncodingMode:
  //
  //  emNone               - Works like TStringField.
  //  emUTF8               - Should work well most databases.
  //  emUTF7               - Almost guaranteed to work with any database. Wasteful in database space.
  //  emFixedCodePage      - Only tested it with Access 97, which doesn't support Unicode.
  //  emFixedCodePage_Safe - Like emFixedCodePage but uses char<=#128.  Wasteful in database space.
  //
  //  Only emUTF8 and emUTF7 fully support Unicode.
  //-------------------------------------------------------------------------------------------

  TTntStringFieldCodePageEnum = (fcpOther,
    fcpThai, fcpJapanese, fcpSimplifiedChinese, fcpTraditionalChinese, fcpKorean,
    fcpCentralEuropean, fcpCyrillic, fcpLatinWestern, fcpGreek, fcpTurkish,
    fcpHebrew, fcpArabic, fcpBaltic, fcpVietnamese);

const
  TntStringFieldCodePageEnumMap: array[TTntStringFieldCodePageEnum] of Word = (0,
    874, 932, 936, 950, 949,
    1250, 1251, 1252, 1253, 1254,
    1255, 1256, 1257, 1258);

type
{TNT-WARN TStringField}
  TTntStringField = class(TStringField{TNT-ALLOW TStringField},IWideStringField)
  private
    FOnGetText: TFieldGetWideTextEvent;
    FOnSetText: TFieldSetWideTextEvent;
    FEncodingMode: TTntStringFieldEncodingMode;
    FFixedCodePage: Word;
    FRawVariantAccess: Boolean;
    procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
    procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
    procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
    procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
    function GetWideDisplayText: WideString;
    function GetWideEditText: WideString;
    procedure SetWideEditText(const Value: WideString);
    function GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
    procedure SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
    function IsFixedCodePageStored: Boolean;
  protected
    {$IFDEF COMPILER_10_UP}
    function GetAsWideString: WideString; override;
    procedure SetAsWideString(const Value: WideString); override;
    {$ELSE}
    function GetAsWideString: WideString; virtual;
    procedure SetAsWideString(const Value: WideString); virtual;
    {$ENDIF}
    function GetAsVariant: Variant; override;
    procedure SetVarValue(const Value: Variant); override;
    function GetAsString: string{TNT-ALLOW string}; override;
    procedure SetAsString(const Value: string{TNT-ALLOW string}); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Value: WideString read GetAsWideString write SetAsWideString;
    property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
    property Text: WideString read GetWideEditText write SetWideEditText;
    {$IFNDEF COMPILER_10_UP}
    property AsWideString: WideString read GetAsWideString write SetAsWideString;
    {$ENDIF}
    property WideDisplayText: WideString read GetWideDisplayText;
    property WideText: WideString read GetWideEditText write SetWideEditText;
  published
    property EncodingMode: TTntStringFieldEncodingMode read FEncodingMode write FEncodingMode default emUTF8;
    property FixedCodePageEnum: TTntStringFieldCodePageEnum read GetFixedCodePageEnum write SetFixedCodePageEnum stored False;
    property FixedCodePage: Word read FFixedCodePage write FFixedCodePage stored IsFixedCodePageStored;
    property RawVariantAccess: Boolean read FRawVariantAccess write FRawVariantAccess default False;
    property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
    property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
  end;

//======================
type
{TNT-WARN TMemoField}
  TTntMemoField = class(TMemoField{TNT-ALLOW TMemoField}, IWideStringField)
  private
    FOnGetText: TFieldGetWideTextEvent;
    FOnSetText: TFieldSetWideTextEvent;
    FEncodingMode: TTntStringFieldEncodingMode;
    FFixedCodePage: Word;
    FRawVariantAccess: Boolean;
    procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
    procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
    procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
    procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
    function GetWideDisplayText: WideString;
    function GetWideEditText: WideString;
    procedure SetWideEditText(const Value: WideString);
    function GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
    procedure SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
    function IsFixedCodePageStored: Boolean;
  protected
    {$IFDEF COMPILER_10_UP}
    function GetAsWideString: WideString; override;
    procedure SetAsWideString(const Value: WideString); override;
    {$ELSE}
    function GetAsWideString: WideString; virtual;
    procedure SetAsWideString(const Value: WideString); virtual;
    {$ENDIF}
    function GetAsVariant: Variant; override;
    procedure SetVarValue(const Value: Variant); override;
    function GetAsString: string{TNT-ALLOW string}; override;
    procedure SetAsString(const Value: string{TNT-ALLOW string}); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Value: WideString read GetAsWideString write SetAsWideString;
    property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
    property Text: WideString read GetWideEditText write SetWideEditText;
    {$IFNDEF COMPILER_10_UP}
    property AsWideString: WideString read GetAsWideString write SetAsWideString;
    {$ENDIF}
    property WideDisplayText: WideString read GetWideDisplayText;
    property WideText: WideString read GetWideEditText write SetWideEditText;
  published
    property EncodingMode: TTntStringFieldEncodingMode read FEncodingMode write FEncodingMode default emUTF8;
    property FixedCodePageEnum: TTntStringFieldCodePageEnum read GetFixedCodePageEnum write SetFixedCodePageEnum stored False;
    property FixedCodePage: Word read FFixedCodePage write FFixedCodePage stored IsFixedCodePageStored;
    property RawVariantAccess: Boolean read FRawVariantAccess write FRawVariantAccess default False;
    property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
    property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
  end;

//======================
function GetTntFieldClass(FieldClass: TFieldClass): TFieldClass;

function GetWideDisplayName(Field: TField): WideString; deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
function GetWideDisplayLabel(Field: TField): WideString; deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
procedure SetWideDisplayLabel(Field: TField; const Value: WideString); deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer

{TNT-WARN AsString}
{TNT-WARN DisplayText}

function GetAsWideString(Field: TField): WideString;
procedure SetAsWideString(Field: TField; const Value: WideString);

function GetWideDisplayText(Field: TField): WideString;

function GetWideText(Field: TField): WideString;
procedure SetWideText(Field: TField; const Value: WideString);

procedure RegisterTntFields;

{ TTntWideStringField / TTntStringField common handlers }
procedure TntWideStringField_GetWideText(Field: TField;
  var Text: WideString; DoDisplayText: Boolean);
function TntWideStringField_GetWideDisplayText(Field: TField;
  OnGetText: TFieldGetWideTextEvent): WideString;
function TntWideStringField_GetWideEditText(Field: TField;
  OnGetText: TFieldGetWideTextEvent): WideString;
procedure TntWideStringField_SetWideText(Field: TField;
  const Value: WideString);
procedure TntWideStringField_SetWideEditText(Field: TField;
  OnSetText: TFieldSetWideTextEvent; const Value: WideString);


implementation

uses
  SysUtils, MaskUtils, Variants, Contnrs, TntSystem, TntSysUtils;

function GetTntFieldClass(FieldClass: TFieldClass): TFieldClass;
begin
  if FieldClass = TDateTimeField{TNT-ALLOW TDateTimeField} then
    Result := TTntDateTimeField
  else if FieldClass = TDateField{TNT-ALLOW TDateField} then
    Result := TTntDateField
  else if FieldClass = TTimeField{TNT-ALLOW TTimeField} then
    Result := TTntTimeField
  else if FieldClass = TWideStringField{TNT-ALLOW TWideStringField} then
    Result := TTntWideStringField
  else if FieldClass = TStringField{TNT-ALLOW TStringField} then
    Result := TTntStringField
  else
    Result := FieldClass;
end;

function GetWideDisplayName(Field: TField): WideString;
begin
  Result := Field.DisplayName;
end;

function GetWideDisplayLabel(Field: TField): WideString;
begin
  Result := Field.DisplayLabel;
end;

procedure SetWideDisplayLabel(Field: TField; const Value: WideString);
begin
  Field.DisplayLabel := Value;
end;

function GetAsWideString(Field: TField): WideString;
{$IFDEF COMPILER_10_UP}
begin
  if (Field.ClassType = TMemoField{TNT-ALLOW TMemoField}) then
    Result := VarToWideStr(Field.AsVariant) { works for NexusDB BLOB Wide }
  else
    Result := Field.AsWideString
end;
{$ELSE}
var
  WideField: IWideStringField;
begin
  if Field.GetInterface(IWideStringField, WideField) then
    Result := WideField.AsWideString
  else if (Field is TWideStringField{TNT-ALLOW TWideStringField}) then
  begin