[sword-svn] r435 - in trunk: . TntUnicodeControls TntUnicodeControls/BCB5 stage
scribe at crosswire.org
scribe at crosswire.org
Sun Jul 30 20:46:25 MST 2006
Author: scribe
Date: 2006-07-30 20:46:13 -0700 (Sun, 30 Jul 2006)
New Revision: 435
Added:
trunk/TntUnicodeControls/TntAxCtrls.pas
trunk/TntUnicodeControls/TntClipBrd.pas
trunk/TntUnicodeControls/TntCompilers.inc
trunk/TntUnicodeControls/TntDB.pas
trunk/TntUnicodeControls/TntDBActns.pas
trunk/TntUnicodeControls/TntDBGrids.pas
trunk/TntUnicodeControls/TntDBLogDlg.dfm
trunk/TntUnicodeControls/TntDBLogDlg.pas
trunk/TntUnicodeControls/TntDbCtrls.pas
trunk/TntUnicodeControls/TntDialogs.pas
trunk/TntUnicodeControls/TntExtDlgs.pas
trunk/TntUnicodeControls/TntFormatStrUtils.pas
trunk/TntUnicodeControls/TntRegistry.pas
trunk/TntUnicodeControls/TntSysUtils.pas
trunk/TntUnicodeControls/TntSystem.pas
trunk/TntUnicodeControls/TntTypInfo.pas
trunk/TntUnicodeControls/TntWindows.pas
Removed:
trunk/TntUnicodeControls/Compilers.inc
Modified:
trunk/TntUnicodeControls/BCB5/TntLibR.bpk
trunk/stage/layout.conf
trunk/sword.bpr
trunk/sword.res
Log:
Added new files needed for the update of the Tnt Unicode package
Modified: trunk/TntUnicodeControls/BCB5/TntLibR.bpk
===================================================================
--- trunk/TntUnicodeControls/BCB5/TntLibR.bpk 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/BCB5/TntLibR.bpk 2006-07-31 03:46:13 UTC (rev 435)
@@ -26,7 +26,7 @@
<DEBUGLIBPATH value="$(BCB)\lib\debug"/>
<RELEASELIBPATH value="$(BCB)\lib\release"/>
<LINKER value="tlink32"/>
- <USERDEFINES value="_DEBUG"/>
+ <USERDEFINES value=""/>
<SYSDEFINES value="_RTLDLL;NO_STRICT;USEPACKAGES"/>
<MAINSOURCE value="TntLibR.cpp"/>
<INCLUDEPATH value="..\;..;$(BCB)\include;$(BCB)\include\vcl"/>
@@ -34,13 +34,12 @@
<WARNINGS value="-w-par"/>
</MACROS>
<OPTIONS>
- <CFLAG1 value="-Od -H=$(BCB)\lib\vcl50.csm -Hc -Vx -Ve -X- -r- -a8 -b- -k -y -v -vi- -c
- -tWM"/>
- <PFLAGS value="-$YD -$W -$O- -v -JPHNE -M"/>
+ <CFLAG1 value="-O2 -H=$(BCB)\lib\vcl50.csm -Hc -Vx -Ve -X- -a8 -b- -k- -vi -c -tWM"/>
+ <PFLAGS value="-$Y- -$L- -$D- -v -JPHNE -M"/>
<RFLAGS value=""/>
- <AFLAGS value="/mx /w2 /zd"/>
+ <AFLAGS value="/mx /w2 /zn"/>
<LFLAGS value="-D"Tnt Unicode VCL Components for BCB5 (Runtime)" -aa -Tpp -Gpr -x -Gn -Gl
- -Gi -v"/>
+ -Gi"/>
</OPTIONS>
<LINKER>
<ALLOBJ value="c0pkg32.obj $(PACKAGES) Memmgr.Lib sysinit.obj $(OBJFILES)"/>
Deleted: trunk/TntUnicodeControls/Compilers.inc
===================================================================
--- trunk/TntUnicodeControls/Compilers.inc 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/Compilers.inc 2006-07-31 03:46:13 UTC (rev 435)
@@ -1,269 +0,0 @@
-//----------------------------------------------------------------------------------------------------------------------
-// Include file to determine which compiler is currently being used to build the project/component.
-// This file uses ideas from Brad Stowers DFS.inc file (www.delphifreestuff.com).
-//
-// Portions created by Mike Lischke are Copyright
-// (C) 1999-2002 Dipl. Ing. Mike Lischke. All Rights Reserved.
-//----------------------------------------------------------------------------------------------------------------------
-// The following symbols are defined:
-//
-// COMPILER_1 : Kylix/Delphi/BCB 1.x is the compiler.
-// COMPILER_1_UP : Kylix/Delphi/BCB 1.x or higher is the compiler.
-// COMPILER_2 : Kylix/Delphi 2.x or BCB 1.x is the compiler.
-// COMPILER_2_UP : Kylix/Delphi 2.x or higher, or BCB 1.x or higher is the compiler.
-// COMPILER_3 : Kylix/Delphi/BCB 3.x is the compiler.
-// COMPILER_3_UP : Kylix/Delphi/BCB 3.x or higher is the compiler.
-// COMPILER_4 : Kylix/Delphi/BCB 4.x is the compiler.
-// COMPILER_4_UP : Kylix/Delphi/BCB 4.x or higher is the compiler.
-// COMPILER_5 : Kylix/Delphi/BCB 5.x is the compiler.
-// COMPILER_5_UP : Kylix/Delphi/BCB 5.x or higher is the compiler.
-// COMPILER_6 : Kylix/Delphi/BCB 6.x is the compiler.
-// COMPILER_6_UP : Kylix/Delphi/BCB 6.x or higher is the compiler.
-// COMPILER_7 : Kylix/Delphi/BCB 7.x is the compiler.
-// COMPILER_7_UP : Kylix/Delphi/BCB 7.x or higher is the compiler.
-//
-// Only defined if Windows is the target:
-// CPPB : Any version of BCB is being used.
-// CPPB_1 : BCB v1.x is being used.
-// CPPB_3 : BCB v3.x is being used.
-// CPPB_3_UP : BCB v3.x or higher is being used.
-// CPPB_4 : BCB v4.x is being used.
-// CPPB_4_UP : BCB v4.x or higher is being used.
-// CPPB_5 : BCB v5.x is being used.
-// CPPB_5_UP : BCB v5.x or higher is being used.
-//
-// Only defined if Windows is the target:
-// DELPHI : Any version of Delphi is being used.
-// DELPHI_1 : Delphi v1.x is being used.
-// DELPHI_2 : Delphi v2.x is being used.
-// DELPHI_2_UP : Delphi v2.x or higher is being used.
-// DELPHI_3 : Delphi v3.x is being used.
-// DELPHI_3_UP : Delphi v3.x or higher is being used.
-// DELPHI_4 : Delphi v4.x is being used.
-// DELPHI_4_UP : Delphi v4.x or higher is being used.
-// DELPHI_5 : Delphi v5.x is being used.
-// DELPHI_5_UP : Delphi v5.x or higher is being used.
-// DELPHI_6 : Delphi v6.x is being used.
-// DELPHI_6_UP : Delphi v6.x or higher is being used.
-// DELPHI_7 : Delphi v7.x is being used.
-// DELPHI_7_UP : Delphi v7.x or higher is being used.
-//
-// Only defined if Linux is the target:
-// KYLIX : Any version of Kylix is being used.
-// KYLIX_1 : Kylix 1.x is being used.
-// KYLIX_1_UP : Kylix 1.x or higher is being used.
-// KYLIX_2 : Kylix 2.x is being used.
-// KYLIX_2_UP : Kylix 2.x or higher is being used.
-// KYLIX_3 : Kylix 3.x is being used.
-// KYLIX_3_UP : Kylix 3.x or higher is being used.
-//
-// Only defined if Linux is the target:
-// QT_CLX : Trolltech's QT library is being used.
-//----------------------------------------------------------------------------------------------------------------------
-
-{$ifdef Win32}
- {$ifdef VER150}
- {$define COMPILER_7}
- {$define DELPHI}
- {$define DELPHI_7}
- {$endif}
-
- {$ifdef VER140}
- {$define COMPILER_6}
- {$define DELPHI}
- {$define DELPHI_6}
- {$endif}
-
- {$ifdef VER130}
- {$define COMPILER_5}
- {$ifdef BCB}
- {$define CPPB}
- {$define CPPB_5}
- {$else}
- {$define DELPHI}
- {$define DELPHI_5}
- {$endif}
- {$endif}
-
- {$ifdef VER125}
- {$define COMPILER_4}
- {$define CPPB}
- {$define CPPB_4}
- {$endif}
-
- {$ifdef VER120}
- {$define COMPILER_4}
- {$define DELPHI}
- {$define DELPHI_4}
- {$endif}
-
- {$ifdef VER110}
- {$define COMPILER_3}
- {$define CPPB}
- {$define CPPB_3}
- {$endif}
-
- {$ifdef VER100}
- {$define COMPILER_3}
- {$define DELPHI}
- {$define DELPHI_3}
- {$endif}
-
- {$ifdef VER93}
- {$define COMPILER_2} // C++ Builder v1 compiler is really v2
- {$define CPPB}
- {$define CPPB_1}
- {$endif}
-
- {$ifdef VER90}
- {$define COMPILER_2}
- {$define DELPHI}
- {$define DELPHI_2}
- {$endif}
-
- {$ifdef VER80}
- {$define COMPILER_1}
- {$define DELPHI}
- {$define DELPHI_1}
- {$endif}
-
- {$ifdef DELPHI_2}
- {$define DELPHI_2_UP}
- {$endif}
-
- {$ifdef DELPHI_3}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$endif}
-
- {$ifdef DELPHI_4}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$endif}
-
- {$ifdef DELPHI_5}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$endif}
-
- {$ifdef DELPHI_6}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$define DELPHI_6_UP}
- {$endif}
-
- {$ifdef DELPHI_7}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$define DELPHI_6_UP}
- {$define DELPHI_7_UP}
- {$endif}
-
- {$ifdef CPPB_3}
- {$define CPPB_3_UP}
- {$endif}
-
- {$ifdef CPPB_4}
- {$define CPPB_3_UP}
- {$define CPPB_4_UP}
- {$endif}
-
- {$ifdef CPPB_5}
- {$define CPPB_3_UP}
- {$define CPPB_4_UP}
- {$define CPPB_5_UP}
- {$endif}
-
- {$ifdef CPPB_3_UP}
- // C++ Builder requires this if you use Delphi components in run-time packages.
- {$ObjExportAll On}
- {$endif}
-
-{$else (not Windows)}
- // Linux is the target
- {$define QT_CLX}
-
- {$define KYLIX}
- {$define KYLIX_1}
- {$define KYLIX_1_UP}
-
- {$ifdef VER150}
- {$define COMPILER_7}
- {$define KYLIX_3}
- {$endif}
-
- {$ifdef VER140}
- {$define COMPILER_6}
- {$define KYLIX_2}
- {$endif}
-
- {$ifdef KYLIX_2}
- {$define KYLIX_2_UP}
- {$endif}
-
- {$ifdef KYLIX_3}
- {$define KYLIX_2_UP}
- {$define KYLIX_3_UP}
- {$endif}
-
-{$endif}
-
-// Compiler defines common to all platforms.
-{$ifdef COMPILER_1}
- {$define COMPILER_1_UP}
-{$endif}
-
-{$ifdef COMPILER_2}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
-{$endif}
-
-{$ifdef COMPILER_3}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
-{$endif}
-
-{$ifdef COMPILER_4}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
-{$endif}
-
-{$ifdef COMPILER_5}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
-{$endif}
-
-{$ifdef COMPILER_6}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
- {$define COMPILER_6_UP}
-{$endif}
-
-{$ifdef COMPILER_7}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
- {$define COMPILER_6_UP}
- {$define COMPILER_7_UP}
-{$endif}
-
-//----------------------------------------------------------------------------------------------------------------------
-
Added: trunk/TntUnicodeControls/TntAxCtrls.pas
===================================================================
--- trunk/TntUnicodeControls/TntAxCtrls.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntAxCtrls.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,185 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntAxCtrls;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ ComObj, StdVcl, AxCtrls, TntClasses;
+
+type
+ TWideStringsAdapter = class(TAutoIntfObject, IStrings, IWideStringsAdapter)
+ private
+ FStrings: TTntStrings;
+ protected
+ { IWideStringsAdapter }
+ procedure ReferenceStrings(S: TTntStrings);
+ procedure ReleaseStrings;
+ { IStrings }
+ function Get_ControlDefault(Index: Integer): OleVariant; safecall;
+ procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
+ function Count: Integer; safecall;
+ function Get_Item(Index: Integer): OleVariant; safecall;
+ procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
+ procedure Remove(Index: Integer); safecall;
+ procedure Clear; safecall;
+ function Add(Item: OleVariant): Integer; safecall;
+ function _NewEnum: IUnknown; safecall;
+ public
+ constructor Create(Strings: TTntStrings);
+ end;
+
+implementation
+
+uses
+ Classes, {$IFDEF COMPILER_6_UP} Variants, {$ELSE} Windows, {$ENDIF} ActiveX;
+
+{ TStringsEnumerator }
+
+type
+ TStringsEnumerator = class(TContainedObject, IEnumString)
+ private
+ FIndex: Integer; // index of next unread string
+ FStrings: IStrings;
+ public
+ constructor Create(const Strings: IStrings);
+ function Next(celt: Longint; out elt;
+ pceltFetched: PLongint): HResult; stdcall;
+ function Skip(celt: Longint): HResult; stdcall;
+ function Reset: HResult; stdcall;
+ function Clone(out enm: IEnumString): HResult; stdcall;
+ end;
+
+constructor TStringsEnumerator.Create(const Strings: IStrings);
+begin
+ inherited Create(Strings);
+ FStrings := Strings;
+end;
+
+function TStringsEnumerator.Next(celt: Longint; out elt; pceltFetched: PLongint): HResult;
+var
+ I: Integer;
+begin
+ I := 0;
+ while (I < celt) and (FIndex < FStrings.Count) do
+ begin
+ TPointerList(elt)[I] := PWideChar(WideString(FStrings.Item[FIndex]));
+ Inc(I);
+ Inc(FIndex);
+ end;
+ if pceltFetched <> nil then pceltFetched^ := I;
+ if I = celt then Result := S_OK else Result := S_FALSE;
+end;
+
+function TStringsEnumerator.Skip(celt: Longint): HResult;
+begin
+ if (FIndex + celt) <= FStrings.Count then
+ begin
+ Inc(FIndex, celt);
+ Result := S_OK;
+ end
+ else
+ begin
+ FIndex := FStrings.Count;
+ Result := S_FALSE;
+ end;
+end;
+
+function TStringsEnumerator.Reset: HResult;
+begin
+ FIndex := 0;
+ Result := S_OK;
+end;
+
+function TStringsEnumerator.Clone(out enm: IEnumString): HResult;
+begin
+ try
+ enm := TStringsEnumerator.Create(FStrings);
+ TStringsEnumerator(enm).FIndex := FIndex;
+ Result := S_OK;
+ except
+ Result := E_UNEXPECTED;
+ end;
+end;
+
+{ TWideStringsAdapter }
+
+constructor TWideStringsAdapter.Create(Strings: TTntStrings);
+var
+ StdVcl: ITypeLib;
+begin
+ OleCheck(LoadRegTypeLib(LIBID_STDVCL, 4, 0, 0, StdVcl));
+ inherited Create(StdVcl, IStrings);
+ FStrings := Strings;
+end;
+
+procedure TWideStringsAdapter.ReferenceStrings(S: TTntStrings);
+begin
+ FStrings := S;
+end;
+
+procedure TWideStringsAdapter.ReleaseStrings;
+begin
+ FStrings := nil;
+end;
+
+function TWideStringsAdapter.Get_ControlDefault(Index: Integer): OleVariant;
+begin
+ Result := Get_Item(Index);
+end;
+
+procedure TWideStringsAdapter.Set_ControlDefault(Index: Integer; Value: OleVariant);
+begin
+ Set_Item(Index, Value);
+end;
+
+function TWideStringsAdapter.Count: Integer;
+begin
+ Result := 0;
+ if FStrings <> nil then Result := FStrings.Count;
+end;
+
+function TWideStringsAdapter.Get_Item(Index: Integer): OleVariant;
+begin
+ Result := NULL;
+ if (FStrings <> nil) then Result := WideString(FStrings[Index]);
+end;
+
+procedure TWideStringsAdapter.Set_Item(Index: Integer; Value: OleVariant);
+begin
+ if (FStrings <> nil) then FStrings[Index] := Value;
+end;
+
+procedure TWideStringsAdapter.Remove(Index: Integer);
+begin
+ if FStrings <> nil then FStrings.Delete(Index);
+end;
+
+procedure TWideStringsAdapter.Clear;
+begin
+ if FStrings <> nil then FStrings.Clear;
+end;
+
+function TWideStringsAdapter.Add(Item: OleVariant): Integer;
+begin
+ Result := -1;
+ if FStrings <> nil then Result := FStrings.Add(Item);
+end;
+
+function TWideStringsAdapter._NewEnum: IUnknown;
+begin
+ Result := TStringsEnumerator.Create(Self);
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntClipBrd.pas
===================================================================
--- trunk/TntUnicodeControls/TntClipBrd.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntClipBrd.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,122 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntClipBrd;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Classes, Windows, Clipbrd;
+
+type
+ TTntClipboard = class(TObject)
+ private
+ function GetAsWideText: WideString;
+ procedure SetAsWideText(const Value: WideString);
+ public
+ property AsWideText: WideString read GetAsWideText write SetAsWideText;
+ end;
+
+function TntClipboard: TTntClipboard;
+
+implementation
+
+type TAccessClipboard = class(TClipboard);
+
+procedure Clipboard_SetBuffer(Format{TNT-ALLOW Format}: Word; var Buffer; Size: Integer);
+{$IFDEF COMPILER_6_UP}
+begin
+ TAccessClipboard(Clipboard).SetBuffer(Format{TNT-ALLOW Format}, Buffer, Size);
+end;
+{$ELSE}
+var
+ Data: THandle;
+ DataPtr: Pointer;
+begin
+ with Clipboard do begin
+ Open;
+ try
+ Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Size);
+ try
+ DataPtr := GlobalLock(Data);
+ try
+ Move(Buffer, DataPtr^, Size);
+ Clear;
+ SetClipboardData(Format{TNT-ALLOW Format}, Data);
+ finally
+ GlobalUnlock(Data);
+ end;
+ except
+ GlobalFree(Data);
+ raise;
+ end;
+ finally
+ Close;
+ end;
+ end;
+end;
+{$ENDIF}
+
+{ TTntClipboard }
+
+function TTntClipboard.GetAsWideText: WideString;
+var
+ Data: THandle;
+begin
+ with Clipboard do begin
+ Open;
+ Data := GetClipboardData(CF_UNICODETEXT);
+ try
+ if Data <> 0 then
+ Result := PWideChar(GlobalLock(Data))
+ else
+ Result := '';
+ finally
+ if Data <> 0 then GlobalUnlock(Data);
+ Close;
+ end;
+ if (Data = 0) or (Result = '') then
+ Result := Clipboard.AsText
+ end;
+end;
+
+procedure TTntClipboard.SetAsWideText(const Value: WideString);
+begin
+ Clipboard.Open;
+ try
+ Clipboard.AsText := Value; {Ensures ANSI compatiblity across platforms.}
+ Clipboard_SetBuffer(CF_UNICODETEXT,
+ PWideChar(Value)^, (Length(Value) + 1) * SizeOf(WideChar));
+ finally
+ Clipboard.Close;
+ end;
+end;
+
+//------------------------------------------
+
+var
+ GTntClipboard: TTntClipboard;
+
+function TntClipboard: TTntClipboard;
+begin
+ if GTntClipboard = nil then
+ GTntClipboard := TTntClipboard.Create;
+ Result := GTntClipboard;
+end;
+
+initialization
+
+finalization
+ GTntClipboard.Free;
+
+end.
Copied: trunk/TntUnicodeControls/TntCompilers.inc (from rev 434, trunk/TntUnicodeControls/Compilers.inc)
===================================================================
--- trunk/TntUnicodeControls/Compilers.inc 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntCompilers.inc 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,323 @@
+//----------------------------------------------------------------------------------------------------------------------
+// Include file to determine which compiler is currently being used to build the project/component.
+// This file uses ideas from Brad Stowers DFS.inc file (www.delphifreestuff.com).
+//
+// Portions created by Mike Lischke are Copyright
+// (C) 1999-2002 Dipl. Ing. Mike Lischke. All Rights Reserved.
+//----------------------------------------------------------------------------------------------------------------------
+// The following symbols are defined:
+//
+// COMPILER_1 : Kylix/Delphi/BCB 1.x is the compiler.
+// COMPILER_1_UP : Kylix/Delphi/BCB 1.x or higher is the compiler.
+// COMPILER_2 : Kylix/Delphi 2.x or BCB 1.x is the compiler.
+// COMPILER_2_UP : Kylix/Delphi 2.x or higher, or BCB 1.x or higher is the compiler.
+// COMPILER_3 : Kylix/Delphi/BCB 3.x is the compiler.
+// COMPILER_3_UP : Kylix/Delphi/BCB 3.x or higher is the compiler.
+// COMPILER_4 : Kylix/Delphi/BCB 4.x is the compiler.
+// COMPILER_4_UP : Kylix/Delphi/BCB 4.x or higher is the compiler.
+// COMPILER_5 : Kylix/Delphi/BCB 5.x is the compiler.
+// COMPILER_5_UP : Kylix/Delphi/BCB 5.x or higher is the compiler.
+// COMPILER_6 : Kylix/Delphi/BCB 6.x is the compiler.
+// COMPILER_6_UP : Kylix/Delphi/BCB 6.x or higher is the compiler.
+// COMPILER_7 : Kylix/Delphi/BCB 7.x is the compiler.
+// COMPILER_7_UP : Kylix/Delphi/BCB 7.x or higher is the compiler.
+//
+// Only defined if Windows is the target:
+// CPPB : Any version of BCB is being used.
+// CPPB_1 : BCB v1.x is being used.
+// CPPB_3 : BCB v3.x is being used.
+// CPPB_3_UP : BCB v3.x or higher is being used.
+// CPPB_4 : BCB v4.x is being used.
+// CPPB_4_UP : BCB v4.x or higher is being used.
+// CPPB_5 : BCB v5.x is being used.
+// CPPB_5_UP : BCB v5.x or higher is being used.
+// CPPB_6 : BCB v6.x is being used.
+// CPPB_6_UP : BCB v6.x or higher is being used.
+//
+// Only defined if Windows is the target:
+// DELPHI : Any version of Delphi is being used.
+// DELPHI_1 : Delphi v1.x is being used.
+// DELPHI_2 : Delphi v2.x is being used.
+// DELPHI_2_UP : Delphi v2.x or higher is being used.
+// DELPHI_3 : Delphi v3.x is being used.
+// DELPHI_3_UP : Delphi v3.x or higher is being used.
+// DELPHI_4 : Delphi v4.x is being used.
+// DELPHI_4_UP : Delphi v4.x or higher is being used.
+// DELPHI_5 : Delphi v5.x is being used.
+// DELPHI_5_UP : Delphi v5.x or higher is being used.
+// DELPHI_6 : Delphi v6.x is being used.
+// DELPHI_6_UP : Delphi v6.x or higher is being used.
+// DELPHI_7 : Delphi v7.x is being used.
+// DELPHI_7_UP : Delphi v7.x or higher is being used.
+//
+// Only defined if Linux is the target:
+// KYLIX : Any version of Kylix is being used.
+// KYLIX_1 : Kylix 1.x is being used.
+// KYLIX_1_UP : Kylix 1.x or higher is being used.
+// KYLIX_2 : Kylix 2.x is being used.
+// KYLIX_2_UP : Kylix 2.x or higher is being used.
+// KYLIX_3 : Kylix 3.x is being used.
+// KYLIX_3_UP : Kylix 3.x or higher is being used.
+//
+// Only defined if Linux is the target:
+// QT_CLX : Trolltech's QT library is being used.
+//----------------------------------------------------------------------------------------------------------------------
+
+{$ifdef Win32}
+ {$ifdef VER170}
+ {$define COMPILER_9}
+ {$define DELPHI}
+ {$define DELPHI_9}
+ {$endif}
+
+ {$ifdef VER150}
+ {$define COMPILER_7}
+ {$define DELPHI}
+ {$define DELPHI_7}
+ {$endif}
+
+ {$ifdef VER140}
+ {$define COMPILER_6}
+ {$ifdef BCB}
+ {$define CPPB}
+ {$define CPPB_6}
+ {$else}
+ {$define DELPHI}
+ {$define DELPHI_6}
+ {$endif}
+ {$endif}
+
+ {$ifdef VER130}
+ {$define COMPILER_5}
+ {$ifdef BCB}
+ {$define CPPB}
+ {$define CPPB_5}
+ {$else}
+ {$define DELPHI}
+ {$define DELPHI_5}
+ {$endif}
+ {$endif}
+
+ {$ifdef VER125}
+ {$define COMPILER_4}
+ {$define CPPB}
+ {$define CPPB_4}
+ {$endif}
+
+ {$ifdef VER120}
+ {$define COMPILER_4}
+ {$define DELPHI}
+ {$define DELPHI_4}
+ {$endif}
+
+ {$ifdef VER110}
+ {$define COMPILER_3}
+ {$define CPPB}
+ {$define CPPB_3}
+ {$endif}
+
+ {$ifdef VER100}
+ {$define COMPILER_3}
+ {$define DELPHI}
+ {$define DELPHI_3}
+ {$endif}
+
+ {$ifdef VER93}
+ {$define COMPILER_2} // C++ Builder v1 compiler is really v2
+ {$define CPPB}
+ {$define CPPB_1}
+ {$endif}
+
+ {$ifdef VER90}
+ {$define COMPILER_2}
+ {$define DELPHI}
+ {$define DELPHI_2}
+ {$endif}
+
+ {$ifdef VER80}
+ {$define COMPILER_1}
+ {$define DELPHI}
+ {$define DELPHI_1}
+ {$endif}
+
+ {$ifdef DELPHI_2}
+ {$define DELPHI_2_UP}
+ {$endif}
+
+ {$ifdef DELPHI_3}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$endif}
+
+ {$ifdef DELPHI_4}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$endif}
+
+ {$ifdef DELPHI_5}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$endif}
+
+ {$ifdef DELPHI_6}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$endif}
+
+ {$ifdef DELPHI_7}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$endif}
+
+ {$ifdef DELPHI_9}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_9_UP}
+ {$endif}
+
+ {$ifdef CPPB_3}
+ {$define CPPB_3_UP}
+ {$endif}
+
+ {$ifdef CPPB_4}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$endif}
+
+ {$ifdef CPPB_5}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$endif}
+
+ {$ifdef CPPB_6}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+ {$endif}
+
+ {$ifdef CPPB_3_UP}
+ // C++ Builder requires this if you use Delphi components in run-time packages.
+ {$ObjExportAll On}
+ {$endif}
+
+{$else (not Windows)}
+ // Linux is the target
+ {$define QT_CLX}
+
+ {$define KYLIX}
+ {$define KYLIX_1}
+ {$define KYLIX_1_UP}
+
+ {$ifdef VER150}
+ {$define COMPILER_7}
+ {$define KYLIX_3}
+ {$endif}
+
+ {$ifdef VER140}
+ {$define COMPILER_6}
+ {$define KYLIX_2}
+ {$endif}
+
+ {$ifdef KYLIX_2}
+ {$define KYLIX_2_UP}
+ {$endif}
+
+ {$ifdef KYLIX_3}
+ {$define KYLIX_2_UP}
+ {$define KYLIX_3_UP}
+ {$endif}
+
+{$endif}
+
+// Compiler defines common to all platforms.
+{$ifdef COMPILER_1}
+ {$define COMPILER_1_UP}
+{$endif}
+
+{$ifdef COMPILER_2}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+{$endif}
+
+{$ifdef COMPILER_3}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+{$endif}
+
+{$ifdef COMPILER_4}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+{$endif}
+
+{$ifdef COMPILER_5}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+{$endif}
+
+{$ifdef COMPILER_6}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+{$endif}
+
+{$ifdef COMPILER_7}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define THEME_7_UP} { Allows experimental theme support on pre-Delphi 7. }
+{$endif}
+
+{$ifdef COMPILER_9}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define THEME_7_UP} { Allows experimental theme support on pre-Delphi 7. }
+ {$define COMPILER_9_UP}
+{$endif}
+
+//----------------------------------------------------------------------------------------------------------------------
+
+{$ALIGN ON}
+
+{$IFDEF COMPILER_6_UP}
+{$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! }
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+{$WARN UNSAFE_CODE OFF} { We are not going to be "safe"! }
+{$WARN UNSAFE_TYPE OFF}
+{$WARN UNSAFE_CAST OFF}
+{$ENDIF}
\ No newline at end of file
Added: trunk/TntUnicodeControls/TntDB.pas
===================================================================
--- trunk/TntUnicodeControls/TntDB.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntDB.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,643 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+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}']
+ function GetAsWideString: WideString;
+ procedure SetAsWideString(const Value: WideString);
+ function GetWideDisplayText: WideString;
+ function GetWideEditText: WideString;
+ procedure SetWideEditText(const Value: WideString);
+ //--
+ property AsWideString: WideString read GetAsWideString write SetAsWideString{inherited};
+ 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;
+ function GetAsWideString: WideString;
+ 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_6_UP}
+ procedure CopyData(Source, Dest: Pointer); override;
+{$ENDIF}
+ public
+ property Value: WideString read GetAsWideString write SetAsWideString;
+ property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
+ property Text: WideString read GetWideEditText write SetWideEditText;
+ property AsWideString: WideString read GetAsWideString write SetAsWideString;
+ 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;
+ function GetAsWideString: WideString;
+ procedure SetAsWideString(const Value: WideString);
+ 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
+ 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;
+ property AsWideString: WideString read GetAsWideString write SetAsWideString;
+ 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;
+
+{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
+ {$IFDEF COMPILER_6_UP} MaskUtils, Variants, {$ELSE} Mask, {$ENDIF} 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 GetAsWideString(Field: TField): WideString;
+var
+ WideField: IWideStringField;
+begin
+ if Field.GetInterface(IWideStringField, WideField) then
+ Result := WideField.AsWideString
+ else if (Field is TWideStringField{TNT-ALLOW TWideStringField}) then begin
+ if Field.IsNull then
+ // This fixes a bug in TWideStringField.GetAsWideString which does not handle Null at all.
+ Result := ''
+ else
+ Result := TWideStringField{TNT-ALLOW TWideStringField}(Field).Value
+ end else
+ Result := Field.AsString{TNT-ALLOW AsString};
+end;
+
+procedure SetAsWideString(Field: TField; const Value: WideString);
+var
+ WideField: IWideStringField;
+begin
+ if Field.GetInterface(IWideStringField, WideField) then
+ WideField.AsWideString := Value
+ else if (Field is TWideStringField{TNT-ALLOW TWideStringField}) then
+ TWideStringField{TNT-ALLOW TWideStringField}(Field).Value := Value
+ else
+ Field.AsString{TNT-ALLOW AsString} := Value;
+end;
+
+function GetWideDisplayText(Field: TField): WideString;
+var
+ WideField: IWideStringField;
+begin
+ if Field.GetInterface(IWideStringField, WideField) then
+ Result := WideField.WideDisplayText
+ else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
+ and (not Assigned(Field.OnGetText)) then
+ Result := GetAsWideString(Field)
+ else
+ Result := Field.DisplayText{TNT-ALLOW DisplayText};
+end;
+
+function GetWideText(Field: TField): WideString;
+var
+ WideField: IWideStringField;
+begin
+ if Field.GetInterface(IWideStringField, WideField) then
+ Result := WideField.WideText
+ else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
+ and (not Assigned(Field.OnGetText)) then
+ Result := GetAsWideString(Field)
+ else
+ Result := Field.Text;
+end;
+
+procedure SetWideText(Field: TField; const Value: WideString);
+var
+ WideField: IWideStringField;
+begin
+ if Field.GetInterface(IWideStringField, WideField) then
+ WideField.WideText := Value
+ else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
+ and (not Assigned(Field.OnSetText)) then
+ SetAsWideString(Field, Value)
+ else
+ Field.Text := Value
+end;
+
+{ TTntDateTimeField }
+
+procedure TTntDateTimeField.SetAsString(const Value: AnsiString);
+begin
+ if Value = '' then
+ inherited
+ else
+ SetAsDateTime(TntStrToDateTime(Value));
+end;
+
+{ TTntDateField }
+
+procedure TTntDateField.SetAsString(const Value: AnsiString);
+begin
+ if Value = '' then
+ inherited
+ else
+ SetAsDateTime(TntStrToDate(Value));
+end;
+
+{ TTntTimeField }
+
+procedure TTntTimeField.SetAsString(const Value: AnsiString);
+begin
+ if Value = '' then
+ inherited
+ else
+ SetAsDateTime(TntStrToTime(Value));
+end;
+
+{ TTntWideStringField / TTntStringField common handlers }
+
+procedure TntWideStringField_LegacyGetText(Sender: TField; OnGetText: TFieldGetWideTextEvent;
+ var AnsiText: AnsiString; DoDisplayText: Boolean);
+var
+ WideText: WideString;
+begin
+ if Assigned(OnGetText) then begin
+ WideText := AnsiText;
+ OnGetText(Sender, WideText, DoDisplayText);
+ AnsiText := WideText;
+ end;
+end;
+
+procedure TntWideStringField_LegacySetText(Sender: TField; OnSetText: TFieldSetWideTextEvent;
+ const AnsiText: AnsiString);
+begin
+ if Assigned(OnSetText) then
+ OnSetText(Sender, AnsiText);
+end;
+
+procedure TntWideStringField_GetWideText(Field: TField;
+ var Text: WideString; DoDisplayText: Boolean);
+var
+ WideStringField: IWideStringField;
+begin
+ Field.GetInterface(IWideStringField, WideStringField);
+ Assert(WideStringField <> nil);
+ if DoDisplayText and (Field.EditMaskPtr <> '') then
+ { to gain the mask, we lose Unicode! }
+ Text := FormatMaskText(Field.EditMaskPtr, WideStringField.GetAsWideString)
+ else
+ Text := WideStringField.GetAsWideString;
+end;
+
+function TntWideStringField_GetWideDisplayText(Field: TField;
+ OnGetText: TFieldGetWideTextEvent): WideString;
+begin
+ Result := '';
+ if Assigned(OnGetText) then
+ OnGetText(Field, Result, True)
+ else if Assigned(Field.OnGetText) then
+ Result := Field.DisplayText{TNT-ALLOW DisplayText} {we lose Unicode to handle this event}
+ else
+ TntWideStringField_GetWideText(Field, Result, True);
+end;
+
+function TntWideStringField_GetWideEditText(Field: TField;
+ OnGetText: TFieldGetWideTextEvent): WideString;
+begin
+ Result := '';
+ if Assigned(OnGetText) then
+ OnGetText(Field, Result, False)
+ else if Assigned(Field.OnGetText) then
+ Result := Field.Text {we lose Unicode to handle this event}
+ else
+ TntWideStringField_GetWideText(Field, Result, False);
+end;
+
+procedure TntWideStringField_SetWideText(Field: TField;
+ const Value: WideString);
+var
+ WideStringField: IWideStringField;
+begin
+ Field.GetInterface(IWideStringField, WideStringField);
+ Assert(WideStringField <> nil);
+ WideStringField.SetAsWideString(Value);
+end;
+
+procedure TntWideStringField_SetWideEditText(Field: TField;
+ OnSetText: TFieldSetWideTextEvent; const Value: WideString);
+begin
+ if Assigned(OnSetText) then
+ OnSetText(Field, Value)
+ else if Assigned(Field.OnSetText) then
+ Field.Text := Value {we lose Unicode to handle this event}
+ else
+ TntWideStringField_SetWideText(Field, Value);
+end;
+
+{ TTntWideStringField }
+
+{$IFNDEF COMPILER_6_UP}
+procedure TTntWideStringField.CopyData(Source, Dest: Pointer);
+begin
+ WideString(Dest^) := WideString(Source^);
+end;
+{$ENDIF}
+
+function TTntWideStringField.GetAsWideString: WideString;
+begin
+ if not GetData(@Result, False) then
+ Result := ''; {fixes a bug in inherited which has unpredictable results for NULL}
+end;
+
+procedure TTntWideStringField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
+ DoDisplayText: Boolean);
+begin
+ TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
+end;
+
+procedure TTntWideStringField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
+begin
+ TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
+end;
+
+procedure TTntWideStringField.SetOnGetText(const Value: TFieldGetWideTextEvent);
+begin
+ FOnGetText := Value;
+ if Assigned(OnGetText) then
+ inherited OnGetText := LegacyGetText
+ else
+ inherited OnGetText := nil;
+end;
+
+procedure TTntWideStringField.SetOnSetText(const Value: TFieldSetWideTextEvent);
+begin
+ FOnSetText := Value;
+ if Assigned(OnSetText) then
+ inherited OnSetText := LegacySetText
+ else
+ inherited OnSetText := nil;
+end;
+
+function TTntWideStringField.GetWideDisplayText: WideString;
+begin
+ Result := TntWideStringField_GetWideDisplayText(Self, OnGetText);
+end;
+
+function TTntWideStringField.GetWideEditText: WideString;
+begin
+ Result := TntWideStringField_GetWideEditText(Self, OnGetText);
+end;
+
+procedure TTntWideStringField.SetWideEditText(const Value: WideString);
+begin
+ TntWideStringField_SetWideEditText(Self, OnSetText, Value);
+end;
+
+(* This stuffing method works with CJK codepages - intended to store accented characters in Access 97 *)
+
+function SafeStringToWideStringEx(const S: AnsiString; Codepage: Word): WideString;
+var
+ R: AnsiString;
+ i: Integer;
+begin
+ R := '';
+ i := 1;
+ while i <= Length(S) do
+ begin
+ if (S[i] = #128) then
+ begin
+ Inc(i);
+ if S[i] = #128 then
+ R := R + #128
+ else
+ R := R + Chr(Ord(S[i]) + 128);
+ Inc(i);
+ end
+ else
+ begin
+ R := R + S[I];
+ Inc(i);
+ end;
+ end;
+ Result := StringToWideStringEx(R, CodePage);
+end;
+
+function SafeWideStringToStringEx(const W: WideString; CodePage: Word): AnsiString;
+var
+ TempS: AnsiString;
+ i: integer;
+begin
+ TempS := WideStringToStringEx(W, CodePage);
+ Result := '';
+ for i := 1 to Length(TempS) do
+ begin
+ if TempS[i] > #128 then
+ Result := Result + #128 + Chr(Ord(TempS[i]) - 128)
+ else if TempS[i] = #128 then
+ Result := Result + #128 + #128
+ else
+ Result := Result + TempS[i];
+ end;
+end;
+
+{ TTntStringField }
+
+constructor TTntStringField.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEncodingMode := emUTF8;
+ FFixedCodePage := TntStringFieldCodePageEnumMap[fcpLatinWestern]
+end;
+
+function TTntStringField.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 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
+ Result := GetAsWideString;
+end;
+
+procedure TTntStringField.SetAsString(const Value: string{TNT-ALLOW string});
+begin
+ 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;
+
+//---------------------------------------------------------------------------------------------
+procedure RegisterTntFields;
+begin
+ RegisterFields([TTntDateTimeField]);
+ RegisterFields([TTntDateField]);
+ RegisterFields([TTntTimeField]);
+ RegisterFields([TTntWideStringField]);
+ RegisterFields([TTntStringField]);
+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}
+
+end.
Added: trunk/TntUnicodeControls/TntDBActns.pas
===================================================================
--- trunk/TntUnicodeControls/TntDBActns.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntDBActns.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,594 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntDBActns;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Classes, ActnList, DBActns, TntActnList;
+
+type
+{TNT-WARN TDataSetAction}
+ TTntDataSetAction = class(TDataSetAction{TNT-ALLOW TDataSetAction}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetFirst}
+ TTntDataSetFirst = class(TDataSetFirst{TNT-ALLOW TDataSetFirst}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetPrior}
+ TTntDataSetPrior = class(TDataSetPrior{TNT-ALLOW TDataSetPrior}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetNext}
+ TTntDataSetNext = class(TDataSetNext{TNT-ALLOW TDataSetNext}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetLast}
+ TTntDataSetLast = class(TDataSetLast{TNT-ALLOW TDataSetLast}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetInsert}
+ TTntDataSetInsert = class(TDataSetInsert{TNT-ALLOW TDataSetInsert}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetDelete}
+ TTntDataSetDelete = class(TDataSetDelete{TNT-ALLOW TDataSetDelete}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetEdit}
+ TTntDataSetEdit = class(TDataSetEdit{TNT-ALLOW TDataSetEdit}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetPost}
+ TTntDataSetPost = class(TDataSetPost{TNT-ALLOW TDataSetPost}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetCancel}
+ TTntDataSetCancel = class(TDataSetCancel{TNT-ALLOW TDataSetCancel}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+{TNT-WARN TDataSetRefresh}
+ TTntDataSetRefresh = class(TDataSetRefresh{TNT-ALLOW TDataSetRefresh}, ITntAction)
+ private
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ property Hint: WideString read GetHint write SetHint;
+ end;
+
+procedure TntDBActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
+
+implementation
+
+uses
+ TntClasses;
+
+{TNT-IGNORE-UNIT}
+
+procedure TntDBActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
+begin
+ TntAction_AfterInherited_Assign(Action, Source);
+ // TDataSetAction
+ if (Action is TDataSetAction) and (Source is TDataSetAction) then begin
+ TDataSetAction(Action).DataSource := TDataSetAction(Source).DataSource;
+ end;
+end;
+
+//-------------------------
+// TNT DB ACTNS
+//-------------------------
+
+{ TTntDataSetAction }
+
+procedure TTntDataSetAction.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetAction.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetAction.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetAction.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetAction.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetAction.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetFirst }
+
+procedure TTntDataSetFirst.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetFirst.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetFirst.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetFirst.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetFirst.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetFirst.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetPrior }
+
+procedure TTntDataSetPrior.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetPrior.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetPrior.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetPrior.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetPrior.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetPrior.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetNext }
+
+procedure TTntDataSetNext.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetNext.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetNext.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetNext.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetNext.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetNext.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetLast }
+
+procedure TTntDataSetLast.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetLast.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetLast.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetLast.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetLast.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetLast.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetInsert }
+
+procedure TTntDataSetInsert.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetInsert.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetInsert.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetInsert.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetInsert.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetInsert.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetDelete }
+
+procedure TTntDataSetDelete.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetDelete.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetDelete.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetDelete.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetDelete.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetDelete.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetEdit }
+
+procedure TTntDataSetEdit.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetEdit.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetEdit.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetEdit.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetEdit.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetEdit.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetPost }
+
+procedure TTntDataSetPost.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetPost.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetPost.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetPost.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetPost.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetPost.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetCancel }
+
+procedure TTntDataSetCancel.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetCancel.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetCancel.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetCancel.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetCancel.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetCancel.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+{ TTntDataSetRefresh }
+
+procedure TTntDataSetRefresh.Assign(Source: TPersistent);
+begin
+ inherited;
+ TntDBActn_AfterInherited_Assign(Self, Source);
+end;
+
+procedure TTntDataSetRefresh.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDataSetRefresh.GetCaption: WideString;
+begin
+ Result := TntAction_GetCaption(Self);
+end;
+
+procedure TTntDataSetRefresh.SetCaption(const Value: WideString);
+begin
+ TntAction_SetCaption(Self, Value);
+end;
+
+function TTntDataSetRefresh.GetHint: WideString;
+begin
+ Result := TntAction_GetHint(Self);
+end;
+
+procedure TTntDataSetRefresh.SetHint(const Value: WideString);
+begin
+ TntAction_SetHint(Self, Value);
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntDBGrids.pas
===================================================================
--- trunk/TntUnicodeControls/TntDBGrids.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntDBGrids.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,1695 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntDBGrids;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Classes, TntClasses, Controls, Windows, Grids, DBGrids, Messages, DBCtrls, DB, TntStdCtrls;
+
+type
+{TNT-WARN TColumnTitle}
+ TTntColumnTitle = class(TColumnTitle{TNT-ALLOW TColumnTitle})
+ private
+ FCaption: WideString;
+ procedure SetInheritedCaption(const Value: AnsiString);
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ function IsCaptionStored: Boolean;
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ procedure RestoreDefaults; override;
+ published
+ property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
+ end;
+
+{TNT-WARN TColumn}
+type
+ TTntColumn = class(TColumn{TNT-ALLOW TColumn})
+ private
+ FWidePickList: TTntStrings;
+ function GetWidePickList: TTntStrings;
+ procedure SetWidePickList(const Value: TTntStrings);
+ procedure HandlePickListChange(Sender: TObject);
+ function GetTitle: TTntColumnTitle;
+ procedure SetTitle(const Value: TTntColumnTitle);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ function CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle}; override;
+ public
+ destructor Destroy; override;
+ property WidePickList: TTntStrings read GetWidePickList write SetWidePickList;
+ published
+{TNT-WARN PickList}
+ property PickList{TNT-ALLOW PickList}: TTntStrings read GetWidePickList write SetWidePickList;
+ property Title: TTntColumnTitle read GetTitle write SetTitle;
+ end;
+
+ { TDBGridInplaceEdit adds support for a button on the in-place editor,
+ which can be used to drop down a table-based lookup list, a stringlist-based
+ pick list, or (if button style is esEllipsis) fire the grid event
+ OnEditButtonClick. }
+
+{$IFDEF COMPILER_6_UP}
+type
+ TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit} = class(TInplaceEditList)
+ private
+ {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+ FDataList: TDBLookupListBox; // 1st field - Delphi/BCB 6 TCustomDBGrid assumes this
+ FUseDataList: Boolean; // 2nd field - Delphi/BCB 6 TCustomDBGrid assumes this
+ {$ENDIF}
+ {$IFDEF DELPHI_7}
+ FDataList: TDBLookupListBox; // 1st field - Delphi 7 TCustomDBGrid assumes this
+ FUseDataList: Boolean; // 2nd field - Delphi 7 TCustomDBGrid assumes this
+ {$ENDIF}
+ {$IFDEF DELPHI_9}
+ FDataList: TDBLookupListBox; // 1st field - Delphi 9 TCustomDBGrid assumes this
+ FUseDataList: Boolean; // 2nd field - Delphi 9 TCustomDBGrid assumes this
+ {$ENDIF}
+ FLookupSource: TDatasource;
+ FWidePickListBox: TTntCustomListbox;
+ function GetWidePickListBox: TTntCustomListbox;
+ protected
+ procedure CloseUp(Accept: Boolean); override;
+ procedure DoEditButtonClick; override;
+ procedure DropDown; override;
+ procedure UpdateContents; override;
+ property UseDataList: Boolean read FUseDataList;
+ public
+ constructor Create(Owner: TComponent); override;
+ property DataList: TDBLookupListBox read FDataList;
+ property WidePickListBox: TTntCustomListbox read GetWidePickListBox;
+ end;
+{$ELSE} // Delphi 5 and lower
+type
+ TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
+ TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit} = class(TInplaceEdit{TNT-ALLOW TInplaceEdit})
+ private
+ FButtonWidth: Integer;
+ FDataList: TDBLookupListBox;
+ FWidePickListBox: TTntCustomListbox;
+ FActiveList: TWinControl;
+ FLookupSource: TDatasource;
+ FEditStyle: TEditStyle;
+ FListVisible: Boolean;
+ FTracking: Boolean;
+ FPressed: Boolean;
+ function GetWidePickListBox: TTntCustomListbox;
+ procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ procedure SetEditStyle(Value: TEditStyle);
+ procedure StopTracking;
+ procedure TrackButton(X,Y: Integer);
+ procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
+ procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
+ procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
+ procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
+ procedure WMPaint(var Message: TWMPaint); message wm_Paint;
+ procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
+ function OverButton(const P: TPoint): Boolean;
+ function ButtonRect: TRect;
+ protected
+ procedure BoundsChanged; override;
+ procedure CloseUp(Accept: Boolean);
+ procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
+ procedure DropDown;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure PaintWindow(DC: HDC); override;
+ procedure UpdateContents; override;
+ procedure WndProc(var Message: TMessage); override;
+ property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
+ property ActiveList: TWinControl read FActiveList write FActiveList;
+ property DataList: TDBLookupListBox read FDataList;
+ property WidePickListBox: TTntCustomListbox read GetWidePickListBox;
+ public
+ constructor Create(Owner: TComponent); override;
+ end;
+{$ENDIF}
+
+type
+{TNT-WARN TDBGridInplaceEdit}
+ TTntDBGridInplaceEdit = class(TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit})
+ private
+ FInDblClick: Boolean;
+ FBlockSetText: Boolean;
+ procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
+ protected
+ function GetText: WideString; virtual;
+ procedure SetText(const Value: WideString); virtual;
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure UpdateContents; override;
+ procedure DblClick; override;
+ public
+ property Text: WideString read GetText write SetText;
+ end;
+
+{TNT-WARN TDBGridColumns}
+ TTntDBGridColumns = class(TDBGridColumns{TNT-ALLOW TDBGridColumns})
+ private
+ function GetColumn(Index: Integer): TTntColumn;
+ procedure SetColumn(Index: Integer; const Value: TTntColumn);
+ public
+ function Add: TTntColumn;
+ property Items[Index: Integer]: TTntColumn read GetColumn write SetColumn; default;
+ end;
+
+ TTntGridDataLink = class(TGridDataLink)
+ private
+ OriginalSetText: TFieldSetTextEvent;
+ procedure GridUpdateFieldText(Sender: TField; const Text: AnsiString);
+ {$IFNDEF COMPILER_6_UP}
+ function Grid: TCustomDBGrid{TNT-ALLOW TCustomDBGrid};
+ {$ENDIF}
+ protected
+ procedure UpdateData; override;
+ procedure RecordChanged(Field: TField); override;
+ end;
+
+{TNT-WARN TCustomDBGrid}
+ TTntCustomDBGrid = class(TCustomDBGrid{TNT-ALLOW TCustomDBGrid})
+ private
+ FEditText: WideString;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure WMChar(var Msg: TWMChar); message WM_CHAR;
+ function GetColumns: TTntDBGridColumns;
+ procedure SetColumns(const Value: TTntDBGridColumns);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure ShowEditorChar(Ch: WideChar); dynamic;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ function CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns}; override;
+ property Columns: TTntDBGridColumns read GetColumns write SetColumns;
+ function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
+ {$IFDEF COMPILER_6_UP}
+ function CreateDataLink: TGridDataLink; override;
+ {$ENDIF}
+ function GetEditText(ACol, ARow: Longint): WideString; reintroduce;
+ procedure DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
+ procedure SetEditText(ACol, ARow: Longint; const Value: AnsiString); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
+ Column: TTntColumn; State: TGridDrawState); dynamic;
+ procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
+ State: TGridDrawState);
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TDBGrid}
+ TTntDBGrid = class(TTntCustomDBGrid)
+ public
+ property Canvas;
+ property SelectedRows;
+ published
+ property Align;
+ property Anchors;
+ property BiDiMode;
+ property BorderStyle;
+ property Color;
+ property Columns stored False; //StoreColumns;
+ property Constraints;
+ property Ctl3D;
+ property DataSource;
+ property DefaultDrawing;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property FixedColor;
+ property Font;
+ property ImeMode;
+ property ImeName;
+ property Options;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ReadOnly;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property TitleFont;
+ property Visible;
+ property OnCellClick;
+ property OnColEnter;
+ property OnColExit;
+ property OnColumnMoved;
+ property OnDrawDataCell; { obsolete }
+ property OnDrawColumnCell;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEditButtonClick;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDock;
+ property OnStartDrag;
+ property OnTitleClick;
+ end;
+
+implementation
+
+uses
+ SysUtils, TntControls, Math, {$IFDEF COMPILER_6_UP} Variants, {$ENDIF} Forms, TntDBCtrls,
+ TntGraphics, Graphics, TntDB, TntActnList, TntSysUtils, TntWindows;
+
+{ TTntColumnTitle }
+
+procedure TTntColumnTitle.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntColumnTitle.IsCaptionStored: Boolean;
+begin
+ Result := (cvTitleCaption in Column.AssignedValues) and
+ (FCaption <> WideString(DefaultCaption));
+end;
+
+procedure TTntColumnTitle.SetInheritedCaption(const Value: AnsiString);
+begin
+ inherited Caption := Value;
+end;
+
+function TTntColumnTitle.GetCaption: WideString;
+begin
+ if cvTitleCaption in Column.AssignedValues then
+ Result := GetSyncedWideString(FCaption, inherited Caption)
+ else
+ Result := inherited Caption;
+end;
+
+procedure TTntColumnTitle.SetCaption(const Value: WideString);
+begin
+ if not (Column as TTntColumn).IsStored then
+ inherited Caption := Value
+ else begin
+ if (cvTitleCaption in Column.AssignedValues) and (Value = FCaption) then Exit;
+ SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
+ end;
+end;
+
+procedure TTntColumnTitle.Assign(Source: TPersistent);
+begin
+ inherited Assign(Source);
+ if Source is TTntColumnTitle then
+ begin
+ if cvTitleCaption in TTntColumnTitle(Source).Column.AssignedValues then
+ Caption := TTntColumnTitle(Source).Caption;
+ end;
+end;
+
+procedure TTntColumnTitle.RestoreDefaults;
+begin
+ FCaption := '';
+ inherited;
+end;
+
+{ TTntColumn }
+
+procedure TTntColumn.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntColumn.CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle};
+begin
+ Result := TTntColumnTitle.Create(Self);
+end;
+
+function TTntColumn.GetTitle: TTntColumnTitle;
+begin
+ Result := (inherited Title) as TTntColumnTitle;
+end;
+
+procedure TTntColumn.SetTitle(const Value: TTntColumnTitle);
+begin
+ inherited Title := Value;
+end;
+
+function TTntColumn.GetWidePickList: TTntStrings;
+begin
+ if FWidePickList = nil then begin
+ FWidePickList := TTntStringList.Create;
+ TTntStringList(FWidePickList).OnChange := HandlePickListChange;
+ end;
+ Result := FWidePickList;
+end;
+
+procedure TTntColumn.SetWidePickList(const Value: TTntStrings);
+begin
+ if Value = nil then
+ begin
+ FWidePickList.Free;
+ FWidePickList := nil;
+ (inherited PickList{TNT-ALLOW PickList}).Clear;
+ Exit;
+ end;
+ WidePickList.Assign(Value);
+end;
+
+procedure TTntColumn.HandlePickListChange(Sender: TObject);
+begin
+ inherited PickList{TNT-ALLOW PickList}.Assign(WidePickList);
+end;
+
+destructor TTntColumn.Destroy;
+begin
+ inherited;
+ FWidePickList.Free;
+end;
+
+{ TTntPopupListbox }
+type
+ TTntPopupListbox = class(TTntCustomListbox)
+ private
+ FSearchText: WideString;
+ FSearchTickCount: Longint;
+ protected
+ procedure CreateParams(var Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure WMChar(var Message: TWMChar); message WM_CHAR;
+ procedure KeyPressW(var Key: WideChar);
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ end;
+
+procedure TTntPopupListbox.CreateParams(var Params: TCreateParams);
+begin
+ inherited CreateParams(Params);
+ with Params do
+ begin
+ Style := Style or WS_BORDER;
+ ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
+ AddBiDiModeExStyle(ExStyle);
+ WindowClass.Style := CS_SAVEBITS;
+ end;
+end;
+
+procedure TTntPopupListbox.CreateWnd;
+begin
+ inherited CreateWnd;
+ Windows.SetParent(Handle, 0);
+ CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
+end;
+
+procedure TTntPopupListbox.WMChar(var Message: TWMChar);
+var
+ Key: WideChar;
+begin
+ Key := GetWideCharFromWMCharMsg(Message);
+ KeyPressW(Key);
+ SetWideCharForWMCharMsg(Message, Key);
+ inherited;
+end;
+
+procedure TTntPopupListbox.KeypressW(var Key: WideChar);
+var
+ TickCount: Integer;
+begin
+ case Key of
+ #8, #27: FSearchText := '';
+ #32..High(WideChar):
+ begin
+ TickCount := GetTickCount;
+ if TickCount - FSearchTickCount > 2000 then FSearchText := '';
+ FSearchTickCount := TickCount;
+ if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
+ if IsWindowUnicode(Handle) then
+ SendMessageW(Handle, LB_SelectString, WORD(-1), Longint(PWideChar(FSearchText)))
+ else
+ SendMessageA(Handle, LB_SelectString, WORD(-1), Longint(PAnsiChar(AnsiString(FSearchText))));
+ Key := #0;
+ end;
+ end;
+end;
+
+procedure TTntPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ inherited MouseUp(Button, Shift, X, Y);
+ (Owner as TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}).CloseUp((X >= 0) and (Y >= 0) and
+ (X < Width) and (Y < Height));
+end;
+
+{ TTntPopupDataList }
+type
+ TTntPopupDataList = class(TPopupDataList)
+ protected
+ procedure Paint; override;
+ end;
+
+procedure TTntPopupDataList.Paint;
+var
+ FRecordIndex: Integer;
+ FRecordCount: Integer;
+ FKeySelected: Boolean;
+ FKeyField: TField;
+
+ procedure UpdateListVars;
+ begin
+ if ListActive then
+ begin
+ FRecordIndex := ListLink.ActiveRecord;
+ FRecordCount := ListLink.RecordCount;
+ FKeySelected := not VarIsNull(KeyValue) or
+ not ListLink.DataSet.BOF;
+ end else
+ begin
+ FRecordIndex := 0;
+ FRecordCount := 0;
+ FKeySelected := False;
+ end;
+
+ FKeyField := nil;
+ if ListLink.Active and (KeyField <> '') then
+ FKeyField := GetFieldProperty(ListLink.DataSet, Self, KeyField);
+ end;
+
+ function VarEquals(const V1, V2: Variant): Boolean;
+ begin
+ Result := False;
+ try
+ Result := V1 = V2;
+ except
+ end;
+ end;
+
+var
+ I, J, W, X, TxtWidth, TxtHeight, LastFieldIndex: Integer;
+ S: WideString;
+ R: TRect;
+ Selected: Boolean;
+ Field: TField;
+ AAlignment: TAlignment;
+begin
+ UpdateListVars;
+ Canvas.Font := Font;
+ TxtWidth := WideCanvasTextWidth(Canvas, '0');
+ TxtHeight := WideCanvasTextHeight(Canvas, '0');
+ LastFieldIndex := ListFields.Count - 1;
+ if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
+ Canvas.Pen.Color := clBtnFace else
+ Canvas.Pen.Color := clBtnShadow;
+ for I := 0 to RowCount - 1 do
+ begin
+ if Enabled then
+ Canvas.Font.Color := Font.Color else
+ Canvas.Font.Color := clGrayText;
+ Canvas.Brush.Color := Color;
+ Selected := not FKeySelected and (I = 0);
+ R.Top := I * TxtHeight;
+ R.Bottom := R.Top + TxtHeight;
+ if I < FRecordCount then
+ begin
+ ListLink.ActiveRecord := I;
+ if not VarIsNull(KeyValue) and
+ VarEquals(FKeyField.Value, KeyValue) then
+ begin
+ Canvas.Font.Color := clHighlightText;
+ Canvas.Brush.Color := clHighlight;
+ Selected := True;
+ end;
+ R.Right := 0;
+ for J := 0 to LastFieldIndex do
+ begin
+ Field := ListFields[J];
+ if J < LastFieldIndex then
+ W := Field.DisplayWidth * TxtWidth + 4 else
+ W := ClientWidth - R.Right;
+ S := GetWideDisplayText(Field);
+ X := 2;
+ AAlignment := Field.Alignment;
+ if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
+ case AAlignment of
+ taRightJustify: X := W - WideCanvasTextWidth(Canvas, S) - 3;
+ taCenter: X := (W - WideCanvasTextWidth(Canvas, S)) div 2;
+ end;
+ R.Left := R.Right;
+ R.Right := R.Right + W;
+ if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags;
+ WideCanvasTextRect(Canvas, R, R.Left + X, R.Top, S);
+ if J < LastFieldIndex then
+ begin
+ Canvas.MoveTo(R.Right, R.Top);
+ Canvas.LineTo(R.Right, R.Bottom);
+ Inc(R.Right);
+ if R.Right >= ClientWidth then Break;
+ end;
+ end;
+ end;
+ R.Left := 0;
+ R.Right := ClientWidth;
+ if I >= FRecordCount then Canvas.FillRect(R);
+ if Selected then
+ Canvas.DrawFocusRect(R);
+ end;
+ if FRecordCount <> 0 then ListLink.ActiveRecord := FRecordIndex;
+end;
+
+{$IFDEF COMPILER_6_UP}
+//-----------------------------------------------------------------------------------------
+// TDBGridInplaceEdit - Delphi 6 and higher
+//-----------------------------------------------------------------------------------------
+
+constructor TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.Create(Owner: TComponent);
+begin
+ inherited Create(Owner);
+ FLookupSource := TDataSource.Create(Self);
+end;
+
+function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.GetWidePickListBox: TTntCustomListBox;
+var
+ PopupListbox: TTntPopupListbox;
+begin
+ if not Assigned(FWidePickListBox) then
+ begin
+ PopupListbox := TTntPopupListbox.Create(Self);
+ PopupListbox.Visible := False;
+ PopupListbox.Parent := Self;
+ PopupListbox.OnMouseUp := ListMouseUp;
+ PopupListbox.IntegralHeight := True;
+ PopupListbox.ItemHeight := 11;
+ FWidePickListBox := PopupListBox;
+ end;
+ Result := FWidePickListBox;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.CloseUp(Accept: Boolean);
+var
+ MasterField: TField;
+ ListValue: Variant;
+begin
+ if ListVisible then
+ begin
+ if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
+ if ActiveList = DataList then
+ ListValue := DataList.KeyValue
+ else
+ if WidePickListBox.ItemIndex <> -1 then
+ ListValue := WidePickListBox.Items[WidePickListBox.ItemIndex];
+ SetWindowPos(ActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
+ SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
+ ListVisible := False;
+ if Assigned(FDataList) then
+ FDataList.ListSource := nil;
+ FLookupSource.Dataset := nil;
+ Invalidate;
+ if Accept then
+ if ActiveList = DataList then
+ with Grid as TTntCustomDBGrid, Columns[SelectedIndex].Field do
+ begin
+ MasterField := DataSet.FieldByName(KeyFields);
+ if MasterField.CanModify and DataLink.Edit then
+ MasterField.Value := ListValue;
+ end
+ else
+ if (not VarIsNull(ListValue)) and EditCanModify then
+ with Grid as TTntCustomDBGrid do
+ SetWideText(Columns[SelectedIndex].Field, ListValue)
+ end;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DoEditButtonClick;
+begin
+ (Grid as TTntCustomDBGrid).EditButtonClick;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DropDown;
+var
+ Column: TTntColumn;
+begin
+ if not ListVisible then
+ begin
+ with (Grid as TTntCustomDBGrid) do
+ Column := Columns[SelectedIndex] as TTntColumn;
+ if ActiveList = FDataList then
+ with Column.Field do
+ begin
+ FDataList.Color := Color;
+ FDataList.Font := Font;
+ FDataList.RowCount := Column.DropDownRows;
+ FLookupSource.DataSet := LookupDataSet;
+ FDataList.KeyField := LookupKeyFields;
+ FDataList.ListField := LookupResultField;
+ FDataList.ListSource := FLookupSource;
+ FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
+ end
+ else if ActiveList = WidePickListBox then
+ begin
+ WidePickListBox.Items.Assign(Column.WidePickList);
+ DropDownRows := Column.DropDownRows;
+ end;
+ end;
+ inherited DropDown;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.UpdateContents;
+var
+ Column: TTntColumn;
+begin
+ inherited UpdateContents;
+ if EditStyle = esPickList then
+ ActiveList := WidePickListBox;
+ if FUseDataList then
+ begin
+ if FDataList = nil then
+ begin
+ FDataList := TTntPopupDataList.Create(Self);
+ FDataList.Visible := False;
+ FDataList.Parent := Self;
+ FDataList.OnMouseUp := ListMouseUp;
+ end;
+ ActiveList := FDataList;
+ end;
+ with (Grid as TTntCustomDBGrid) do
+ Column := Columns[SelectedIndex] as TTntColumn;
+ Self.ReadOnly := Column.ReadOnly;
+ Font.Assign(Column.Font);
+ ImeMode := Column.ImeMode;
+ ImeName := Column.ImeName;
+end;
+
+{$ELSE}
+//-----------------------------------------------------------------------------------------
+// TDBGridInplaceEdit - Delphi 5 and lower
+//-----------------------------------------------------------------------------------------
+
+constructor TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.Create(Owner: TComponent);
+begin
+ inherited Create(Owner);
+ FLookupSource := TDataSource.Create(Self);
+ FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
+ FEditStyle := esSimple;
+end;
+
+function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.GetWidePickListBox: TTntCustomListBox;
+var
+ PopupListbox: TTntPopupListbox;
+begin
+ if not Assigned(FWidePickListBox) then
+ begin
+ PopupListbox := TTntPopupListbox.Create(Self);
+ PopupListbox.Visible := False;
+ PopupListbox.Parent := Self;
+ PopupListbox.OnMouseUp := ListMouseUp;
+ PopupListbox.IntegralHeight := True;
+ PopupListbox.ItemHeight := 11;
+ FWidePickListBox := PopupListBox;
+ end;
+ Result := FWidePickListBox;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.BoundsChanged;
+var
+ R: TRect;
+begin
+ SetRect(R, 2, 2, Width - 2, Height);
+ if FEditStyle <> esSimple then
+ if not (Owner as TTntCustomDBGrid).UseRightToLeftAlignment then
+ Dec(R.Right, FButtonWidth)
+ else
+ Inc(R.Left, FButtonWidth - 2);
+ SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
+ SendMessage(Handle, EM_SCROLLCARET, 0, 0);
+ if SysLocale.FarEast then
+ SetImeCompositionWindow(Font, R.Left, R.Top);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.CloseUp(Accept: Boolean);
+var
+ MasterField: TField;
+ ListValue: Variant;
+begin
+ if FListVisible then
+ begin
+ if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
+ if FActiveList = FDataList then
+ ListValue := FDataList.KeyValue
+ else
+ if WidePickListBox.ItemIndex <> -1 then
+ ListValue := WidePickListBox.Items[WidePickListBox.ItemIndex];
+ SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
+ SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
+ FListVisible := False;
+ if Assigned(FDataList) then
+ FDataList.ListSource := nil;
+ FLookupSource.Dataset := nil;
+ Invalidate;
+ if Accept then
+ if FActiveList = FDataList then
+ with Grid as TTntCustomDBGrid, Columns[SelectedIndex].Field do
+ begin
+ MasterField := DataSet.FieldByName(KeyFields);
+ if MasterField.CanModify and DataLink.Edit then
+ MasterField.Value := ListValue;
+ end
+ else
+ if (not VarIsNull(ListValue)) and EditCanModify then
+ with Grid as TTntCustomDBGrid do
+ SetWideText(Columns[SelectedIndex].Field, ListValue);
+ end;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DoDropDownKeys(var Key: Word; Shift: TShiftState);
+begin
+ case Key of
+ VK_UP, VK_DOWN:
+ if ssAlt in Shift then
+ begin
+ if FListVisible then CloseUp(True) else DropDown;
+ Key := 0;
+ end;
+ VK_RETURN, VK_ESCAPE:
+ if FListVisible and not (ssAlt in Shift) then
+ begin
+ CloseUp(Key = VK_RETURN);
+ Key := 0;
+ end;
+ end;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DropDown;
+var
+ P: TPoint;
+ I,J,Y: Integer;
+ Column: TTntColumn;
+ FPickList: TTntPopupListbox;
+begin
+ if not FListVisible and Assigned(FActiveList) then
+ begin
+ FActiveList.Width := Width;
+ with Grid as TTntCustomDBGrid do
+ Column := Columns[SelectedIndex];
+ if FActiveList = FDataList then
+ with Column.Field do
+ begin
+ FDataList.Color := Color;
+ FDataList.Font := Font;
+ FDataList.RowCount := Column.DropDownRows;
+ FLookupSource.DataSet := LookupDataSet;
+ FDataList.KeyField := LookupKeyFields;
+ FDataList.ListField := LookupResultField;
+ FDataList.ListSource := FLookupSource;
+ FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
+{ J := Column.DefaultWidth;
+ if J > FDataList.ClientWidth then
+ FDataList.ClientWidth := J;
+} end
+ else
+ begin
+ FPickList := WidePickListBox as TTntPopupListbox;
+ FPickList.Color := Color;
+ FPickList.Font := Font;
+ FPickList.Items := Column.PickList{TNT-ALLOW PickList};
+ if FPickList.Items.Count >= Integer(Column.DropDownRows) then
+ FPickList.Height := Integer(Column.DropDownRows) * FPickList.ItemHeight + 4
+ else
+ FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
+ if Column.Field.IsNull then
+ FPickList.ItemIndex := -1
+ else
+ FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Text);
+ J := FPickList.ClientWidth;
+ for I := 0 to FPickList.Items.Count - 1 do
+ begin
+ Y := WideCanvasTextWidth(FPickList.Canvas, FPickList.Items[I]);
+ if Y > J then J := Y;
+ end;
+ FPickList.ClientWidth := J;
+ end;
+ P := Parent.ClientToScreen(Point(Left, Top));
+ Y := P.Y + Height;
+ if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
+ SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
+ SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
+ FListVisible := True;
+ Invalidate;
+ Windows.SetFocus(Handle);
+ end;
+end;
+
+procedure KillMessage(Wnd: HWnd; Msg: Integer);
+// Delete the requested message from the queue, but throw back
+// any WM_QUIT msgs that PeekMessage may also return
+var
+ M: TMsg;
+begin
+ M.Message := 0;
+ if PeekMessage{TNT-ALLOW PeekMessage}(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
+ PostQuitMessage(M.wparam);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
+ begin
+ (Grid as TTntCustomDBGrid).EditButtonClick;
+ KillMessage(Handle, WM_CHAR);
+ end
+ else
+ inherited KeyDown(Key, Shift);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.ListMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ if Button = mbLeft then
+ CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ if (Button = mbLeft) and (FEditStyle <> esSimple) and
+ OverButton(Point(X,Y)) then
+ begin
+ if FListVisible then
+ CloseUp(False)
+ else
+ begin
+ MouseCapture := True;
+ FTracking := True;
+ TrackButton(X, Y);
+ if Assigned(FActiveList) then
+ DropDown;
+ end;
+ end;
+ inherited MouseDown(Button, Shift, X, Y);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+ ListPos: TPoint;
+ MousePos: TSmallPoint;
+begin
+ if FTracking then
+ begin
+ TrackButton(X, Y);
+ if FListVisible then
+ begin
+ ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
+ if PtInRect(FActiveList.ClientRect, ListPos) then
+ begin
+ StopTracking;
+ MousePos := PointToSmallPoint(ListPos);
+ SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
+ Exit;
+ end;
+ end;
+ end;
+ inherited MouseMove(Shift, X, Y);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+var
+ WasPressed: Boolean;
+begin
+ WasPressed := FPressed;
+ StopTracking;
+ if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
+ (Grid as TTntCustomDBGrid).EditButtonClick;
+ inherited MouseUp(Button, Shift, X, Y);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.PaintWindow(DC: HDC);
+var
+ R: TRect;
+ Flags: Integer;
+ W, X, Y: Integer;
+begin
+ if FEditStyle <> esSimple then
+ begin
+ R := ButtonRect;
+ Flags := 0;
+ if FEditStyle in [esDataList, esPickList] then
+ begin
+ if FActiveList = nil then
+ Flags := DFCS_INACTIVE
+ else if FPressed then
+ Flags := DFCS_FLAT or DFCS_PUSHED;
+ DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
+ end
+ else { esEllipsis }
+ begin
+ if FPressed then Flags := BF_FLAT;
+ DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
+ X := R.Left + ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
+ Y := R.Top + ((R.Bottom - R.Top) shr 1) - 1 + Ord(FPressed);
+ W := FButtonWidth shr 3;
+ if W = 0 then W := 1;
+ PatBlt(DC, X, Y, W, W, BLACKNESS);
+ PatBlt(DC, X - (W * 2), Y, W, W, BLACKNESS);
+ PatBlt(DC, X + (W * 2), Y, W, W, BLACKNESS);
+ end;
+ ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
+ end;
+ inherited PaintWindow(DC);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.SetEditStyle(Value: TEditStyle);
+begin
+ if Value = FEditStyle then Exit;
+ FEditStyle := Value;
+ case Value of
+ esPickList:
+ begin
+ FActiveList := WidePickListBox;
+ end;
+ esDataList:
+ begin
+ if FDataList = nil then
+ begin
+ FDataList := TTntPopupDataList.Create(Self);
+ FDataList.Visible := False;
+ FDataList.Parent := Self;
+ FDataList.OnMouseUp := ListMouseUp;
+ end;
+ FActiveList := FDataList;
+ end;
+ else { cbsNone, cbsEllipsis, or read only field }
+ FActiveList := nil;
+ end;
+ with (Grid as TTntCustomDBGrid) do
+ Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
+ Repaint;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.StopTracking;
+begin
+ if FTracking then
+ begin
+ TrackButton(-1, -1);
+ FTracking := False;
+ MouseCapture := False;
+ end;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.TrackButton(X,Y: Integer);
+var
+ NewState: Boolean;
+ R: TRect;
+begin
+ R := ButtonRect;
+ NewState := PtInRect(R, Point(X, Y));
+ if FPressed <> NewState then
+ begin
+ FPressed := NewState;
+ InvalidateRect(Handle, @R, False);
+ end;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.UpdateContents;
+var
+ Column: TTntColumn;
+ NewStyle: TEditStyle;
+ MasterField: TField;
+begin
+ with (Grid as TTntCustomDBGrid) do
+ Column := Columns[SelectedIndex];
+ NewStyle := esSimple;
+ case Column.ButtonStyle of
+ cbsEllipsis: NewStyle := esEllipsis;
+ cbsAuto:
+ if Assigned(Column.Field) then
+ with Column.Field do
+ begin
+ { Show the dropdown button only if the field is editable }
+ if FieldKind = fkLookup then
+ begin
+ MasterField := Dataset.FieldByName(KeyFields);
+ { Column.DefaultReadonly will always be True for a lookup field.
+ Test if Column.ReadOnly has been assigned a value of True }
+ if Assigned(MasterField) and MasterField.CanModify and
+ not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
+ with (Grid as TTntCustomDBGrid) do
+ if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
+ NewStyle := esDataList
+ end
+ else
+ if Assigned(Column.PickList{TNT-ALLOW PickList})
+ and (Column.PickList{TNT-ALLOW PickList}.Count > 0)
+ and (not Column.Readonly) then
+ NewStyle := esPickList
+ else if DataType in [ftDataset, ftReference] then
+ NewStyle := esEllipsis;
+ end;
+ end;
+ EditStyle := NewStyle;
+ inherited UpdateContents;
+ Font.Assign(Column.Font);
+ ImeMode := Column.ImeMode;
+ ImeName := Column.ImeName;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.CMCancelMode(var Message: TCMCancelMode);
+begin
+ if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
+ CloseUp(False);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.WMCancelMode(var Message: TMessage);
+begin
+ StopTracking;
+ inherited;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.WMKillFocus(var Message: TMessage);
+begin
+ if not SysLocale.FarEast then inherited
+ else
+ begin
+ ImeName := Screen.DefaultIme;
+ ImeMode := imDontCare;
+ inherited;
+ if HWND(Message.WParam) <> (Grid as TTntCustomDBGrid).Handle then
+ ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
+ end;
+ CloseUp(False);
+end;
+
+function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.ButtonRect: TRect;
+begin
+ if not (Owner as TTntCustomDBGrid).UseRightToLeftAlignment then
+ Result := Rect(Width - FButtonWidth, 0, Width, Height)
+ else
+ Result := Rect(0, 0, FButtonWidth, Height);
+end;
+
+function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.OverButton(const P: TPoint): Boolean;
+begin
+ Result := PtInRect(ButtonRect, P);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.WMLButtonDblClk(var Message: TWMLButtonDblClk);
+begin
+ with Message do
+ if (FEditStyle <> esSimple) and OverButton(Point(XPos, YPos)) then
+ Exit;
+ inherited;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.WMPaint(var Message: TWMPaint);
+begin
+ PaintHandler(Message);
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.WMSetCursor(var Message: TWMSetCursor);
+var
+ P: TPoint;
+begin
+ GetCursorPos(P);
+ P := ScreenToClient(P);
+ if (FEditStyle <> esSimple) and OverButton(P) then
+ Windows.SetCursor(LoadCursor(0, idc_Arrow))
+ else
+ inherited;
+end;
+
+procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.WndProc(var Message: TMessage);
+begin
+ case Message.Msg of
+ wm_KeyDown, wm_SysKeyDown, wm_Char:
+ if EditStyle in [esPickList, esDataList] then
+ with TWMKey(Message) do
+ begin
+ DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
+ if (CharCode <> 0) and FListVisible then
+ begin
+ with TMessage(Message) do
+ SendMessage(FActiveList.Handle, Msg, WParam, LParam);
+ Exit;
+ end;
+ end
+ end;
+ inherited;
+end;
+{$ENDIF}
+//-----------------------------------------------------------------------------------------
+
+{ TTntDBGridInplaceEdit }
+
+procedure TTntDBGridInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
+begin
+ TntCustomEdit_CreateWindowHandle(Self, Params);
+end;
+
+function TTntDBGridInplaceEdit.GetText: WideString;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntDBGridInplaceEdit.SetText(const Value: WideString);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntDBGridInplaceEdit.WMSetText(var Message: TWMSetText);
+begin
+ if (not FBlockSetText) then
+ inherited;
+end;
+
+procedure TTntDBGridInplaceEdit.UpdateContents;
+var
+ Grid: TTntCustomDBGrid;
+begin
+ Grid := Self.Grid as TTntCustomDBGrid;
+ EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
+ Text := Grid.GetEditText(Grid.Col, Grid.Row);
+ MaxLength := Grid.GetEditLimit;
+
+ FBlockSetText := True;
+ try
+ inherited;
+ finally
+ FBlockSetText := False;
+ end;
+end;
+
+procedure TTntDBGridInplaceEdit.DblClick;
+begin
+ FInDblClick := True;
+ try
+ inherited;
+ finally
+ FInDblClick := False;
+ end;
+end;
+
+{ TTntGridDataLink }
+
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
+type
+ THackGridDataLink = class(TDataLink)
+ protected
+ FGrid: TCustomDBGrid{TNT-ALLOW TCustomDBGrid};
+ end;
+{$ENDIF}
+
+{$IFNDEF COMPILER_6_UP}
+function TTntGridDataLink.Grid: TCustomDBGrid{TNT-ALLOW TCustomDBGrid};
+begin
+ Result := THackGridDataLink(Self).FGrid;
+end;
+{$ENDIF}
+
+procedure TTntGridDataLink.GridUpdateFieldText(Sender: TField; const Text: AnsiString);
+begin
+ Sender.OnSetText := OriginalSetText;
+ if Assigned(Sender) then
+ SetWideText(Sender, (Grid as TTntCustomDBGrid).FEditText);
+end;
+
+procedure TTntGridDataLink.RecordChanged(Field: TField);
+var
+ CField: TField;
+begin
+ inherited;
+ if Grid.HandleAllocated then begin
+ CField := Grid.SelectedField;
+ if ((Field = nil) or (CField = Field)) and
+ (Assigned(CField) and (GetWideText(CField) <> (Grid as TTntCustomDBGrid).FEditText)) then
+ begin
+ with (Grid as TTntCustomDBGrid) do begin
+ InvalidateEditor;
+ if InplaceEditor <> nil then InplaceEditor.Deselect;
+ end;
+ end;
+ end;
+end;
+
+procedure TTntGridDataLink.UpdateData;
+var
+ Field: TField;
+begin
+ Field := (Grid as TTntCustomDBGrid).SelectedField;
+ // remember "set text"
+ if Field <> nil then
+ OriginalSetText := Field.OnSetText;
+ try
+ // redirect "set text" to self
+ if Field <> nil then
+ Field.OnSetText := GridUpdateFieldText;
+ inherited; // clear modified !
+ finally
+ // redirect "set text" to field
+ if Field <> nil then
+ Field.OnSetText := OriginalSetText;
+ // forget original "set text"
+ OriginalSetText := nil;
+ end;
+end;
+
+{ TTntDBGridColumns }
+
+function TTntDBGridColumns.Add: TTntColumn;
+begin
+ Result := inherited Add as TTntColumn;
+end;
+
+function TTntDBGridColumns.GetColumn(Index: Integer): TTntColumn;
+begin
+ Result := inherited Items[Index] as TTntColumn;
+end;
+
+procedure TTntDBGridColumns.SetColumn(Index: Integer; const Value: TTntColumn);
+begin
+ inherited Items[Index] := Value;
+end;
+
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
+type
+ THackCustomDBGrid = class(TCustomGrid)
+ protected
+ FIndicators: TImageList;
+ FTitleFont: TFont;
+ FReadOnly: Boolean;
+ FOriginalImeName: TImeName;
+ FOriginalImeMode: TImeMode;
+ FUserChange: Boolean;
+ FIsESCKey: Boolean;
+ FLayoutFromDataset: Boolean;
+ FOptions: TDBGridOptions;
+ FTitleOffset, FIndicatorOffset: Byte;
+ FUpdateLock: Byte;
+ FLayoutLock: Byte;
+ FInColExit: Boolean;
+ FDefaultDrawing: Boolean;
+ FSelfChangingTitleFont: Boolean;
+ FSelecting: Boolean;
+ FSelRow: Integer;
+ FDataLink: TGridDataLink;
+ end;
+{$ENDIF}
+
+{ TTntCustomDBGrid }
+
+constructor TTntCustomDBGrid.Create(AOwner: TComponent);
+begin
+ inherited;
+ {$IFNDEF COMPILER_6_UP}
+ DataLink.Free;
+ THackCustomDBGrid(Self).FDataLink := TTntGridDataLink.Create(Self);
+ {$ENDIF}
+end;
+
+procedure TTntCustomDBGrid.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, '');
+end;
+
+type TAccessCustomGrid = class(TCustomGrid);
+
+procedure TTntCustomDBGrid.WMChar(var Msg: TWMChar);
+begin
+ if (goEditing in TAccessCustomGrid(Self).Options)
+ and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
+ RestoreWMCharMsg(TMessage(Msg));
+ ShowEditorChar(WideChar(Msg.CharCode));
+ end else
+ inherited;
+end;
+
+procedure TTntCustomDBGrid.ShowEditorChar(Ch: WideChar);
+begin
+ ShowEditor;
+ if InplaceEditor <> nil then begin
+ if Win32PlatformIsUnicode then
+ PostMessageW(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0)
+ else
+ PostMessageA(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0);
+ end;
+end;
+
+procedure TTntCustomDBGrid.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntCustomDBGrid.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomDBGrid.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntCustomDBGrid.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+function TTntCustomDBGrid.CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns};
+begin
+ Result := TTntDBGridColumns.Create(Self, TTntColumn);
+end;
+
+function TTntCustomDBGrid.GetColumns: TTntDBGridColumns;
+begin
+ Result := inherited Columns as TTntDBGridColumns;
+end;
+
+procedure TTntCustomDBGrid.SetColumns(const Value: TTntDBGridColumns);
+begin
+ inherited Columns := Value;
+end;
+
+function TTntCustomDBGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
+begin
+ Result := TTntDBGridInplaceEdit.Create(Self);
+end;
+
+{$IFDEF COMPILER_6_UP}
+function TTntCustomDBGrid.CreateDataLink: TGridDataLink;
+begin
+ Result := TTntGridDataLink.Create(Self);
+end;
+{$ENDIF}
+
+function TTntCustomDBGrid.GetEditText(ACol, ARow: Integer): WideString;
+var
+ Field: TField;
+begin
+ Field := GetColField(RawToDataColumn(ACol));
+ if Field = nil then
+ Result := ''
+ else
+ Result := GetWideText(Field);
+ FEditText := Result;
+end;
+
+procedure TTntCustomDBGrid.SetEditText(ACol, ARow: Integer; const Value: AnsiString);
+begin
+ if (InplaceEditor as TTntDBGridInplaceEdit).FInDblClick then
+ FEditText := Value
+ else
+ FEditText := (InplaceEditor as TTntDBGridInplaceEdit).Text;
+ inherited;
+end;
+
+//----------------- DRAW CELL PROCS --------------------------------------------------
+var
+ DrawBitmap: TBitmap = nil;
+
+procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
+ const Text: WideString; Alignment: TAlignment; ARightToLeft: Boolean);
+const
+ AlignFlags : array [TAlignment] of Integer =
+ ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
+ DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
+ DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
+ RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
+var
+ B, R: TRect;
+ Hold, Left: Integer;
+ I: TColorRef;
+begin
+ I := ColorToRGB(ACanvas.Brush.Color);
+ if GetNearestColor(ACanvas.Handle, I) = I then
+ begin { Use ExtTextOutW for solid colors }
+ { In BiDi, because we changed the window origin, the text that does not
+ change alignment, actually gets its alignment changed. }
+ if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
+ ChangeBiDiModeAlignment(Alignment);
+ case Alignment of
+ taLeftJustify:
+ Left := ARect.Left + DX;
+ taRightJustify:
+ Left := ARect.Right - WideCanvasTextWidth(ACanvas, Text) - 3;
+ else { taCenter }
+ Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
+ - (WideCanvasTextWidth(ACanvas, Text) shr 1);
+ end;
+ WideCanvasTextRect(ACanvas, ARect, Left, ARect.Top + DY, Text);
+ end
+ else begin { Use FillRect and Drawtext for dithered colors }
+ DrawBitmap.Canvas.Lock;
+ try
+ with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
+ begin { brush origin tics in painting / scrolling. }
+ Width := Max(Width, Right - Left);
+ Height := Max(Height, Bottom - Top);
+ R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
+ B := Rect(0, 0, Right - Left, Bottom - Top);
+ end;
+ with DrawBitmap.Canvas do
+ begin
+ Font := ACanvas.Font;
+ Font.Color := ACanvas.Font.Color;
+ Brush := ACanvas.Brush;
+ Brush.Style := bsSolid;
+ FillRect(B);
+ SetBkMode(Handle, TRANSPARENT);
+ if (ACanvas.CanvasOrientation = coRightToLeft) then
+ ChangeBiDiModeAlignment(Alignment);
+ Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), R,
+ AlignFlags[Alignment] or RTL[ARightToLeft]);
+ end;
+ if (ACanvas.CanvasOrientation = coRightToLeft) then
+ begin
+ Hold := ARect.Left;
+ ARect.Left := ARect.Right;
+ ARect.Right := Hold;
+ end;
+ ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
+ finally
+ DrawBitmap.Canvas.Unlock;
+ end;
+ end;
+end;
+
+procedure TTntCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
+ State: TGridDrawState);
+var
+ Alignment: TAlignment;
+ Value: WideString;
+begin
+ Alignment := taLeftJustify;
+ Value := '';
+ if Assigned(Field) then
+ begin
+ Alignment := Field.Alignment;
+ Value := GetWideDisplayText(Field);
+ end;
+ WriteText(Canvas, Rect, 2, 2, Value, Alignment,
+ UseRightToLeftAlignmentForField(Field, Alignment));
+end;
+
+procedure TTntCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
+ DataCol: Integer; Column: TTntColumn; State: TGridDrawState);
+var
+ Value: WideString;
+begin
+ Value := '';
+ if Assigned(Column.Field) then
+ Value := GetWideDisplayText(Column.Field);
+ WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment,
+ UseRightToLeftAlignmentForField(Column.Field, Column.Alignment));
+end;
+
+procedure TTntCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
+var
+ FrameOffs: Byte;
+
+ procedure DrawTitleCell(ACol, ARow: Integer; Column: TTntColumn; var AState: TGridDrawState);
+ const
+ ScrollArrows: array [Boolean, Boolean] of Integer =
+ ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
+ var
+ MasterCol: TColumn{TNT-ALLOW TColumn};
+ TitleRect, TxtRect, ButtonRect: TRect;
+ I: Integer;
+ InBiDiMode: Boolean;
+ begin
+ TitleRect := CalcTitleRect(Column, ARow, MasterCol);
+
+ if MasterCol = nil then
+ begin
+ Canvas.FillRect(ARect);
+ Exit;
+ end;
+
+ Canvas.Font := MasterCol.Title.Font;
+ Canvas.Brush.Color := MasterCol.Title.Color;
+ if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
+ InflateRect(TitleRect, -1, -1);
+ TxtRect := TitleRect;
+ I := GetSystemMetrics(SM_CXHSCROLL);
+ if ((TxtRect.Right - TxtRect.Left) > I) and MasterCol.Expandable then
+ begin
+ Dec(TxtRect.Right, I);
+ ButtonRect := TitleRect;
+ ButtonRect.Left := TxtRect.Right;
+ I := SaveDC(Canvas.Handle);
+ try
+ Canvas.FillRect(ButtonRect);
+ InflateRect(ButtonRect, -1, -1);
+ IntersectClipRect(Canvas.Handle, ButtonRect.Left,
+ ButtonRect.Top, ButtonRect.Right, ButtonRect.Bottom);
+ InflateRect(ButtonRect, 1, 1);
+ { DrawFrameControl doesn't draw properly when orienatation has changed.
+ It draws as ExtTextOutW does. }
+ InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
+ if InBiDiMode then { stretch the arrows box }
+ Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
+ DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
+ ScrollArrows[InBiDiMode, MasterCol.Expanded] or DFCS_FLAT);
+ finally
+ RestoreDC(Canvas.Handle, I);
+ end;
+ end;
+ with (MasterCol.Title as TTntColumnTitle) do
+ WriteText(Canvas, TxtRect, FrameOffs, FrameOffs, Caption, Alignment, IsRightToLeft);
+ if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
+ begin
+ InflateRect(TitleRect, 1, 1);
+ DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
+ DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
+ end;
+ AState := AState - [gdFixed]; // prevent box drawing later
+ end;
+
+var
+ OldActive: Integer;
+ Highlight: Boolean;
+ Value: WideString;
+ DrawColumn: TTntColumn;
+begin
+ if csLoading in ComponentState then
+ begin
+ Canvas.Brush.Color := Color;
+ Canvas.FillRect(ARect);
+ Exit;
+ end;
+
+ if (gdFixed in AState) and (RawToDataColumn(ACol) < 0) then
+ begin
+ inherited;
+ exit;
+ end;
+
+ Dec(ARow, FixedRows);
+ ACol := RawToDataColumn(ACol);
+
+ if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
+ [dgRowLines, dgColLines]) then
+ begin
+ InflateRect(ARect, -1, -1);
+ FrameOffs := 1;
+ end
+ else
+ FrameOffs := 2;
+
+ with Canvas do
+ begin
+ DrawColumn := Columns[ACol] as TTntColumn;
+ if not DrawColumn.Showing then Exit;
+ if not (gdFixed in AState) then
+ begin
+ Font := DrawColumn.Font;
+ Brush.Color := DrawColumn.Color;
+ end;
+ if ARow < 0 then
+ DrawTitleCell(ACol, ARow + FixedRows, DrawColumn, AState)
+ else if (DataLink = nil) or not DataLink.Active then
+ FillRect(ARect)
+ else
+ begin
+ Value := '';
+ OldActive := DataLink.ActiveRecord;
+ try
+ DataLink.ActiveRecord := ARow;
+ if Assigned(DrawColumn.Field) then
+ Value := GetWideDisplayText(DrawColumn.Field);
+ Highlight := HighlightCell(ACol, ARow, Value, AState);
+ if Highlight then
+ begin
+ Brush.Color := clHighlight;
+ Font.Color := clHighlightText;
+ end;
+ if not Enabled then
+ Font.Color := clGrayText;
+ if DefaultDrawing then
+ DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);
+ if Columns.State = csDefault then
+ DrawDataCell(ARect, DrawColumn.Field, AState);
+ DrawColumnCell(ARect, ACol, DrawColumn, AState);
+ finally
+ DataLink.ActiveRecord := OldActive;
+ end;
+ if DefaultDrawing and (gdSelected in AState)
+ and ((dgAlwaysShowSelection in Options) or Focused)
+ and not (csDesigning in ComponentState)
+ and not (dgRowSelect in Options)
+ and (UpdateLock = 0)
+ and (ValidParentForm(Self).ActiveControl = Self) then
+ Windows.DrawFocusRect(Handle, ARect);
+ end;
+ end;
+ if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
+ [dgRowLines, dgColLines]) then
+ begin
+ InflateRect(ARect, 1, 1);
+ DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
+ DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
+ end;
+end;
+
+procedure TTntCustomDBGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomDBGrid.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+initialization
+ DrawBitmap := TBitmap.Create;
+
+finalization
+ DrawBitmap.Free;
+
+end.
Added: trunk/TntUnicodeControls/TntDBLogDlg.dfm
===================================================================
--- trunk/TntUnicodeControls/TntDBLogDlg.dfm 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntDBLogDlg.dfm 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,108 @@
+object TntLoginDialog: TTntLoginDialog
+ Left = 307
+ Top = 131
+ ActiveControl = Password
+ BorderStyle = bsDialog
+ Caption = 'Database Login'
+ ClientHeight = 147
+ ClientWidth = 273
+ Color = clBtnFace
+ ParentFont = True
+ OldCreateOrder = True
+ Position = poScreenCenter
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 13
+ object OKButton: TTntButton
+ Left = 109
+ Top = 114
+ Width = 75
+ Height = 25
+ Caption = '&OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 0
+ end
+ object CancelButton: TTntButton
+ Left = 190
+ Top = 114
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 1
+ end
+ object Panel: TTntPanel
+ Left = 8
+ Top = 7
+ Width = 257
+ Height = 98
+ BevelInner = bvRaised
+ BevelOuter = bvLowered
+ TabOrder = 2
+ object Label3: TTntLabel
+ Left = 10
+ Top = 6
+ Width = 50
+ Height = 13
+ Caption = 'Database:'
+ end
+ object DatabaseName: TTntLabel
+ Left = 91
+ Top = 6
+ Width = 3
+ Height = 13
+ end
+ object Bevel: TTntBevel
+ Left = 1
+ Top = 24
+ Width = 254
+ Height = 9
+ Shape = bsTopLine
+ end
+ object Panel1: TTntPanel
+ Left = 2
+ Top = 31
+ Width = 253
+ Height = 65
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 0
+ object Label1: TTntLabel
+ Left = 8
+ Top = 8
+ Width = 56
+ Height = 13
+ Caption = '&User Name:'
+ FocusControl = UserName
+ end
+ object Label2: TTntLabel
+ Left = 8
+ Top = 36
+ Width = 50
+ Height = 13
+ Caption = '&Password:'
+ FocusControl = Password
+ end
+ object UserName: TTntEdit
+ Left = 86
+ Top = 5
+ Width = 153
+ Height = 21
+ MaxLength = 31
+ TabOrder = 0
+ end
+ object Password: TTntEdit
+ Left = 86
+ Top = 33
+ Width = 153
+ Height = 21
+ MaxLength = 31
+ PasswordCharW = #9679
+ TabOrder = 1
+ PasswordChar_UTF7 = '+Jc8'
+ end
+ end
+ end
+end
Added: trunk/TntUnicodeControls/TntDBLogDlg.pas
===================================================================
--- trunk/TntUnicodeControls/TntDBLogDlg.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntDBLogDlg.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,138 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntDBLogDlg;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ SysUtils, Windows, Messages, Classes, Graphics, Controls,
+ TntForms, TntStdCtrls, TntExtCtrls, StdCtrls, ExtCtrls;
+
+type
+ TTntLoginDialog = class(TTntForm{TNT-ALLOW TTntForm})
+ Panel: TTntPanel;
+ Bevel: TTntBevel;
+ DatabaseName: TTntLabel;
+ OKButton: TTntButton;
+ CancelButton: TTntButton;
+ Panel1: TTntPanel;
+ Label1: TTntLabel;
+ Label2: TTntLabel;
+ Label3: TTntLabel;
+ Password: TTntEdit;
+ UserName: TTntEdit;
+ procedure FormShow(Sender: TObject);
+ end;
+
+{TNT-WARN LoginDialog}
+function TntLoginDialog(const ADatabaseName: WideString;
+ var AUserName, APassword: WideString): Boolean;
+
+{TNT-WARN LoginDialogEx}
+function TntLoginDialogEx(const ADatabaseName: WideString;
+ var AUserName, APassword: WideString; NameReadOnly: Boolean): Boolean;
+
+{TNT-WARN RemoteLoginDialog}
+function TntRemoteLoginDialog(var AUserName, APassword: WideString): Boolean;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ Forms {$IFDEF COMPILER_6_UP}, VDBConsts {$ENDIF};
+
+function TntLoginDialog(const ADatabaseName: WideString;
+ var AUserName, APassword: WideString): Boolean;
+begin
+ with TTntLoginDialog.Create(Application) do
+ try
+ DatabaseName.Caption := ADatabaseName;
+ UserName.Text := AUserName;
+ Result := False;
+ if AUserName = '' then ActiveControl := UserName;
+ if ShowModal = mrOk then
+ begin
+ AUserName := UserName.Text;
+ APassword := Password.Text;
+ Result := True;
+ end;
+ finally
+ Free;
+ end;
+end;
+
+function TntLoginDialogEx(const ADatabaseName: WideString;
+ var AUserName, APassword: WideString; NameReadOnly: Boolean): Boolean;
+begin
+ with TTntLoginDialog.Create(Application) do
+ try
+ DatabaseName.Caption := ADatabaseName;
+ UserName.Text := AUserName;
+ Result := False;
+ if NameReadOnly then
+ UserName.Enabled := False
+ else
+ if AUserName = '' then ActiveControl := UserName;
+ if ShowModal = mrOk then
+ begin
+ AUserName := UserName.Text;
+ APassword := Password.Text;
+ Result := True;
+ end;
+ finally
+ Free;
+ end;
+end;
+
+{$IFNDEF COMPILER_6_UP}
+resourcestring
+ SRemoteLogin = 'Remote Login';
+{$ENDIF}
+
+function TntRemoteLoginDialog(var AUserName, APassword: WideString): Boolean;
+begin
+ with TTntLoginDialog.Create(Application) do
+ try
+ Caption := SRemoteLogin;
+ Bevel.Visible := False;
+ DatabaseName.Visible := False;
+ Label3.Visible := False;
+ Panel.Height := Panel.Height - Bevel.Top;
+ OKButton.Top := OKButton.Top - Bevel.Top;
+ CancelButton.Top := CancelButton.Top - Bevel.Top;
+ Height := Height - Bevel.Top;
+ UserName.Text := AUserName;
+ Result := False;
+ if AUserName = '' then ActiveControl := UserName;
+ if ShowModal = mrOk then
+ begin
+ AUserName := UserName.Text;
+ APassword := Password.Text;
+ Result := True;
+ end;
+ finally
+ Free;
+ end;
+end;
+
+{ TTntLoginDialog }
+
+procedure TTntLoginDialog.FormShow(Sender: TObject);
+begin
+ if (DatabaseName.Width + DatabaseName.Left) >= Panel.ClientWidth then
+ DatabaseName.Width := (Panel.ClientWidth - DatabaseName.Left) - 5;
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntDbCtrls.pas
===================================================================
--- trunk/TntUnicodeControls/TntDbCtrls.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntDbCtrls.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,2160 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntDbCtrls;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Forms, Classes, Windows, Messages, DB, DBCtrls, Controls, StdCtrls,
+ TntClasses, TntStdCtrls, TntControls, TntComCtrls, TntExtCtrls;
+
+type
+{TNT-WARN TPaintControl}
+ TTntPaintControl = class
+ private
+ FOwner: TWinControl;
+ FClassName: WideString;
+ FHandle: HWnd;
+ FObjectInstance: Pointer;
+ FDefWindowProc: Pointer;
+ FCtl3dButton: Boolean;
+ function GetHandle: HWnd;
+ procedure SetCtl3DButton(Value: Boolean);
+ procedure WndProc(var Message: TMessage);
+ public
+ constructor Create(AOwner: TWinControl; const ClassName: WideString);
+ destructor Destroy; override;
+ procedure DestroyHandle;
+ property Ctl3DButton: Boolean read FCtl3dButton write SetCtl3dButton;
+ property Handle: HWnd read GetHandle;
+ end;
+
+type
+{TNT-WARN TDBEdit}
+ TTntDBEdit = class(TDBEdit{TNT-ALLOW TDBEdit})
+ private
+ InheritedDataChange: TNotifyEvent;
+ FPasswordChar: WideChar;
+ procedure DataChange(Sender: TObject);
+ procedure UpdateData(Sender: TObject);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
+ function GetTextMargins: TPoint;
+ function GetPasswordChar: WideChar;
+ procedure SetPasswordChar(const Value: WideChar);
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ private
+ function GetSelStart: Integer; reintroduce; virtual;
+ procedure SetSelStart(const Value: Integer); reintroduce; virtual;
+ function GetSelLength: Integer; reintroduce; virtual;
+ procedure SetSelLength(const Value: Integer); reintroduce; virtual;
+ function GetSelText: WideString; reintroduce;
+ procedure SetSelText(const Value: WideString);
+ function GetText: WideString;
+ procedure SetText(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property SelText: WideString read GetSelText write SetSelText;
+ property SelStart: Integer read GetSelStart write SetSelStart;
+ property SelLength: Integer read GetSelLength write SetSelLength;
+ property Text: WideString read GetText write SetText;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
+ end;
+
+{TNT-WARN TDBText}
+ TTntDBText = class(TDBText{TNT-ALLOW TDBText})
+ private
+ FDataLink: TFieldDataLink;
+ InheritedDataChange: TNotifyEvent;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
+ procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
+ function GetCaption: TWideCaption;
+ function IsCaptionStored: Boolean;
+ procedure SetCaption(const Value: TWideCaption);
+ function GetFieldText: WideString;
+ procedure DataChange(Sender: TObject);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetLabelText: WideString; reintroduce; virtual;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TDBComboBox}
+ TTntCustomDBComboBox = class(TDBComboBox{TNT-ALLOW TDBComboBox},
+ IWideCustomListControl)
+ private
+ FDataLink: TFieldDataLink;
+ {$IFDEF COMPILER_6_UP}
+ FFilter: WideString;
+ FLastTime: Cardinal;
+ {$ENDIF}
+ procedure UpdateData(Sender: TObject);
+ procedure EditingChange(Sender: TObject);
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ procedure SetReadOnly;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure WMChar(var Message: TWMChar); message WM_CHAR;
+ private
+ FItems: TTntStrings;
+ FSaveItems: TTntStrings;
+ FSaveItemIndex: integer;
+ function GetItems: TTntStrings;
+ procedure SetItems(const Value: TTntStrings); reintroduce;
+ function GetSelStart: Integer;
+ procedure SetSelStart(const Value: Integer);
+ function GetSelLength: Integer;
+ procedure SetSelLength(const Value: Integer);
+ function GetSelText: WideString;
+ procedure SetSelText(const Value: WideString);
+ function GetText: WideString;
+ procedure SetText(const Value: WideString);
+
+ procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
+ protected
+ procedure DataChange(Sender: TObject);
+ function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
+ function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
+ procedure DoEditCharMsg(var Message: TWMChar); virtual;
+ function GetFieldValue: Variant; virtual;
+ procedure SetFieldValue(const Value: Variant); virtual;
+ function GetComboValue: Variant; virtual; abstract;
+ procedure SetComboValue(const Value: Variant); virtual; abstract;
+ {$IFDEF DELPHI_7}
+ function GetItemsClass: TCustomComboBoxStringsClass; override;
+ {$ENDIF}
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure CreateWnd; override;
+ procedure DestroyWnd; override;
+ procedure WndProc(var Message: TMessage); override;
+ procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
+ procedure KeyPress(var Key: AnsiChar); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+{$IFDEF COMPILER_6_UP}
+ procedure CopySelection(Destination: TCustomListControl); override;
+{$ENDIF}
+ procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
+ public
+ property SelText: WideString read GetSelText write SetSelText;
+ property SelStart: Integer read GetSelStart write SetSelStart;
+ property SelLength: Integer read GetSelLength write SetSelLength;
+ property Text: WideString read GetText write SetText;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ property Items: TTntStrings read GetItems write SetItems;
+ end;
+
+ TTntDBComboBox = class(TTntCustomDBComboBox)
+ protected
+ function GetFieldValue: Variant; override;
+ procedure SetFieldValue(const Value: Variant); override;
+ function GetComboValue: Variant; override;
+ procedure SetComboValue(const Value: Variant); override;
+ end;
+
+type
+{TNT-WARN TDBCheckBox}
+ TTntDBCheckBox = class(TDBCheckBox{TNT-ALLOW TDBCheckBox})
+ private
+ function GetCaption: TWideCaption;
+ procedure SetCaption(const Value: TWideCaption);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsCaptionStored: Boolean;
+ function IsHintStored: Boolean;
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure Toggle; override;
+ published
+ property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TDBRichEdit}
+ TTntDBRichEdit = class(TTntCustomRichEdit)
+ private
+ FDataLink: TFieldDataLink;
+ FAutoDisplay: Boolean;
+ FFocused: Boolean;
+ FMemoLoaded: Boolean;
+ FDataSave: AnsiString;
+ procedure BeginEditing;
+ procedure DataChange(Sender: TObject);
+ procedure EditingChange(Sender: TObject);
+ function GetDataField: string{TNT-ALLOW string};
+ function GetDataSource: TDataSource;
+ function GetField: TField;
+ function GetReadOnly: Boolean;
+ procedure SetDataField(const Value: string{TNT-ALLOW string});
+ procedure SetDataSource(Value: TDataSource);
+ procedure SetReadOnly(Value: Boolean);
+ procedure SetAutoDisplay(Value: Boolean);
+ procedure SetFocused(Value: Boolean);
+ procedure UpdateData(Sender: TObject);
+ procedure WMCut(var Message: TMessage); message WM_CUT;
+ procedure WMPaste(var Message: TMessage); message WM_PASTE;
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ procedure CMExit(var Message: TCMExit); message CM_EXIT;
+ procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
+ procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
+ procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
+ protected
+ procedure InternalLoadMemo; dynamic;
+ procedure InternalSaveMemo; dynamic;
+ protected
+ procedure Change; override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: AnsiChar); override;
+ procedure Loaded; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ procedure LoadMemo; virtual;
+ function UpdateAction(Action: TBasicAction): Boolean; override;
+ function UseRightToLeftAlignment: Boolean; override;
+ property Field: TField read GetField;
+ published
+ property Align;
+ property Alignment;
+ property Anchors;
+ property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property Color;
+ property Constraints;
+ property Ctl3D;
+ property DataField: string{TNT-ALLOW string} read GetDataField write SetDataField;
+ property DataSource: TDataSource read GetDataSource write SetDataSource;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property HideScrollBars;
+ property ImeMode;
+ property ImeName;
+ property MaxLength;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PlainText;
+ property PopupMenu;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ScrollBars;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Visible;
+ property WantReturns;
+ property WantTabs;
+ property WordWrap;
+ property OnChange;
+ property OnClick;
+ property OnContextPopup;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnResizeRequest;
+ property OnSelectionChange;
+ property OnProtectChange;
+ property OnSaveClipboard;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+type
+{TNT-WARN TDBMemo}
+ TTntDBMemo = class(TTntCustomMemo)
+ private
+ FDataLink: TFieldDataLink;
+ FAutoDisplay: Boolean;
+ FFocused: Boolean;
+ FMemoLoaded: Boolean;
+ FPaintControl: TTntPaintControl;
+ procedure DataChange(Sender: TObject);
+ procedure EditingChange(Sender: TObject);
+ function GetDataField: string{TNT-ALLOW string};
+ function GetDataSource: TDataSource;
+ function GetField: TField;
+ function GetReadOnly: Boolean;
+ procedure SetDataField(const Value: string{TNT-ALLOW string});
+ procedure SetDataSource(Value: TDataSource);
+ procedure SetReadOnly(Value: Boolean);
+ procedure SetAutoDisplay(Value: Boolean);
+ procedure SetFocused(Value: Boolean);
+ procedure UpdateData(Sender: TObject);
+ procedure WMCut(var Message: TMessage); message WM_CUT;
+ procedure WMPaste(var Message: TMessage); message WM_PASTE;
+ procedure WMUndo(var Message: TMessage); message WM_UNDO;
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ procedure CMExit(var Message: TCMExit); message CM_EXIT;
+ procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
+ procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
+ procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
+ protected
+ procedure Change; override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
+ procedure Loaded; override;
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ procedure WndProc(var Message: TMessage); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ procedure LoadMemo; virtual;
+ function UpdateAction(Action: TBasicAction): Boolean; override;
+ function UseRightToLeftAlignment: Boolean; override;
+ property Field: TField read GetField;
+ published
+ property Align;
+ property Alignment;
+ property Anchors;
+ property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property Color;
+ property Constraints;
+ property Ctl3D;
+ property DataField: string{TNT-ALLOW string} read GetDataField write SetDataField;
+ property DataSource: TDataSource read GetDataSource write SetDataSource;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property ImeMode;
+ property ImeName;
+ property MaxLength;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ScrollBars;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Visible;
+ property WantReturns;
+ property WantTabs;
+ property WordWrap;
+ property OnChange;
+ property OnClick;
+ property OnContextPopup;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+{ TDBRadioGroup }
+type
+ TTntDBRadioGroup = class(TTntCustomRadioGroup)
+ private
+ FDataLink: TFieldDataLink;
+ FValue: WideString;
+ FValues: TTntStrings;
+ FInSetValue: Boolean;
+ FOnChange: TNotifyEvent;
+ procedure DataChange(Sender: TObject);
+ procedure UpdateData(Sender: TObject);
+ function GetDataField: string{TNT-ALLOW string};
+ function GetDataSource: TDataSource;
+ function GetField: TField;
+ function GetReadOnly: Boolean;
+ function GetButtonValue(Index: Integer): WideString;
+ procedure SetDataField(const Value: string{TNT-ALLOW string});
+ procedure SetDataSource(Value: TDataSource);
+ procedure SetReadOnly(Value: Boolean);
+ procedure SetValue(const Value: WideString);
+ procedure SetItems(Value: TTntStrings);
+ procedure SetValues(Value: TTntStrings);
+ procedure CMExit(var Message: TCMExit); message CM_EXIT;
+ procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
+ protected
+ procedure Change; dynamic;
+ procedure Click; override;
+ procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
+ function CanModify: Boolean; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ property DataLink: TFieldDataLink read FDataLink;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ function UpdateAction(Action: TBasicAction): Boolean; override;
+ function UseRightToLeftAlignment: Boolean; override;
+ property Field: TField read GetField;
+ property ItemIndex;
+ property Value: WideString read FValue write SetValue;
+ published
+ property Align;
+ property Anchors;
+ property BiDiMode;
+ property Caption;
+ property Color;
+ property Columns;
+ property Constraints;
+ property Ctl3D;
+ property DataField: string{TNT-ALLOW string} read GetDataField write SetDataField;
+ property DataSource: TDataSource read GetDataSource write SetDataSource;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property Items write SetItems;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Values: TTntStrings read FValues write SetValues;
+ property Visible;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnContextPopup;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+implementation
+
+uses
+ SysUtils, Graphics, {$IFDEF COMPILER_6_UP} Variants, {$ENDIF} TntDB,
+ TntActnList, TntGraphics, TntSysUtils, RichEdit, Mask;
+
+function FieldIsBlobLike(Field: TField): Boolean;
+begin
+ Result := False;
+ if Assigned(Field) then begin
+ if Field.IsBlob then
+ Result := True
+ else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
+ and (Field.Size = MaxInt) then
+ Result := True; { wide string field filling in for a blob field }
+ end;
+end;
+
+{ TTntPaintControl }
+
+type
+ TAccessWinControl = class(TWinControl);
+
+constructor TTntPaintControl.Create(AOwner: TWinControl; const ClassName: WideString);
+begin
+ FOwner := AOwner;
+ FClassName := ClassName;
+end;
+
+destructor TTntPaintControl.Destroy;
+begin
+ DestroyHandle;
+end;
+
+procedure TTntPaintControl.DestroyHandle;
+begin
+ if FHandle <> 0 then DestroyWindow(FHandle);
+ FreeObjectInstance(FObjectInstance);
+ FHandle := 0;
+ FObjectInstance := nil;
+end;
+
+function TTntPaintControl.GetHandle: HWnd;
+var
+ Params: TCreateParams;
+begin
+ if FHandle = 0 then
+ begin
+ FObjectInstance := MakeObjectInstance(WndProc);
+ TAccessWinControl(FOwner).CreateParams(Params);
+ Params.Style := Params.Style and not (WS_HSCROLL or WS_VSCROLL);
+ if (not Win32PlatformIsUnicode) then begin
+ with Params do
+ FHandle := CreateWindowEx(ExStyle, PAnsiChar(AnsiString(FClassName)),
+ PAnsiChar(TAccessWinControl(FOwner).Text), Style or WS_VISIBLE,
+ X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
+ FDefWindowProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
+ SetWindowLong(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
+ end else begin
+ with Params do
+ FHandle := CreateWindowExW(ExStyle, PWideChar(FClassName),
+ PWideChar(TntControl_GetText(FOwner)), Style or WS_VISIBLE,
+ X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
+ FDefWindowProc := Pointer(GetWindowLongW(FHandle, GWL_WNDPROC));
+ SetWindowLongW(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
+ end;
+ SendMessage(FHandle, WM_SETFONT, TAccessWinControl(FOwner).Font.Handle, 1);
+ end;
+ Result := FHandle;
+end;
+
+procedure TTntPaintControl.SetCtl3DButton(Value: Boolean);
+begin
+ if FHandle <> 0 then DestroyHandle;
+ FCtl3DButton := Value;
+end;
+
+procedure TTntPaintControl.WndProc(var Message: TMessage);
+begin
+ with Message do
+ if (Msg >= CN_CTLCOLORMSGBOX) and (Msg <= CN_CTLCOLORSTATIC) then
+ Result := FOwner.Perform(Msg, WParam, LParam)
+ else if (not Win32PlatformIsUnicode) then
+ Result := CallWindowProcA(FDefWindowProc, FHandle, Msg, WParam, LParam)
+ else
+ Result := CallWindowProcW(FDefWindowProc, FHandle, Msg, WParam, LParam);
+end;
+
+{ THackFieldDataLink }
+type
+ THackFieldDataLink_D5_D6_D7_D9 = class(TDataLink)
+ protected
+ FField: TField;
+ FFieldName: string{TNT-ALLOW string};
+ FControl: TComponent;
+ FEditing: Boolean;
+ FModified: Boolean;
+ end;
+
+{$IFDEF COMPILER_5}
+ THackFieldDataLink = THackFieldDataLink_D5_D6_D7_D9;
+{$ENDIF}
+{$IFDEF COMPILER_6}
+ THackFieldDataLink = THackFieldDataLink_D5_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_7}
+ THackFieldDataLink = THackFieldDataLink_D5_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_9}
+ THackFieldDataLink = THackFieldDataLink_D5_D6_D7_D9;
+{$ENDIF}
+
+{ TTntDBEdit }
+
+type
+ THackDBEdit_D5_D6_D7_D9 = class(TCustomMaskEdit)
+ protected
+ FDataLink: TFieldDataLink;
+ FCanvas: TControlCanvas;
+ FAlignment: TAlignment;
+ FFocused: Boolean;
+ end;
+
+{$IFDEF COMPILER_5}
+ THackDBEdit = THackDBEdit_D5_D6_D7_D9;
+{$ENDIF}
+{$IFDEF COMPILER_6}
+ THackDBEdit = THackDBEdit_D5_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_7}
+ THackDBEdit = THackDBEdit_D5_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_9}
+ THackDBEdit = THackDBEdit_D5_D6_D7_D9;
+{$ENDIF}
+
+constructor TTntDBEdit.Create(AOwner: TComponent);
+begin
+ inherited;
+ InheritedDataChange := THackDBEdit(Self).FDataLink.OnDataChange;
+ THackDBEdit(Self).FDataLink.OnDataChange := DataChange;
+ THackDBEdit(Self).FDataLink.OnUpdateData := UpdateData;
+end;
+
+procedure TTntDBEdit.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, 'EDIT');
+end;
+
+procedure TTntDBEdit.CreateWnd;
+begin
+ inherited;
+ TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
+end;
+
+procedure TTntDBEdit.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDBEdit.GetSelStart: Integer;
+begin
+ Result := TntCustomEdit_GetSelStart(Self);
+end;
+
+procedure TTntDBEdit.SetSelStart(const Value: Integer);
+begin
+ TntCustomEdit_SetSelStart(Self, Value);
+end;
+
+function TTntDBEdit.GetSelLength: Integer;
+begin
+ Result := TntCustomEdit_GetSelLength(Self);
+end;
+
+procedure TTntDBEdit.SetSelLength(const Value: Integer);
+begin
+ TntCustomEdit_SetSelLength(Self, Value);
+end;
+
+function TTntDBEdit.GetSelText: WideString;
+begin
+ Result := TntCustomEdit_GetSelText(Self);
+end;
+
+procedure TTntDBEdit.SetSelText(const Value: WideString);
+begin
+ TntCustomEdit_SetSelText(Self, Value);
+end;
+
+function TTntDBEdit.GetPasswordChar: WideChar;
+begin
+ Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar)
+end;
+
+procedure TTntDBEdit.SetPasswordChar(const Value: WideChar);
+begin
+ TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
+end;
+
+function TTntDBEdit.GetText: WideString;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntDBEdit.SetText(const Value: WideString);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntDBEdit.DataChange(Sender: TObject);
+begin
+ with THackDBEdit(Self), Self do begin
+ if Field = nil then
+ InheritedDataChange(Sender)
+ else begin
+ if FAlignment <> Field.Alignment then
+ begin
+ EditText := ''; {forces update}
+ FAlignment := Field.Alignment;
+ end;
+ EditMask := Field.EditMask;
+ if not (csDesigning in ComponentState) then
+ begin
+ if (Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
+ MaxLength := Field.Size;
+ end;
+ if FFocused and FDataLink.CanModify then
+ Text := GetWideText(Field)
+ else
+ begin
+ Text := GetWideDisplayText(Field);
+ if FDataLink.Editing and THackFieldDataLink(FDataLink).FModified then
+ Modified := True;
+ end;
+ end;
+ end;
+end;
+
+procedure TTntDBEdit.UpdateData(Sender: TObject);
+begin
+ ValidateEdit;
+ SetWideText(Field, Text);
+end;
+
+procedure TTntDBEdit.CMEnter(var Message: TCMEnter);
+var
+ SaveFarEast: Boolean;
+begin
+ SaveFarEast := SysLocale.FarEast;
+ try
+ SysLocale.FarEast := False;
+ inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
+ finally
+ SysLocale.FarEast := SaveFarEast;
+ end;
+end;
+
+function TTntDBEdit.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntDBEdit.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntDBEdit.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntDBEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntDBEdit.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+procedure TTntDBEdit.WMPaint(var Message: TWMPaint);
+const
+ AlignStyle : array[Boolean, TAlignment] of DWORD =
+ ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
+ (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
+var
+ ALeft: Integer;
+ Margins: TPoint;
+ R: TRect;
+ DC: HDC;
+ PS: TPaintStruct;
+ S: WideString;
+ AAlignment: TAlignment;
+ I: Integer;
+begin
+ with THackDBEdit(Self), Self do begin
+ AAlignment := FAlignment;
+ if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
+ if ((AAlignment = taLeftJustify) or FFocused) and (not (csPaintCopy in ControlState))
+ or (not Win32PlatformIsUnicode) then
+ begin
+ inherited;
+ Exit;
+ end;
+ { Since edit controls do not handle justification unless multi-line (and
+ then only poorly) we will draw right and center justify manually unless
+ the edit has the focus. }
+ if FCanvas = nil then
+ begin
+ FCanvas := TControlCanvas.Create;
+ FCanvas.Control := Self;
+ end;
+ DC := Message.DC;
+ if DC = 0 then DC := BeginPaint(Handle, PS);
+ FCanvas.Handle := DC;
+ try
+ FCanvas.Font := Font;
+ with FCanvas do
+ begin
+ R := ClientRect;
+ if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
+ begin
+ Brush.Color := clWindowFrame;
+ FrameRect(R);
+ InflateRect(R, -1, -1);
+ end;
+ Brush.Color := Color;
+ if not Enabled then
+ Font.Color := clGrayText;
+ if (csPaintCopy in ControlState) and (Field <> nil) then
+ begin
+ S := GetWideDisplayText(Field);
+ case CharCase of
+ ecUpperCase: S := Tnt_WideUpperCase(S);
+ ecLowerCase: S := Tnt_WideLowerCase(S);
+ end;
+ end else
+ S := Text { EditText? };
+ if PasswordChar <> #0 then
+ for I := 1 to Length(S) do S[I] := PasswordChar;
+ Margins := GetTextMargins;
+ case AAlignment of
+ taLeftJustify: ALeft := Margins.X;
+ taRightJustify: ALeft := ClientWidth - WideCanvasTextWidth(FCanvas, S) - Margins.X - 1;
+ else
+ ALeft := (ClientWidth - WideCanvasTextWidth(FCanvas, S)) div 2;
+ end;
+ if SysLocale.MiddleEast then UpdateTextFlags;
+ WideCanvasTextRect(FCanvas, R, ALeft, Margins.Y, S);
+ end;
+ finally
+ FCanvas.Handle := 0;
+ if Message.DC = 0 then EndPaint(Handle, PS);
+ end;
+ end;
+end;
+
+function TTntDBEdit.GetTextMargins: TPoint;
+var
+ DC: HDC;
+ SaveFont: HFont;
+ I: Integer;
+ SysMetrics, Metrics: TTextMetric;
+begin
+ if NewStyleControls then
+ begin
+ if BorderStyle = bsNone then I := 0 else
+ if Ctl3D then I := 1 else I := 2;
+ Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
+ Result.Y := I;
+ end else
+ begin
+ if BorderStyle = bsNone then I := 0 else
+ begin
+ DC := GetDC(0);
+ GetTextMetrics(DC, SysMetrics);
+ SaveFont := SelectObject(DC, Font.Handle);
+ GetTextMetrics(DC, Metrics);
+ SelectObject(DC, SaveFont);
+ ReleaseDC(0, DC);
+ I := SysMetrics.tmHeight;
+ if I > Metrics.tmHeight then I := Metrics.tmHeight;
+ I := I div 4;
+ end;
+ Result.X := I;
+ Result.Y := I;
+ end;
+end;
+
+{ TTntDBText }
+
+constructor TTntDBText.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
+ InheritedDataChange := FDataLink.OnDataChange;
+ FDataLink.OnDataChange := DataChange;
+end;
+
+destructor TTntDBText.Destroy;
+begin
+ FDataLink := nil;
+ inherited;
+end;
+
+procedure TTntDBText.CMDialogChar(var Message: TCMDialogChar);
+begin
+ TntLabel_CMDialogChar(Self, Message, Caption);
+end;
+
+function TTntDBText.IsCaptionStored: Boolean;
+begin
+ Result := TntControl_IsCaptionStored(Self)
+end;
+
+function TTntDBText.GetCaption: TWideCaption;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntDBText.SetCaption(const Value: TWideCaption);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntDBText.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDBText.GetLabelText: WideString;
+begin
+ if csPaintCopy in ControlState then
+ Result := GetFieldText
+ else
+ Result := Caption;
+end;
+
+procedure TTntDBText.DoDrawText(var Rect: TRect; Flags: Integer);
+begin
+ if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
+ inherited;
+end;
+
+function TTntDBText.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntDBText.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntDBText.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntDBText.CMHintShow(var Message: TMessage);
+begin
+ ProcessCMHintShowMsg(Message);
+ inherited;
+end;
+
+procedure TTntDBText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntDBText.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntDBText.GetFieldText: WideString;
+begin
+ if Field <> nil then
+ Result := GetWideDisplayText(Field)
+ else
+ if csDesigning in ComponentState then Result := Name else Result := '';
+end;
+
+procedure TTntDBText.DataChange(Sender: TObject);
+begin
+ Caption := GetFieldText;
+end;
+
+{ TTntCustomDBComboBox }
+
+constructor TTntCustomDBComboBox.Create(AOwner: TComponent);
+begin
+ inherited;
+ FItems := TTntComboBoxStrings.Create;
+ TTntComboBoxStrings(FItems).ComboBox := Self;
+ FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnUpdateData := UpdateData;
+ FDataLink.OnEditingChange := EditingChange;
+end;
+
+destructor TTntCustomDBComboBox.Destroy;
+begin
+ FreeAndNil(FItems);
+ FreeAndNil(FSaveItems);
+ FDataLink := nil;
+ inherited;
+end;
+
+procedure TTntCustomDBComboBox.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, 'COMBOBOX');
+end;
+
+procedure TTntCustomDBComboBox.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+type
+ TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
+
+procedure TTntCustomDBComboBox.CreateWnd;
+var
+ PreInheritedAnsiText: AnsiString;
+begin
+ PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
+ inherited;
+ TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
+end;
+
+procedure TTntCustomDBComboBox.DestroyWnd;
+begin
+ TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex);
+ inherited;
+end;
+
+procedure TTntCustomDBComboBox.SetReadOnly;
+begin
+ if (Style in [csDropDown, csSimple]) and HandleAllocated then
+ SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.CanModify), 0);
+end;
+
+procedure TTntCustomDBComboBox.EditingChange(Sender: TObject);
+begin
+ SetReadOnly;
+end;
+
+procedure TTntCustomDBComboBox.CMEnter(var Message: TCMEnter);
+var
+ SaveFarEast: Boolean;
+begin
+ SaveFarEast := SysLocale.FarEast;
+ try
+ SysLocale.FarEast := False;
+ inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
+ finally
+ SysLocale.FarEast := SaveFarEast;
+ end;
+end;
+
+procedure TTntCustomDBComboBox.WndProc(var Message: TMessage);
+begin
+ if (not (csDesigning in ComponentState))
+ and (Message.Msg = CB_SHOWDROPDOWN)
+ and (Message.WParam = 0)
+ and (not FDataLink.Editing) then begin
+ DataChange(Self); {Restore text}
+ Dispatch(Message); {Do NOT call inherited!}
+ end else
+ inherited WndProc(Message);
+end;
+
+procedure TTntCustomDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
+begin
+ if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
+ inherited;
+end;
+
+procedure TTntCustomDBComboBox.KeyPress(var Key: AnsiChar);
+var
+ SaveAutoComplete: Boolean;
+begin
+ TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
+ try
+ inherited;
+ finally
+ TntCombo_AfterKeyPress(Self, SaveAutoComplete);
+ end;
+end;
+
+procedure TTntCustomDBComboBox.DoEditCharMsg(var Message: TWMChar);
+begin
+ {$IFDEF COMPILER_6_UP}
+ TntCombo_AutoCompleteKeyPress(Self, Items, Message,
+ GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
+ {$ENDIF}
+end;
+
+procedure TTntCustomDBComboBox.WMChar(var Message: TWMChar);
+begin
+ {$IFDEF COMPILER_6_UP}
+ TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
+ {$ENDIF}
+ inherited;
+end;
+
+function TTntCustomDBComboBox.GetItems: TTntStrings;
+begin
+ Result := FItems;
+end;
+
+procedure TTntCustomDBComboBox.SetItems(const Value: TTntStrings);
+begin
+ FItems.Assign(Value);
+ DataChange(Self);
+end;
+
+function TTntCustomDBComboBox.GetSelStart: Integer;
+begin
+ Result := TntCombo_GetSelStart(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetSelStart(const Value: Integer);
+begin
+ TntCombo_SetSelStart(Self, Value);
+end;
+
+function TTntCustomDBComboBox.GetSelLength: Integer;
+begin
+ Result := TntCombo_GetSelLength(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetSelLength(const Value: Integer);
+begin
+ TntCombo_SetSelLength(Self, Value);
+end;
+
+function TTntCustomDBComboBox.GetSelText: WideString;
+begin
+ Result := TntCombo_GetSelText(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetSelText(const Value: WideString);
+begin
+ TntCombo_SetSelText(Self, Value);
+end;
+
+function TTntCustomDBComboBox.GetText: WideString;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetText(const Value: WideString);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntCustomDBComboBox.CNCommand(var Message: TWMCommand);
+begin
+ if not TntCombo_CNCommand(Self, Items, Message) then
+ inherited;
+end;
+
+function TTntCustomDBComboBox.GetFieldValue: Variant;
+begin
+ Result := Field.Value;
+end;
+
+procedure TTntCustomDBComboBox.SetFieldValue(const Value: Variant);
+begin
+ Field.Value := Value;
+end;
+
+procedure TTntCustomDBComboBox.DataChange(Sender: TObject);
+begin
+ if not (Style = csSimple) and DroppedDown then Exit;
+ if Field <> nil then
+ SetComboValue(GetFieldValue)
+ else
+ if csDesigning in ComponentState then
+ SetComboValue(Name)
+ else
+ SetComboValue(Null);
+end;
+
+procedure TTntCustomDBComboBox.UpdateData(Sender: TObject);
+begin
+ SetFieldValue(GetComboValue);
+end;
+
+function TTntCustomDBComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
+begin
+ Result := True;
+end;
+
+function TTntCustomDBComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
+begin
+ Result := False;
+end;
+
+function TTntCustomDBComboBox.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomDBComboBox.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntCustomDBComboBox.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomDBComboBox.AddItem(const Item: WideString; AObject: TObject);
+begin
+ TntComboBox_AddItem(Items, Item, AObject);
+end;
+
+{$IFDEF COMPILER_6_UP}
+procedure TTntCustomDBComboBox.CopySelection(Destination: TCustomListControl);
+begin
+ TntComboBox_CopySelection(Items, ItemIndex, Destination);
+end;
+{$ENDIF}
+
+procedure TTntCustomDBComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomDBComboBox.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{$IFDEF DELPHI_7}
+function TTntCustomDBComboBox.GetItemsClass: TCustomComboBoxStringsClass;
+begin
+ Result := TD7PatchedComboBoxStrings;
+end;
+{$ENDIF}
+
+{ TTntDBComboBox }
+
+function TTntDBComboBox.GetFieldValue: Variant;
+begin
+ Result := GetWideText(Field);
+end;
+
+procedure TTntDBComboBox.SetFieldValue(const Value: Variant);
+begin
+ SetWideText(Field, Value);
+end;
+
+procedure TTntDBComboBox.SetComboValue(const Value: Variant);
+var
+ I: Integer;
+ Redraw: Boolean;
+ OldValue: WideString;
+ NewValue: WideString;
+begin
+ OldValue := VarToWideStr(GetComboValue);
+ NewValue := VarToWideStr(Value);
+
+ if NewValue <> OldValue then
+ begin
+ if Style <> csDropDown then
+ begin
+ Redraw := (Style <> csSimple) and HandleAllocated;
+ if Redraw then Items.BeginUpdate;
+ try
+ if NewValue = '' then I := -1 else I := Items.IndexOf(NewValue);
+ ItemIndex := I;
+ finally
+ Items.EndUpdate;
+ end;
+ if I >= 0 then Exit;
+ end;
+ if Style in [csDropDown, csSimple] then Text := NewValue;
+ end;
+end;
+
+function TTntDBComboBox.GetComboValue: Variant;
+var
+ I: Integer;
+begin
+ if Style in [csDropDown, csSimple] then Result := Text else
+ begin
+ I := ItemIndex;
+ if I < 0 then Result := '' else Result := Items[I];
+ end;
+end;
+
+{ TTntDBCheckBox }
+
+procedure TTntDBCheckBox.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, 'BUTTON');
+end;
+
+procedure TTntDBCheckBox.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDBCheckBox.IsCaptionStored: Boolean;
+begin
+ Result := TntControl_IsCaptionStored(Self);
+end;
+
+function TTntDBCheckBox.GetCaption: TWideCaption;
+begin
+ Result := TntControl_GetText(Self)
+end;
+
+procedure TTntDBCheckBox.SetCaption(const Value: TWideCaption);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+function TTntDBCheckBox.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntDBCheckBox.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntDBCheckBox.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntDBCheckBox.Toggle;
+var
+ FDataLink: TDataLink;
+begin
+ inherited;
+ FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
+ FDataLink.UpdateRecord;
+end;
+
+procedure TTntDBCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntDBCheckBox.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntDBRichEdit }
+
+constructor TTntDBRichEdit.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ inherited ReadOnly := True;
+ FAutoDisplay := True;
+ FDataLink := TFieldDataLink.Create;
+ FDataLink.Control := Self;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnEditingChange := EditingChange;
+ FDataLink.OnUpdateData := UpdateData;
+end;
+
+destructor TTntDBRichEdit.Destroy;
+begin
+ FDataLink.Free;
+ FDataLink := nil;
+ inherited Destroy;
+end;
+
+procedure TTntDBRichEdit.Loaded;
+begin
+ inherited Loaded;
+ if (csDesigning in ComponentState) then
+ DataChange(Self)
+end;
+
+procedure TTntDBRichEdit.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (FDataLink <> nil) and
+ (AComponent = DataSource) then DataSource := nil;
+end;
+
+function TTntDBRichEdit.UseRightToLeftAlignment: Boolean;
+begin
+ Result := DBUseRightToLeftAlignment(Self, Field);
+end;
+
+procedure TTntDBRichEdit.BeginEditing;
+begin
+ if not FDataLink.Editing then
+ try
+ if FieldIsBlobLike(Field) then
+ FDataSave := Field.AsString{TNT-ALLOW AsString};
+ FDataLink.Edit;
+ finally
+ FDataSave := '';
+ end;
+end;
+
+procedure TTntDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+ if FMemoLoaded then
+ begin
+ if (Key = VK_DELETE) or (Key = VK_BACK) or
+ ((Key = VK_INSERT) and (ssShift in Shift)) or
+ (((Key = Ord('V')) or (Key = Ord('X'))) and (ssCtrl in Shift)) then
+ BeginEditing;
+ end;
+end;
+
+procedure TTntDBRichEdit.KeyPress(var Key: AnsiChar);
+begin
+ inherited KeyPress(Key);
+ if FMemoLoaded then
+ begin
+ if (Key in [#32..#255]) and (Field <> nil) and
+ not Field.IsValidChar(Key) then
+ begin
+ MessageBeep(0);
+ Key := #0;
+ end;
+ case Key of
+ ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
+ BeginEditing;
+ #27:
+ FDataLink.Reset;
+ end;
+ end else
+ begin
+ if Key = #13 then LoadMemo;
+ Key := #0;
+ end;
+end;
+
+procedure TTntDBRichEdit.Change;
+begin
+ if FMemoLoaded then
+ FDataLink.Modified;
+ FMemoLoaded := True;
+ inherited Change;
+end;
+
+procedure TTntDBRichEdit.CNNotify(var Message: TWMNotify);
+begin
+ inherited;
+ if Message.NMHdr^.code = EN_PROTECTED then
+ Message.Result := 0 { allow the operation (otherwise the control might appear stuck) }
+end;
+
+function TTntDBRichEdit.GetDataSource: TDataSource;
+begin
+ Result := FDataLink.DataSource;
+end;
+
+procedure TTntDBRichEdit.SetDataSource(Value: TDataSource);
+begin
+ FDataLink.DataSource := Value;
+ if Value <> nil then Value.FreeNotification(Self);
+end;
+
+function TTntDBRichEdit.GetDataField: string{TNT-ALLOW string};
+begin
+ Result := FDataLink.FieldName;
+end;
+
+procedure TTntDBRichEdit.SetDataField(const Value: string{TNT-ALLOW string});
+begin
+ FDataLink.FieldName := Value;
+end;
+
+function TTntDBRichEdit.GetReadOnly: Boolean;
+begin
+ Result := FDataLink.ReadOnly;
+end;
+
+procedure TTntDBRichEdit.SetReadOnly(Value: Boolean);
+begin
+ FDataLink.ReadOnly := Value;
+end;
+
+function TTntDBRichEdit.GetField: TField;
+begin
+ Result := FDataLink.Field;
+end;
+
+procedure TTntDBRichEdit.InternalLoadMemo;
+var
+ Stream: TStringStream{TNT-ALLOW TStringStream};
+begin
+ Stream := TStringStream{TNT-ALLOW TStringStream}.Create(Field.AsString{TNT-ALLOW AsString});
+ try
+ Lines.LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TTntDBRichEdit.LoadMemo;
+begin
+ if not FMemoLoaded and Assigned(Field) and FieldIsBlobLike(Field) then
+ begin
+ try
+ InternalLoadMemo;
+ FMemoLoaded := True;
+ except
+ { Rich Edit Load failure }
+ on E:EOutOfResources do
+ Lines.Text := WideFormat('(%s)', [E.Message]);
+ end;
+ EditingChange(Self);
+ end;
+end;
+
+procedure TTntDBRichEdit.DataChange(Sender: TObject);
+begin
+ if Field <> nil then
+ if FieldIsBlobLike(Field) then
+ begin
+ if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
+ begin
+ { Check if the data has changed since we read it the first time }
+ if (FDataSave <> '') and (FDataSave = Field.AsString{TNT-ALLOW AsString}) then Exit;
+ FMemoLoaded := False;
+ LoadMemo;
+ end else
+ begin
+ Text := WideFormat('(%s)', [Field.DisplayLabel]);
+ FMemoLoaded := False;
+ end;
+ end else
+ begin
+ if FFocused and FDataLink.CanModify then
+ Text := GetWideText(Field)
+ else
+ Text := GetWideDisplayText(Field);
+ FMemoLoaded := True;
+ end
+ else
+ begin
+ if csDesigning in ComponentState then Text := Name else Text := '';
+ FMemoLoaded := False;
+ end;
+ if HandleAllocated then
+ RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
+end;
+
+procedure TTntDBRichEdit.EditingChange(Sender: TObject);
+begin
+ inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
+end;
+
+procedure TTntDBRichEdit.InternalSaveMemo;
+var
+ Stream: TStringStream{TNT-ALLOW TStringStream};
+begin
+ Stream := TStringStream{TNT-ALLOW TStringStream}.Create('');
+ try
+ Lines.SaveToStream(Stream);
+ Field.AsString{TNT-ALLOW AsString} := Stream.DataString;
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TTntDBRichEdit.UpdateData(Sender: TObject);
+begin
+ if FieldIsBlobLike(Field) then
+ InternalSaveMemo
+ else
+ SetAsWideString(Field, Text);
+end;
+
+procedure TTntDBRichEdit.SetFocused(Value: Boolean);
+begin
+ if FFocused <> Value then
+ begin
+ FFocused := Value;
+ if not Assigned(Field) or not FieldIsBlobLike(Field) then
+ FDataLink.Reset;
+ end;
+end;
+
+procedure TTntDBRichEdit.CMEnter(var Message: TCMEnter);
+begin
+ SetFocused(True);
+ inherited;
+end;
+
+procedure TTntDBRichEdit.CMExit(var Message: TCMExit);
+begin
+ try
+ FDataLink.UpdateRecord;
+ except
+ SetFocus;
+ raise;
+ end;
+ SetFocused(False);
+ inherited;
+end;
+
+procedure TTntDBRichEdit.SetAutoDisplay(Value: Boolean);
+begin
+ if FAutoDisplay <> Value then
+ begin
+ FAutoDisplay := Value;
+ if Value then LoadMemo;
+ end;
+end;
+
+procedure TTntDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
+begin
+ if not FMemoLoaded then LoadMemo else inherited;
+end;
+
+procedure TTntDBRichEdit.WMCut(var Message: TMessage);
+begin
+ BeginEditing;
+ inherited;
+end;
+
+procedure TTntDBRichEdit.WMPaste(var Message: TMessage);
+begin
+ BeginEditing;
+ inherited;
+end;
+
+procedure TTntDBRichEdit.CMGetDataLink(var Message: TMessage);
+begin
+ Message.Result := Integer(FDataLink);
+end;
+
+function TTntDBRichEdit.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
+ FDataLink.ExecuteAction(Action);
+end;
+
+function TTntDBRichEdit.UpdateAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
+ FDataLink.UpdateAction(Action);
+end;
+
+{ TTntDBMemo }
+
+constructor TTntDBMemo.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ inherited ReadOnly := True;
+ ControlStyle := ControlStyle + [csReplicatable];
+ FAutoDisplay := True;
+ FDataLink := TFieldDataLink.Create;
+ FDataLink.Control := Self;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnEditingChange := EditingChange;
+ FDataLink.OnUpdateData := UpdateData;
+ FPaintControl := TTntPaintControl.Create(Self, 'EDIT');
+end;
+
+destructor TTntDBMemo.Destroy;
+begin
+ FPaintControl.Free;
+ FDataLink.Free;
+ FDataLink := nil;
+ inherited Destroy;
+end;
+
+procedure TTntDBMemo.Loaded;
+begin
+ inherited Loaded;
+ if (csDesigning in ComponentState) then DataChange(Self);
+end;
+
+procedure TTntDBMemo.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if (Operation = opRemove) and (FDataLink <> nil) and
+ (AComponent = DataSource) then DataSource := nil;
+end;
+
+function TTntDBMemo.UseRightToLeftAlignment: Boolean;
+begin
+ Result := DBUseRightToLeftAlignment(Self, Field);
+end;
+
+procedure TTntDBMemo.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+ if FMemoLoaded then
+ begin
+ if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
+ FDataLink.Edit;
+ end;
+end;
+
+procedure TTntDBMemo.KeyPress(var Key: Char{TNT-ALLOW Char});
+begin
+ inherited KeyPress(Key);
+ if FMemoLoaded then
+ begin
+ if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
+ not FDataLink.Field.IsValidChar(Key) then
+ begin
+ MessageBeep(0);
+ Key := #0;
+ end;
+ case Key of
+ ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
+ FDataLink.Edit;
+ #27:
+ FDataLink.Reset;
+ end;
+ end else
+ begin
+ if Key = #13 then LoadMemo;
+ Key := #0;
+ end;
+end;
+
+procedure TTntDBMemo.Change;
+begin
+ if FMemoLoaded then FDataLink.Modified;
+ FMemoLoaded := True;
+ inherited Change;
+end;
+
+function TTntDBMemo.GetDataSource: TDataSource;
+begin
+ Result := FDataLink.DataSource;
+end;
+
+procedure TTntDBMemo.SetDataSource(Value: TDataSource);
+begin
+ if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
+ FDataLink.DataSource := Value;
+ if Value <> nil then Value.FreeNotification(Self);
+end;
+
+function TTntDBMemo.GetDataField: string{TNT-ALLOW string};
+begin
+ Result := FDataLink.FieldName;
+end;
+
+procedure TTntDBMemo.SetDataField(const Value: string{TNT-ALLOW string});
+begin
+ FDataLink.FieldName := Value;
+end;
+
+function TTntDBMemo.GetReadOnly: Boolean;
+begin
+ Result := FDataLink.ReadOnly;
+end;
+
+procedure TTntDBMemo.SetReadOnly(Value: Boolean);
+begin
+ FDataLink.ReadOnly := Value;
+end;
+
+function TTntDBMemo.GetField: TField;
+begin
+ Result := FDataLink.Field;
+end;
+
+procedure TTntDBMemo.LoadMemo;
+begin
+ if not FMemoLoaded and Assigned(FDataLink.Field) and FieldIsBlobLike(FDataLink.Field) then
+ begin
+ try
+ Lines.Text := GetAsWideString(FDataLink.Field);
+ FMemoLoaded := True;
+ except
+ { Memo too large }
+ on E:EInvalidOperation do
+ Lines.Text := WideFormat('(%s)', [E.Message]);
+ end;
+ EditingChange(Self);
+ end;
+end;
+
+procedure TTntDBMemo.DataChange(Sender: TObject);
+begin
+ if FDataLink.Field <> nil then
+ if FieldIsBlobLike(FDataLink.Field) then
+ begin
+ if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
+ begin
+ FMemoLoaded := False;
+ LoadMemo;
+ end else
+ begin
+ Text := WideFormat('(%s)', [FDataLink.Field.DisplayLabel]);
+ FMemoLoaded := False;
+ EditingChange(Self);
+ end;
+ end else
+ begin
+ if FFocused and FDataLink.CanModify then
+ Text := GetWideText(FDataLink.Field)
+ else
+ Text := GetWideDisplayText(FDataLink.Field);
+ FMemoLoaded := True;
+ end
+ else
+ begin
+ if csDesigning in ComponentState then Text := Name else Text := '';
+ FMemoLoaded := False;
+ end;
+ if HandleAllocated then
+ RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
+end;
+
+procedure TTntDBMemo.EditingChange(Sender: TObject);
+begin
+ inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
+end;
+
+procedure TTntDBMemo.UpdateData(Sender: TObject);
+begin
+ SetAsWideString(FDataLink.Field, Text);
+end;
+
+procedure TTntDBMemo.SetFocused(Value: Boolean);
+begin
+ if FFocused <> Value then
+ begin
+ FFocused := Value;
+ if not Assigned(FDataLink.Field) or not FieldIsBlobLike(FDataLink.Field) then
+ FDataLink.Reset;
+ end;
+end;
+
+procedure TTntDBMemo.WndProc(var Message: TMessage);
+begin
+ with Message do
+ if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
+ (Msg = CM_FONTCHANGED) then FPaintControl.DestroyHandle;
+ inherited;
+end;
+
+procedure TTntDBMemo.CMEnter(var Message: TCMEnter);
+begin
+ SetFocused(True);
+ inherited;
+end;
+
+procedure TTntDBMemo.CMExit(var Message: TCMExit);
+begin
+ try
+ FDataLink.UpdateRecord;
+ except
+ SetFocus;
+ raise;
+ end;
+ SetFocused(False);
+ inherited;
+end;
+
+procedure TTntDBMemo.SetAutoDisplay(Value: Boolean);
+begin
+ if FAutoDisplay <> Value then
+ begin
+ FAutoDisplay := Value;
+ if Value then LoadMemo;
+ end;
+end;
+
+procedure TTntDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
+begin
+ if not FMemoLoaded then LoadMemo else inherited;
+end;
+
+procedure TTntDBMemo.WMCut(var Message: TMessage);
+begin
+ FDataLink.Edit;
+ inherited;
+end;
+
+procedure TTntDBMemo.WMUndo(var Message: TMessage);
+begin
+ FDataLink.Edit;
+ inherited;
+end;
+
+procedure TTntDBMemo.WMPaste(var Message: TMessage);
+begin
+ FDataLink.Edit;
+ inherited;
+end;
+
+procedure TTntDBMemo.CMGetDataLink(var Message: TMessage);
+begin
+ Message.Result := Integer(FDataLink);
+end;
+
+procedure TTntDBMemo.WMPaint(var Message: TWMPaint);
+var
+ S: WideString;
+begin
+ if not (csPaintCopy in ControlState) then
+ inherited
+ else begin
+ if FDataLink.Field <> nil then
+ if FieldIsBlobLike(FDataLink.Field) then
+ begin
+ if FAutoDisplay then
+ S := TntAdjustLineBreaks(GetAsWideString(FDataLink.Field)) else
+ S := WideFormat('(%s)', [FDataLink.Field.DisplayLabel]);
+ end else
+ S := GetWideDisplayText(FDataLink.Field);
+ if (not Win32PlatformIsUnicode) then
+ SendMessageA(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PAnsiChar(AnsiString(S))))
+ else
+ SendMessageW(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PWideChar(S)));
+ SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Message.DC, 0);
+ SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
+ end;
+end;
+
+function TTntDBMemo.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
+ FDataLink.ExecuteAction(Action);
+end;
+
+function TTntDBMemo.UpdateAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
+ FDataLink.UpdateAction(Action);
+end;
+
+{ TTntDBRadioGroup }
+
+constructor TTntDBRadioGroup.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FDataLink := TFieldDataLink.Create;
+ FDataLink.Control := Self;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnUpdateData := UpdateData;
+ FValues := TTntStringList.Create;
+end;
+
+destructor TTntDBRadioGroup.Destroy;
+begin
+ FDataLink.Free;
+ FDataLink := nil;
+ FValues.Free;
+ inherited Destroy;
+end;
+
+procedure TTntDBRadioGroup.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if (Operation = opRemove) and (FDataLink <> nil) and
+ (AComponent = DataSource) then DataSource := nil;
+end;
+
+function TTntDBRadioGroup.UseRightToLeftAlignment: Boolean;
+begin
+ Result := inherited UseRightToLeftAlignment;
+end;
+
+procedure TTntDBRadioGroup.DataChange(Sender: TObject);
+begin
+ if FDataLink.Field <> nil then
+ Value := GetWideText(FDataLink.Field) else
+ Value := '';
+end;
+
+procedure TTntDBRadioGroup.UpdateData(Sender: TObject);
+begin
+ if FDataLink.Field <> nil then
+ SetWideText(FDataLink.Field, Value);
+end;
+
+function TTntDBRadioGroup.GetDataSource: TDataSource;
+begin
+ Result := FDataLink.DataSource;
+end;
+
+procedure TTntDBRadioGroup.SetDataSource(Value: TDataSource);
+begin
+ FDataLink.DataSource := Value;
+ if Value <> nil then Value.FreeNotification(Self);
+end;
+
+function TTntDBRadioGroup.GetDataField: string{TNT-ALLOW string};
+begin
+ Result := FDataLink.FieldName;
+end;
+
+procedure TTntDBRadioGroup.SetDataField(const Value: string{TNT-ALLOW string});
+begin
+ FDataLink.FieldName := Value;
+end;
+
+function TTntDBRadioGroup.GetReadOnly: Boolean;
+begin
+ Result := FDataLink.ReadOnly;
+end;
+
+procedure TTntDBRadioGroup.SetReadOnly(Value: Boolean);
+begin
+ FDataLink.ReadOnly := Value;
+end;
+
+function TTntDBRadioGroup.GetField: TField;
+begin
+ Result := FDataLink.Field;
+end;
+
+function TTntDBRadioGroup.GetButtonValue(Index: Integer): WideString;
+begin
+ if (Index < FValues.Count) and (FValues[Index] <> '') then
+ Result := FValues[Index]
+ else if Index < Items.Count then
+ Result := Items[Index]
+ else
+ Result := '';
+end;
+
+procedure TTntDBRadioGroup.SetValue(const Value: WideString);
+var
+ WasFocused: Boolean;
+ I, Index: Integer;
+begin
+ if FValue <> Value then
+ begin
+ FInSetValue := True;
+ try
+ WasFocused := (ItemIndex > -1) and (Buttons[ItemIndex].Focused);
+ Index := -1;
+ for I := 0 to Items.Count - 1 do
+ if Value = GetButtonValue(I) then
+ begin
+ Index := I;
+ Break;
+ end;
+ ItemIndex := Index;
+ // Move the focus rect along with the selected index
+ if WasFocused then
+ Buttons[ItemIndex].SetFocus;
+ finally
+ FInSetValue := False;
+ end;
+ FValue := Value;
+ Change;
+ end;
+end;
+
+procedure TTntDBRadioGroup.CMExit(var Message: TCMExit);
+begin
+ try
+ FDataLink.UpdateRecord;
+ except
+ if ItemIndex >= 0 then
+ (Controls[ItemIndex] as TTntRadioButton).SetFocus else
+ (Controls[0] as TTntRadioButton).SetFocus;
+ raise;
+ end;
+ inherited;
+end;
+
+procedure TTntDBRadioGroup.CMGetDataLink(var Message: TMessage);
+begin
+ Message.Result := Integer(FDataLink);
+end;
+
+procedure TTntDBRadioGroup.Click;
+begin
+ if not FInSetValue then
+ begin
+ inherited Click;
+ if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex);
+ if FDataLink.Editing then FDataLink.Modified;
+ end;
+end;
+
+procedure TTntDBRadioGroup.SetItems(Value: TTntStrings);
+begin
+ Items.Assign(Value);
+ DataChange(Self);
+end;
+
+procedure TTntDBRadioGroup.SetValues(Value: TTntStrings);
+begin
+ FValues.Assign(Value);
+ DataChange(Self);
+end;
+
+procedure TTntDBRadioGroup.Change;
+begin
+ if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TTntDBRadioGroup.KeyPress(var Key: Char{TNT-ALLOW Char});
+begin
+ inherited KeyPress(Key);
+ case Key of
+ #8, ' ': FDataLink.Edit;
+ #27: FDataLink.Reset;
+ end;
+end;
+
+function TTntDBRadioGroup.CanModify: Boolean;
+begin
+ Result := FDataLink.Edit;
+end;
+
+function TTntDBRadioGroup.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
+ DataLink.ExecuteAction(Action);
+end;
+
+function TTntDBRadioGroup.UpdateAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited UpdateAction(Action) or (DataLink <> nil) and
+ DataLink.UpdateAction(Action);
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntDialogs.pas
===================================================================
--- trunk/TntUnicodeControls/TntDialogs.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntDialogs.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,848 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntDialogs;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Classes, Controls, Forms, Messages, CommDlg, Windows, Dialogs,
+ TntClasses, TntControls, TntForms;
+
+type
+{TNT-WARN TIncludeItemEvent}
+ TIncludeItemEventW = procedure (const OFN: TOFNotifyExW; var Include: Boolean) of object;
+
+{TNT-WARN TOpenDialog}
+ TTntOpenDialog = class(TOpenDialog{TNT-ALLOW TOpenDialog})
+ private
+ FDefaultExt: WideString;
+ FFileName: WideString;
+ FFilter: WideString;
+ FInitialDir: WideString;
+ FTitle: WideString;
+ FFiles: TTntStrings;
+ FOnIncludeItem: TIncludeItemEventW;
+ function GetDefaultExt: WideString;
+ procedure SetInheritedDefaultExt(const Value: AnsiString);
+ procedure SetDefaultExt(const Value: WideString);
+ function GetFileName: WideString;
+ procedure SetFileName(const Value: WideString);
+ function GetFilter: WideString;
+ procedure SetInheritedFilter(const Value: AnsiString);
+ procedure SetFilter(const Value: WideString);
+ function GetInitialDir: WideString;
+ procedure SetInheritedInitialDir(const Value: AnsiString);
+ procedure SetInitialDir(const Value: WideString);
+ function GetTitle: WideString;
+ procedure SetInheritedTitle(const Value: AnsiString);
+ procedure SetTitle(const Value: WideString);
+ function GetFiles: TTntStrings;
+ private
+ FProxiedOpenFilenameA: TOpenFilenameA;
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ function CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
+ procedure GetFileNamesW(var OpenFileName: TOpenFileNameW);
+ procedure DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean); override;
+ procedure WndProc(var Message: TMessage); override;
+ function DoExecuteW(Func: Pointer): Bool;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Execute: Boolean; override;
+ property Files: TTntStrings read GetFiles;
+ published
+ property DefaultExt: WideString read GetDefaultExt write SetDefaultExt;
+ property FileName: WideString read GetFileName write SetFileName;
+ property Filter: WideString read GetFilter write SetFilter;
+ property InitialDir: WideString read GetInitialDir write SetInitialDir;
+ property Title: WideString read GetTitle write SetTitle;
+ property OnIncludeItem: TIncludeItemEventW read FOnIncludeItem write FOnIncludeItem;
+ end;
+
+{TNT-WARN TSaveDialog}
+ TTntSaveDialog = class(TTntOpenDialog)
+ public
+ function Execute: Boolean; override;
+ end;
+
+{ Message dialog }
+
+{TNT-WARN CreateMessageDialog}
+function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons): TTntForm{TNT-ALLOW TTntForm};
+
+{TNT-WARN MessageDlg}
+function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
+{TNT-WARN MessageDlgPos}
+function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer;
+{TNT-WARN MessageDlgPosHelp}
+function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
+ const HelpFileName: WideString): Integer;
+
+{TNT-WARN ShowMessage}
+procedure WideShowMessage(const Msg: WideString);
+{TNT-WARN ShowMessageFmt}
+procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
+{TNT-WARN ShowMessagePos}
+procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
+
+{ Input dialog }
+
+{TNT-WARN InputQuery}
+function WideInputQuery(const ACaption, APrompt: WideString;
+ var Value: WideString): Boolean;
+{TNT-WARN InputBox}
+function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
+
+{TNT-WARN PromptForFileName}
+function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
+ const ADefaultExt: WideString = ''; const ATitle: WideString = '';
+ const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
+
+implementation
+
+uses
+ {$IFDEF COMPILER_6_UP} Types, {$ENDIF} SysUtils, Graphics, Consts, Math,
+ TntSystem, TntWindows, TntSysUtils, TntStdCtrls, TntClipBrd, TntExtCtrls;
+
+var
+ ProxyExecuteDialog: TTntOpenDialog;
+
+function ProxyGetOpenFileNameA(var OpenFile: TOpenFilename): Bool; stdcall;
+begin
+ ProxyExecuteDialog.FProxiedOpenFilenameA := OpenFile;
+ Result := False; { as if user hit "Cancel". }
+end;
+
+{ TTntOpenDialog }
+
+constructor TTntOpenDialog.Create(AOwner: TComponent);
+begin
+ inherited;
+ FFiles := TTntStringList.Create;
+end;
+
+destructor TTntOpenDialog.Destroy;
+begin
+ FreeAndNil(FFiles);
+ inherited;
+end;
+
+procedure TTntOpenDialog.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntOpenDialog.GetDefaultExt: WideString;
+begin
+ Result := GetSyncedWideString(FDefaultExt, inherited DefaultExt);
+end;
+
+procedure TTntOpenDialog.SetInheritedDefaultExt(const Value: AnsiString);
+begin
+ inherited DefaultExt := Value;
+end;
+
+procedure TTntOpenDialog.SetDefaultExt(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FDefaultExt, inherited DefaultExt, SetInheritedDefaultExt);
+end;
+
+function TTntOpenDialog.GetFileName: WideString;
+var
+ Path: array[0..MAX_PATH] of WideChar;
+begin
+ if Win32PlatformIsUnicode and NewStyleControls and (Handle <> 0) then begin
+ // get filename from handle
+ SendMessageW(GetParent(Handle), CDM_GETFILEPATH, SizeOf(Path), Integer(@Path));
+ Result := Path;
+ end else
+ Result := GetSyncedWideString(FFileName, inherited FileName);
+end;
+
+procedure TTntOpenDialog.SetFileName(const Value: WideString);
+begin
+ FFileName := Value;
+ inherited FileName := Value;
+end;
+
+function TTntOpenDialog.GetFilter: WideString;
+begin
+ Result := GetSyncedWideString(FFilter, inherited Filter);
+end;
+
+procedure TTntOpenDialog.SetInheritedFilter(const Value: AnsiString);
+begin
+ inherited Filter := Value;
+end;
+
+procedure TTntOpenDialog.SetFilter(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FFilter, inherited Filter, SetInheritedFilter);
+end;
+
+function TTntOpenDialog.GetInitialDir: WideString;
+begin
+ Result := GetSyncedWideString(FInitialDir, inherited InitialDir);
+end;
+
+procedure TTntOpenDialog.SetInheritedInitialDir(const Value: AnsiString);
+begin
+ inherited InitialDir := Value;
+end;
+
+procedure TTntOpenDialog.SetInitialDir(const Value: WideString);
+
+ function RemoveTrailingPathDelimiter(const Value: WideString): WideString;
+ var
+ L: Integer;
+ begin
+ // remove trailing path delimiter (except 'C:\')
+ L := Length(Value);
+ if (L > 1) and WideIsPathDelimiter(Value, L) and not WideIsDelimiter(':', Value, L - 1) then
+ Dec(L);
+ Result := Copy(Value, 1, L);
+ end;
+
+begin
+ SetSyncedWideString(RemoveTrailingPathDelimiter(Value), FInitialDir,
+ inherited InitialDir, SetInheritedInitialDir);
+end;
+
+function TTntOpenDialog.GetTitle: WideString;
+begin
+ Result := GetSyncedWideString(FTitle, inherited Title)
+end;
+
+procedure TTntOpenDialog.SetInheritedTitle(const Value: AnsiString);
+begin
+ inherited Title := Value;
+end;
+
+procedure TTntOpenDialog.SetTitle(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FTitle, inherited Title, SetInheritedTitle);
+end;
+
+function TTntOpenDialog.GetFiles: TTntStrings;
+begin
+ if (not Win32PlatformIsUnicode) then
+ FFiles.Assign(inherited Files);
+ Result := FFiles;
+end;
+
+function TTntOpenDialog.CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
+begin
+ GetFileNamesW(OpenFileName);
+ Result := DoCanClose;
+ FFiles.Clear;
+ inherited Files.Clear;
+end;
+
+procedure TTntOpenDialog.DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean);
+begin
+ // CDN_INCLUDEITEM -> DoIncludeItem() is only be available on Windows 2000 +
+ // Therefore, just cast OFN as a TOFNotifyExW, since that's what it really is.
+ if Win32PlatformIsUnicode and Assigned(FOnIncludeItem) then
+ FOnIncludeItem(TOFNotifyExW(OFN), Include)
+end;
+
+procedure TTntOpenDialog.WndProc(var Message: TMessage);
+begin
+ Message.Result := 0;
+ if (Message.Msg = WM_INITDIALOG) and not (ofOldStyleDialog in Options) then begin
+ { If not ofOldStyleDialog then DoShow on CDN_INITDONE, not WM_INITDIALOG }
+ Exit;
+ end;
+ if Win32PlatformIsUnicode
+ and (Message.Msg = WM_NOTIFY) then begin
+ case (POFNotify(Message.LParam)^.hdr.code) of
+ CDN_FILEOK:
+ if not CanCloseW(POFNotifyW(Message.LParam)^.lpOFN^) then
+ begin
+ Message.Result := 1;
+ SetWindowLong(Handle, DWL_MSGRESULT, Message.Result);
+ Exit;
+ end;
+ end;
+ end;
+ inherited WndProc(Message);
+end;
+
+function TTntOpenDialog.DoExecuteW(Func: Pointer): Bool;
+var
+ OpenFilename: TOpenFilenameW;
+
+ function GetResNamePtr(var ScopedStringStorage: WideString; lpszName: PAnsiChar): PWideChar;
+ // duplicated from TntTrxResourceUtils.pas
+ begin
+ if Tnt_Is_IntResource(PWideChar(lpszName)) then
+ Result := PWideChar(lpszName)
+ else begin
+ ScopedStringStorage := lpszName;
+ Result := PWideChar(ScopedStringStorage);
+ end;
+ end;
+
+ function AllocFilterStr(const S: WideString): WideString;
+ var
+ P: PWideChar;
+ begin
+ Result := '';
+ if S <> '' then
+ begin
+ Result := S + #0#0; // double null terminators (an additional zero added in case Description/Filter pair not even.)
+ P := StrScanW(PWideChar(Result), '|');
+ while P <> nil do
+ begin
+ P^ := #0;
+ Inc(P);
+ P := StrScanW(P, '|');
+ end;
+ end;
+ end;
+
+var
+ TempTemplate, TempFilter, TempFilename, TempExt: WideString;
+begin
+ FFiles.Clear;
+
+ // 1. Init inherited dialog defaults.
+ // 2. Populate OpenFileName record with ansi defaults
+ ProxyExecuteDialog := Self;
+ try
+ DoExecute(@ProxyGetOpenFileNameA);
+ finally
+ ProxyExecuteDialog := nil;
+ end;
+ OpenFileName := TOpenFilenameW(FProxiedOpenFilenameA);
+
+ with OpenFilename do
+ begin
+ if not IsWindow(hWndOwner) then
+ hWndOwner := Application.Handle;
+ // Filter (PChar -> PWideChar)
+ TempFilter := AllocFilterStr(Filter);
+ lpstrFilter := PWideChar(TempFilter);
+ // FileName (PChar -> PWideChar)
+ SetLength(TempFilename, nMaxFile + 2);
+ lpstrFile := PWideChar(TempFilename);
+ FillChar(lpstrFile^, (nMaxFile + 2) * SizeOf(WideChar), 0);
+ StrLCopyW(lpstrFile, PWideChar(FileName), nMaxFile);
+ // InitialDir (PChar -> PWideChar)
+ if (InitialDir = '') and ForceCurrentDirectory then
+ lpstrInitialDir := '.'
+ else
+ lpstrInitialDir := PWideChar(InitialDir);
+ // Title (PChar -> PWideChar)
+ lpstrTitle := PWideChar(Title);
+ // DefaultExt (PChar -> PWideChar)
+ TempExt := DefaultExt;
+ if (TempExt = '') and (Flags and OFN_EXPLORER = 0) then
+ begin
+ TempExt := WideExtractFileExt(Filename);
+ Delete(TempExt, 1, 1);
+ end;
+ if TempExt <> '' then
+ lpstrDefExt := PWideChar(TempExt);
+ // resource template (PChar -> PWideChar)
+ lpTemplateName := GetResNamePtr(TempTemplate, Template);
+ // start modal dialog
+ Result := TaskModalDialog(Func, OpenFileName);
+ if Result then
+ begin
+ GetFileNamesW(OpenFilename);
+ if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
+ Options := Options + [ofExtensionDifferent]
+ else
+ Options := Options - [ofExtensionDifferent];
+ if (Flags and OFN_READONLY) <> 0 then
+ Options := Options + [ofReadOnly]
+ else
+ Options := Options - [ofReadOnly];
+ FilterIndex := nFilterIndex;
+ end;
+ end;
+end;
+
+procedure TTntOpenDialog.GetFileNamesW(var OpenFileName: TOpenFileNameW);
+var
+ Separator: WideChar;
+
+ procedure ExtractFileNamesW(P: PWideChar);
+ var
+ DirName, FileName: WideString;
+ FileList: TWideStringDynArray;
+ i: integer;
+ begin
+ FileList := ExtractStringsFromStringArray(P, Separator);
+ if Length(FileList) > 0 then begin
+ DirName := FileList[0];
+ if Length(FileList) = 1 then
+ FFiles.Add(DirName)
+ else begin
+ // prepare DirName
+ if WideLastChar(DirName) <> PathDelim then
+ DirName := DirName + PathDelim;
+ // add files
+ for i := 1 {second item} to High(FileList) do begin
+ FileName := FileList[i];
+ // prepare FileName
+ if (FileName[1] <> PathDelim)
+ and ((Length(FileName) <= 3) or (FileName[2] <> DriveDelim) or (FileName[3] <> PathDelim))
+ then
+ FileName := DirName + FileName;
+ // add to list
+ FFiles.Add(FileName);
+ end;
+ end;
+ end;
+ end;
+
+var
+ P: PWideChar;
+begin
+ Separator := #0;
+ if (ofAllowMultiSelect in Options) and
+ ((ofOldStyleDialog in Options) or not NewStyleControls) then
+ Separator := ' ';
+ with OpenFileName do
+ begin
+ if ofAllowMultiSelect in Options then
+ begin
+ ExtractFileNamesW(lpstrFile);
+ FileName := FFiles[0];
+ end else
+ begin
+ P := lpstrFile;
+ FileName := ExtractStringFromStringArray(P, Separator);
+ FFiles.Add(FileName);
+ end;
+ end;
+
+ // Sync inherited Files
+ inherited Files.Assign(FFiles);
+end;
+
+function TTntOpenDialog.Execute: Boolean;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := DoExecute(@GetOpenFileNameA)
+ else
+ Result := DoExecuteW(@GetOpenFileNameW);
+end;
+
+{ TTntSaveDialog }
+
+function TTntSaveDialog.Execute: Boolean;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := DoExecute(@GetSaveFileNameA)
+ else
+ Result := DoExecuteW(@GetSaveFileNameW);
+end;
+
+{ Message dialog }
+
+function GetAveCharSize(Canvas: TCanvas): TPoint;
+var
+ I: Integer;
+ Buffer: array[0..51] of WideChar;
+begin
+ for I := 0 to 25 do Buffer[I] := WideChar(I + Ord('A'));
+ for I := 0 to 25 do Buffer[I + 26] := WideChar(I + Ord('a'));
+ GetTextExtentPointW(Canvas.Handle, Buffer, 52, TSize(Result));
+ Result.X := Result.X div 52;
+end;
+
+type
+ TTntMessageForm = class(TTntForm{TNT-ALLOW TTntForm})
+ private
+ Message: TTntLabel;
+ procedure HelpButtonClick(Sender: TObject);
+ protected
+ procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ function GetFormText: WideString;
+ public
+ constructor CreateNew(AOwner: TComponent); reintroduce;
+ end;
+
+constructor TTntMessageForm.CreateNew(AOwner: TComponent);
+var
+ NonClientMetrics: TNonClientMetrics;
+begin
+ inherited CreateNew(AOwner);
+ NonClientMetrics.cbSize := sizeof(NonClientMetrics);
+ if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
+ Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
+end;
+
+procedure TTntMessageForm.HelpButtonClick(Sender: TObject);
+begin
+ Application.HelpContext(HelpContext);
+end;
+
+procedure TTntMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if (Shift = [ssCtrl]) and (Key = Word('C')) then
+ begin
+ Beep;
+ TntClipboard.AsWideText := GetFormText;
+ end;
+end;
+
+function TTntMessageForm.GetFormText: WideString;
+var
+ DividerLine, ButtonCaptions: WideString;
+ I: integer;
+begin
+ DividerLine := StringOfChar('-', 27) + sLineBreak;
+ for I := 0 to ComponentCount - 1 do
+ if Components[I] is TTntButton then
+ ButtonCaptions := ButtonCaptions + TTntButton(Components[I]).Caption +
+ StringOfChar(' ', 3);
+ ButtonCaptions := WideStringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
+ Result := DividerLine + Caption + sLineBreak + DividerLine + Message.Caption + sLineBreak
+ + DividerLine + ButtonCaptions + sLineBreak + DividerLine;
+end;
+
+function GetMessageCaption(MsgType: TMsgDlgType): WideString;
+begin
+ case MsgType of
+ mtWarning: Result := SMsgDlgWarning;
+ mtError: Result := SMsgDlgError;
+ mtInformation: Result := SMsgDlgInformation;
+ mtConfirmation: Result := SMsgDlgConfirm;
+ mtCustom: Result := '';
+ else
+ raise ETntInternalError.Create('Unexpected MsgType in GetMessageCaption.');
+ end;
+end;
+
+function GetButtonCaption(MsgDlgBtn: TMsgDlgBtn): WideString;
+begin
+ case MsgDlgBtn of
+ mbYes: Result := SMsgDlgYes;
+ mbNo: Result := SMsgDlgNo;
+ mbOK: Result := SMsgDlgOK;
+ mbCancel: Result := SMsgDlgCancel;
+ mbAbort: Result := SMsgDlgAbort;
+ mbRetry: Result := SMsgDlgRetry;
+ mbIgnore: Result := SMsgDlgIgnore;
+ mbAll: Result := SMsgDlgAll;
+ mbNoToAll: Result := SMsgDlgNoToAll;
+ mbYesToAll: Result := SMsgDlgYesToAll;
+ mbHelp: Result := SMsgDlgHelp;
+ else
+ raise ETntInternalError.Create('Unexpected MsgDlgBtn in GetButtonCaption.');
+ end;
+end;
+
+var
+ IconIDs: array[TMsgDlgType] of PAnsiChar = (IDI_EXCLAMATION, IDI_HAND,
+ IDI_ASTERISK, IDI_QUESTION, nil);
+ ButtonNames: array[TMsgDlgBtn] of WideString = (
+ 'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
+ 'YesToAll', 'Help');
+ ModalResults: array[TMsgDlgBtn] of Integer = (
+ mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
+ mrYesToAll, 0);
+
+function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons): TTntForm{TNT-ALLOW TTntForm};
+const
+ mcHorzMargin = 8;
+ mcVertMargin = 8;
+ mcHorzSpacing = 10;
+ mcVertSpacing = 10;
+ mcButtonWidth = 50;
+ mcButtonHeight = 14;
+ mcButtonSpacing = 4;
+var
+ DialogUnits: TPoint;
+ HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
+ ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
+ IconTextWidth, IconTextHeight, X, ALeft: Integer;
+ B, DefaultButton, CancelButton: TMsgDlgBtn;
+ IconID: PAnsiChar;
+ ATextRect: TRect;
+ ThisButtonWidth: integer;
+begin
+ Result := TTntMessageForm.CreateNew(Application);
+ with Result do
+ begin
+ BiDiMode := Application.BiDiMode;
+ BorderStyle := bsDialog;
+ Canvas.Font := Font;
+ KeyPreview := True;
+ OnKeyDown := TTntMessageForm(Result).CustomKeyDown;
+ DialogUnits := GetAveCharSize(Canvas);
+ HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
+ VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
+ HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
+ VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
+ ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
+ for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
+ begin
+ if B in Buttons then
+ begin
+ ATextRect := Rect(0,0,0,0);
+ Tnt_DrawTextW(Canvas.Handle,
+ PWideChar(GetButtonCaption(B)), -1,
+ ATextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
+ DrawTextBiDiModeFlagsReadingOnly);
+ with ATextRect do ThisButtonWidth := Right - Left + 8;
+ if ThisButtonWidth > ButtonWidth then
+ ButtonWidth := ThisButtonWidth;
+ end;
+ end;
+ ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
+ ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
+ SetRect(ATextRect, 0, 0, Screen.Width div 2, 0);
+ Tnt_DrawTextW(Canvas.Handle, PWideChar(Msg), Length(Msg) + 1, ATextRect,
+ DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
+ DrawTextBiDiModeFlagsReadingOnly);
+ IconID := IconIDs[DlgType];
+ IconTextWidth := ATextRect.Right;
+ IconTextHeight := ATextRect.Bottom;
+ if IconID <> nil then
+ begin
+ Inc(IconTextWidth, 32 + HorzSpacing);
+ if IconTextHeight < 32 then IconTextHeight := 32;
+ end;
+ ButtonCount := 0;
+ for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
+ if B in Buttons then Inc(ButtonCount);
+ ButtonGroupWidth := 0;
+ if ButtonCount <> 0 then
+ ButtonGroupWidth := ButtonWidth * ButtonCount +
+ ButtonSpacing * (ButtonCount - 1);
+ ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
+ ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
+ VertMargin * 2;
+ Left := (Screen.Width div 2) - (Width div 2);
+ Top := (Screen.Height div 2) - (Height div 2);
+ if DlgType <> mtCustom then
+ Caption := GetMessageCaption(DlgType)
+ else
+ Caption := TntApplication.Title;
+ if IconID <> nil then
+ with TTntImage.Create(Result) do
+ begin
+ Name := 'Image';
+ Parent := Result;
+ Picture.Icon.Handle := LoadIcon(0, IconID);
+ SetBounds(HorzMargin, VertMargin, 32, 32);
+ end;
+ TTntMessageForm(Result).Message := TTntLabel.Create(Result);
+ with TTntMessageForm(Result).Message do
+ begin
+ Name := 'Message';
+ Parent := Result;
+ WordWrap := True;
+ Caption := Msg;
+ BoundsRect := ATextRect;
+ BiDiMode := Result.BiDiMode;
+ ALeft := IconTextWidth - ATextRect.Right + HorzMargin;
+ if UseRightToLeftAlignment then
+ ALeft := Result.ClientWidth - ALeft - Width;
+ SetBounds(ALeft, VertMargin,
+ ATextRect.Right, ATextRect.Bottom);
+ end;
+ if mbOk in Buttons then DefaultButton := mbOk else
+ if mbYes in Buttons then DefaultButton := mbYes else
+ DefaultButton := mbRetry;
+ if mbCancel in Buttons then CancelButton := mbCancel else
+ if mbNo in Buttons then CancelButton := mbNo else
+ CancelButton := mbOk;
+ X := (ClientWidth - ButtonGroupWidth) div 2;
+ for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
+ if B in Buttons then
+ with TTntButton.Create(Result) do
+ begin
+ Name := ButtonNames[B];
+ Parent := Result;
+ Caption := GetButtonCaption(B);
+ ModalResult := ModalResults[B];
+ if B = DefaultButton then Default := True;
+ if B = CancelButton then Cancel := True;
+ SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
+ ButtonWidth, ButtonHeight);
+ Inc(X, ButtonWidth + ButtonSpacing);
+ if B = mbHelp then
+ OnClick := TTntMessageForm(Result).HelpButtonClick;
+ end;
+ end;
+end;
+
+function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
+begin
+ Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
+end;
+
+function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer;
+begin
+ Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '');
+end;
+
+function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
+ Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
+ const HelpFileName: WideString): Integer;
+begin
+ with WideCreateMessageDialog(Msg, DlgType, Buttons) do
+ try
+ HelpContext := HelpCtx;
+ HelpFile := HelpFileName;
+ if X >= 0 then Left := X;
+ if Y >= 0 then Top := Y;
+ if (Y < 0) and (X < 0) then Position := poScreenCenter;
+ Result := ShowModal;
+ finally
+ Free;
+ end;
+end;
+
+procedure WideShowMessage(const Msg: WideString);
+begin
+ WideShowMessagePos(Msg, -1, -1);
+end;
+
+procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
+begin
+ WideShowMessage(WideFormat(Msg, Params));
+end;
+
+procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
+begin
+ WideMessageDlgPos(Msg, mtCustom, [mbOK], 0, X, Y);
+end;
+
+{ Input dialog }
+
+function WideInputQuery(const ACaption, APrompt: WideString; var Value: WideString): Boolean;
+var
+ Form: TTntForm{TNT-ALLOW TTntForm};
+ Prompt: TTntLabel;
+ Edit: TTntEdit;
+ DialogUnits: TPoint;
+ ButtonTop, ButtonWidth, ButtonHeight: Integer;
+begin
+ Result := False;
+ Form := TTntForm{TNT-ALLOW TTntForm}.Create(Application);
+ with Form do begin
+ try
+ Canvas.Font := Font;
+ DialogUnits := GetAveCharSize(Canvas);
+ BorderStyle := bsDialog;
+ Caption := ACaption;
+ ClientWidth := MulDiv(180, DialogUnits.X, 4);
+ Position := poScreenCenter;
+ Prompt := TTntLabel.Create(Form);
+ with Prompt do
+ begin
+ Parent := Form;
+ Caption := APrompt;
+ Left := MulDiv(8, DialogUnits.X, 4);
+ Top := MulDiv(8, DialogUnits.Y, 8);
+ Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
+ WordWrap := True;
+ end;
+ Edit := TTntEdit.Create(Form);
+ with Edit do
+ begin
+ Parent := Form;
+ Left := Prompt.Left;
+ Top := Prompt.Top + Prompt.Height + 5;
+ Width := MulDiv(164, DialogUnits.X, 4);
+ MaxLength := 255;
+ Text := Value;
+ SelectAll;
+ end;
+ ButtonTop := Edit.Top + Edit.Height + 15;
+ ButtonWidth := MulDiv(50, DialogUnits.X, 4);
+ ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
+ with TTntButton.Create(Form) do
+ begin
+ Parent := Form;
+ Caption := SMsgDlgOK;
+ ModalResult := mrOk;
+ Default := True;
+ SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
+ ButtonHeight);
+ end;
+ with TTntButton.Create(Form) do
+ begin
+ Parent := Form;
+ Caption := SMsgDlgCancel;
+ ModalResult := mrCancel;
+ Cancel := True;
+ SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15, ButtonWidth,
+ ButtonHeight);
+ Form.ClientHeight := Top + Height + 13;
+ end;
+ if ShowModal = mrOk then
+ begin
+ Value := Edit.Text;
+ Result := True;
+ end;
+ finally
+ Form.Free;
+ end;
+ end;
+end;
+
+function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
+begin
+ Result := ADefault;
+ WideInputQuery(ACaption, APrompt, Result);
+end;
+
+function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
+ const ADefaultExt: WideString = ''; const ATitle: WideString = '';
+ const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
+var
+ Dialog: TTntOpenDialog;
+begin
+ if SaveDialog then
+ begin
+ Dialog := TTntSaveDialog.Create(nil);
+ Dialog.Options := Dialog.Options + [ofOverwritePrompt];
+ end
+ else
+ Dialog := TTntOpenDialog.Create(nil);
+ with Dialog do
+ try
+ Title := ATitle;
+ DefaultExt := ADefaultExt;
+ if AFilter = '' then
+ Filter := SDefaultFilter else
+ Filter := AFilter;
+ InitialDir := AInitialDir;
+ FileName := AFileName;
+ Result := Execute;
+ if Result then
+ AFileName := FileName;
+ finally
+ Free;
+ end;
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntExtDlgs.pas
===================================================================
--- trunk/TntUnicodeControls/TntExtDlgs.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntExtDlgs.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,291 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntExtDlgs;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Classes, TntDialogs, TntExtCtrls, TntStdCtrls, TntButtons;
+
+type
+{TNT-WARN TOpenPictureDialog}
+ TTntOpenPictureDialog = class(TTntOpenDialog)
+ private
+ FPicturePanel: TTntPanel;
+ FPictureLabel: TTntLabel;
+ FPreviewButton: TTntSpeedButton;
+ FPaintPanel: TTntPanel;
+ FImageCtrl: TTntImage;
+ FSavedFilename: WideString;
+ function IsFilterStored: Boolean;
+ procedure PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
+ protected
+ procedure PreviewClick(Sender: TObject); virtual;
+ procedure DoClose; override;
+ procedure DoSelectionChange; override;
+ procedure DoShow; override;
+ property ImageCtrl: TTntImage read FImageCtrl;
+ property PictureLabel: TTntLabel read FPictureLabel;
+ published
+ property Filter stored IsFilterStored;
+ public
+ constructor Create(AOwner: TComponent); override;
+ function Execute: Boolean; override;
+ end;
+
+{TNT-WARN TSavePictureDialog}
+ TTntSavePictureDialog = class(TTntOpenPictureDialog)
+ public
+ function Execute: Boolean; override;
+ end;
+
+implementation
+
+uses
+ ExtDlgs, {ExtDlgs is needed for a linked resource} Dialogs, Consts, Messages, Windows,
+ Graphics, Math, Controls, Forms, SysUtils, CommDlg, TntSysUtils, TntForms;
+
+{ TTntSilentPaintPanel }
+
+type
+ TTntSilentPaintPanel = class(TTntPanel)
+ protected
+ procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
+ end;
+
+procedure TTntSilentPaintPanel.WMPaint(var Msg: TWMPaint);
+begin
+ try
+ inherited;
+ except
+ Caption := SInvalidImage;
+ end;
+end;
+
+{ TTntOpenPictureDialog }
+
+constructor TTntOpenPictureDialog.Create(AOwner: TComponent);
+begin
+ inherited;
+ Filter := GraphicFilter(TGraphic);
+ FPicturePanel := TTntPanel.Create(Self);
+ with FPicturePanel do
+ begin
+ Name := 'PicturePanel';
+ Caption := '';
+ SetBounds(204, 5, 169, 200);
+ BevelOuter := bvNone;
+ BorderWidth := 6;
+ TabOrder := 1;
+ FPictureLabel := TTntLabel.Create(Self);
+ with FPictureLabel do
+ begin
+ Name := 'PictureLabel';
+ Caption := '';
+ SetBounds(6, 6, 157, 23);
+ Align := alTop;
+ AutoSize := False;
+ Parent := FPicturePanel;
+ end;
+ FPreviewButton := TTntSpeedButton.Create(Self);
+ with FPreviewButton do
+ begin
+ Name := 'PreviewButton';
+ SetBounds(77, 1, 23, 22);
+ Enabled := False;
+ Glyph.LoadFromResourceName(FindClassHInstance(TOpenPictureDialog{TNT-ALLOW TOpenPictureDialog}), 'PREVIEWGLYPH');
+ Hint := SPreviewLabel;
+ ParentShowHint := False;
+ ShowHint := True;
+ OnClick := PreviewClick;
+ Parent := FPicturePanel;
+ end;
+ FPaintPanel := TTntSilentPaintPanel.Create(Self);
+ with FPaintPanel do
+ begin
+ Name := 'PaintPanel';
+ Caption := '';
+ SetBounds(6, 29, 157, 145);
+ Align := alClient;
+ BevelInner := bvRaised;
+ BevelOuter := bvLowered;
+ TabOrder := 0;
+ FImageCtrl := TTntImage.Create(Self);
+ Parent := FPicturePanel;
+ with FImageCtrl do
+ begin
+ Name := 'PaintBox';
+ Align := alClient;
+ OnDblClick := PreviewClick;
+ Parent := FPaintPanel;
+ {$IFDEF COMPILER_6_UP}
+ Proportional := True;
+ {$ENDIF}
+ Stretch := True;
+ Center := True;
+ IncrementalDisplay := True;
+ end;
+ end;
+ end;
+end;
+
+procedure TTntOpenPictureDialog.DoClose;
+begin
+ inherited;
+ { Hide any hint windows left behind }
+ Application.HideHint;
+end;
+
+procedure TTntOpenPictureDialog.DoSelectionChange;
+var
+ FullName: WideString;
+ ValidPicture: Boolean;
+
+ function ValidFile(const FileName: WideString): Boolean;
+ begin
+ Result := WideFileGetAttr(FileName) <> $FFFFFFFF;
+ end;
+
+begin
+ FullName := FileName;
+ if FullName <> FSavedFilename then
+ begin
+ FSavedFilename := FullName;
+ ValidPicture := WideFileExists(FullName) and ValidFile(FullName);
+ if ValidPicture then
+ try
+ FImageCtrl.Picture.LoadFromFile(FullName);
+ FPictureLabel.Caption := WideFormat(SPictureDesc,
+ [FImageCtrl.Picture.Width, FImageCtrl.Picture.Height]);
+ FPreviewButton.Enabled := True;
+ FPaintPanel.Caption := '';
+ except
+ ValidPicture := False;
+ end;
+ if not ValidPicture then
+ begin
+ FPictureLabel.Caption := SPictureLabel;
+ FPreviewButton.Enabled := False;
+ FImageCtrl.Picture := nil;
+ FPaintPanel.Caption := srNone;
+ end;
+ end;
+ inherited;
+end;
+
+procedure TTntOpenPictureDialog.DoShow;
+var
+ PreviewRect, StaticRect: TRect;
+begin
+ { Set preview area to entire dialog }
+ GetClientRect(Handle, PreviewRect);
+ StaticRect := GetStaticRect;
+ { Move preview area to right of static area }
+ PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
+ Inc(PreviewRect.Top, 4);
+ FPicturePanel.BoundsRect := PreviewRect;
+ FPreviewButton.Left := FPaintPanel.BoundsRect.Right - FPreviewButton.Width - 2;
+ FImageCtrl.Picture := nil;
+ FSavedFilename := '';
+ FPaintPanel.Caption := srNone;
+ FPicturePanel.ParentWindow := Handle;
+ inherited;
+end;
+
+function TTntOpenPictureDialog.Execute: Boolean;
+begin
+ if NewStyleControls and not (ofOldStyleDialog in Options) then
+ Template := 'DLGTEMPLATE' else
+ Template := nil;
+ Result := inherited Execute;
+end;
+
+function TTntOpenPictureDialog.IsFilterStored: Boolean;
+begin
+ Result := not (Filter = GraphicFilter(TGraphic));
+end;
+
+procedure TTntOpenPictureDialog.PreviewClick(Sender: TObject);
+var
+ PreviewForm: TTntForm{TNT-ALLOW TTntForm};
+ Panel: TTntPanel;
+begin
+ PreviewForm := TTntForm{TNT-ALLOW TTntForm}.Create(Self);
+ with PreviewForm do
+ try
+ Name := 'PreviewForm';
+ Visible := False;
+ Caption := SPreviewLabel;
+ BorderStyle := bsSizeToolWin;
+ KeyPreview := True;
+ Position := poScreenCenter;
+ OnKeyPress := PreviewKeyPress;
+ Panel := TTntPanel.Create(PreviewForm);
+ with Panel do
+ begin
+ Name := 'Panel';
+ Caption := '';
+ Align := alClient;
+ BevelOuter := bvNone;
+ BorderStyle := bsSingle;
+ BorderWidth := 5;
+ Color := clWindow;
+ Parent := PreviewForm;
+ DoubleBuffered := True;
+ with TTntImage.Create(PreviewForm) do
+ begin
+ Name := 'Image';
+ Align := alClient;
+ Stretch := True;
+ {$IFDEF COMPILER_6_UP}
+ Proportional := True;
+ {$ENDIF}
+ Center := True;
+ Picture.Assign(FImageCtrl.Picture);
+ Parent := Panel;
+ end;
+ end;
+ if FImageCtrl.Picture.Width > 0 then
+ begin
+ ClientWidth := Min(Monitor.Width * 3 div 4,
+ FImageCtrl.Picture.Width + (ClientWidth - Panel.ClientWidth)+ 10);
+ ClientHeight := Min(Monitor.Height * 3 div 4,
+ FImageCtrl.Picture.Height + (ClientHeight - Panel.ClientHeight) + 10);
+ end;
+ ShowModal;
+ finally
+ Free;
+ end;
+end;
+
+procedure TTntOpenPictureDialog.PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
+begin
+ if Key = Char{TNT-ALLOW Char}(VK_ESCAPE) then
+ TTntForm{TNT-ALLOW TTntForm}(Sender).Close;
+end;
+
+{ TSavePictureDialog }
+function TTntSavePictureDialog.Execute: Boolean;
+begin
+ if NewStyleControls and not (ofOldStyleDialog in Options) then
+ Template := 'DLGTEMPLATE' else
+ Template := nil;
+
+ if (not Win32PlatformIsUnicode) then
+ Result := DoExecute(@GetSaveFileNameA)
+ else
+ Result := DoExecuteW(@GetSaveFileNameW);
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntFormatStrUtils.pas
===================================================================
--- trunk/TntUnicodeControls/TntFormatStrUtils.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntFormatStrUtils.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,456 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntFormatStrUtils;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+// this unit provides functions to work with format strings
+
+uses Classes, TntClasses, TntSysUtils;
+
+function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
+{$IFDEF COMPILER_6_UP}
+function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
+ const Args: array of const
+ {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
+{$ENDIF}
+procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
+
+implementation
+
+uses SysUtils, Math, TypInfo;
+
+resourcestring
+ SInvalidFormatSpecifier = 'Invalid Format Specifier: %s';
+ SMismatchedArgumentTypes = 'Argument types for index %d do not match. (%s <> %s)';
+ SMismatchedArgumentCounts = 'Number of format specifiers do not match.';
+
+type
+ TFormatSpecifierType = (fstInteger, fstFloating, fstPointer, fstString);
+
+function GetFormatSpecifierType(const FormatSpecifier: WideString): TFormatSpecifierType;
+var
+ LastChar: WideChar;
+begin
+ LastChar := WideLastChar(FormatSpecifier);
+ case LastChar of
+ 'd', 'D', 'u', 'U', 'x', 'X':
+ result := fstInteger;
+ 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'N', 'm', 'M':
+ result := fstFloating;
+ 'p', 'P':
+ result := fstPointer;
+ 's', 'S':
+ result := fstString
+ else
+ raise ETntInternalError.CreateFmt('Internal Error: Unexpected format type (%s)', [LastChar]);
+ end;
+end;
+
+type
+ TFormatStrParser = class(TObject)
+ private
+ ParsedString: TBufferedWideString;
+ PFormatString: PWideChar;
+ LastIndex: Integer;
+ ExplicitCount: Integer;
+ ImplicitCount: Integer;
+ procedure RaiseInvalidFormatSpecifier;
+ function ParseChar(c: WideChar): Boolean;
+ procedure ForceParseChar(c: WideChar);
+ function ParseDigit: Boolean;
+ function ParseInteger: Boolean;
+ procedure ForceParseType;
+ function PeekDigit: Boolean;
+ function PeekIndexSpecifier(out Index: Integer): Boolean;
+ public
+ constructor Create(const _FormatString: WideString);
+ destructor Destroy; override;
+ function ParseFormatSpecifier: Boolean;
+ end;
+
+constructor TFormatStrParser.Create(const _FormatString: WideString);
+begin
+ inherited Create;
+ PFormatString := PWideChar(_FormatString);
+ ExplicitCount := 0;
+ ImplicitCount := 0;
+ LastIndex := -1;
+ ParsedString := TBufferedWideString.Create;
+end;
+
+destructor TFormatStrParser.Destroy;
+begin
+ FreeAndNil(ParsedString);
+ inherited;
+end;
+
+procedure TFormatStrParser.RaiseInvalidFormatSpecifier;
+begin
+ raise ETntGeneralError.CreateFmt(SInvalidFormatSpecifier, [ParsedString.Value + PFormatString]);
+end;
+
+function TFormatStrParser.ParseChar(c: WideChar): Boolean;
+begin
+ result := False;
+ if PFormatString^ = c then begin
+ result := True;
+ ParsedString.AddChar(c);
+ Inc(PFormatString);
+ end;
+end;
+
+procedure TFormatStrParser.ForceParseChar(c: WideChar);
+begin
+ if not ParseChar(c) then
+ RaiseInvalidFormatSpecifier;
+end;
+
+function TFormatStrParser.PeekDigit: Boolean;
+begin
+ result := False;
+ if (PFormatString^ <> #0)
+ and (PFormatString^ >= '0')
+ and (PFormatString^ <= '9') then
+ result := True;
+end;
+
+function TFormatStrParser.ParseDigit: Boolean;
+begin
+ result := False;
+ if PeekDigit then begin
+ result := True;
+ ForceParseChar(PFormatString^);
+ end;
+end;
+
+function TFormatStrParser.ParseInteger: Boolean;
+const
+ MAX_INT_DIGITS = 6;
+var
+ digitcount: integer;
+begin
+ digitcount := 0;
+ While ParseDigit do begin
+ inc(digitcount);
+ end;
+ result := (digitcount > 0);
+ if digitcount > MAX_INT_DIGITS then
+ RaiseInvalidFormatSpecifier;
+end;
+
+procedure TFormatStrParser.ForceParseType;
+begin
+ if PFormatString^ = #0 then
+ RaiseInvalidFormatSpecifier;
+
+ case PFormatString^ of
+ 'd', 'u', 'x', 'e', 'f', 'g', 'n', 'm', 'p', 's',
+ 'D', 'U', 'X', 'E', 'F', 'G', 'N', 'M', 'P', 'S':
+ begin
+ // do nothing
+ end
+ else
+ RaiseInvalidFormatSpecifier;
+ end;
+ ForceParseChar(PFormatString^);
+end;
+
+function TFormatStrParser.PeekIndexSpecifier(out Index: Integer): Boolean;
+var
+ SaveParsedString: WideString;
+ SaveFormatString: PWideChar;
+begin
+ SaveParsedString := ParsedString.Value;
+ SaveFormatString := PFormatString;
+ try
+ ParsedString.Clear;
+ Result := False;
+ Index := -1;
+ if ParseInteger then begin
+ Index := StrToInt(ParsedString.Value);
+ if ParseChar(':') then
+ Result := True;
+ end;
+ finally
+ ParsedString.Clear;
+ ParsedString.AddString(SaveParsedString);
+ PFormatString := SaveFormatString;
+ end;
+end;
+
+function TFormatStrParser.ParseFormatSpecifier: Boolean;
+var
+ ExplicitIndex: Integer;
+begin
+ Result := False;
+ // Parse entire format specifier
+ ForceParseChar('%');
+ if (PFormatString^ <> #0)
+ and (not ParseChar(' '))
+ and (not ParseChar('%')) then begin
+ if PeekIndexSpecifier(ExplicitIndex) then begin
+ Inc(ExplicitCount);
+ LastIndex := Max(LastIndex, ExplicitIndex);
+ end else begin
+ Inc(ImplicitCount);
+ Inc(LastIndex);
+ ParsedString.AddString(IntToStr(LastIndex));
+ ParsedString.AddChar(':');
+ end;
+ if ParseChar('*') then
+ begin
+ Inc(ImplicitCount);
+ Inc(LastIndex);
+ ParseChar(':');
+ end else if ParseInteger then
+ ParseChar(':');
+ ParseChar('-');
+ if ParseChar('*') then begin
+ Inc(ImplicitCount);
+ Inc(LastIndex);
+ end else
+ ParseInteger;
+ if ParseChar('.') then begin
+ if not ParseChar('*') then
+ ParseInteger;
+ end;
+ ForceParseType;
+ Result := True;
+ end;
+end;
+
+//-----------------------------------
+
+function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
+var
+ PosSpec: Integer;
+begin
+ with TFormatStrParser.Create(_FormatString) do
+ try
+ // loop until no more '%'
+ PosSpec := Pos('%', PFormatString);
+ While PosSpec <> 0 do begin
+ try
+ // delete everything up until '%'
+ ParsedString.AddBuffer(PFormatString, PosSpec - 1);
+ Inc(PFormatString, PosSpec - 1);
+ // parse format specifier
+ ParseFormatSpecifier;
+ finally
+ PosSpec := Pos('%', PFormatString);
+ end;
+ end;
+ if ((ExplicitCount = 0) and (ImplicitCount = 1)) {simple expression}
+ or ((ExplicitCount > 0) and (ImplicitCount = 0)) {nothing converted} then
+ result := _FormatString {original}
+ else
+ result := ParsedString.Value + PFormatString;
+ finally
+ Free;
+ end;
+end;
+
+{$IFDEF COMPILER_6_UP}
+function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
+ const Args: array of const
+ {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
+{ This function replaces floating point format specifiers with their actual formatted values.
+ It also adds index specifiers so that the other format specifiers don't lose their place.
+ The reason for this is that WideFormat doesn't correctly format floating point specifiers.
+ See QC#4254. }
+var
+ Parser: TFormatStrParser;
+ PosSpec: Integer;
+ Output: TBufferedWideString;
+begin
+ Output := TBufferedWideString.Create;
+ try
+ Parser := TFormatStrParser.Create(_FormatString);
+ with Parser do
+ try
+ // loop until no more '%'
+ PosSpec := Pos('%', PFormatString);
+ While PosSpec <> 0 do begin
+ try
+ // delete everything up until '%'
+ Output.AddBuffer(PFormatString, PosSpec - 1);
+ Inc(PFormatString, PosSpec - 1);
+ // parse format specifier
+ ParsedString.Clear;
+ if (not ParseFormatSpecifier)
+ or (GetFormatSpecifierType(ParsedString.Value) <> fstFloating) then
+ Output.AddBuffer(ParsedString.BuffPtr, MaxInt)
+ {$IFDEF COMPILER_7_UP}
+ else if Assigned(FormatSettings) then
+ Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args, FormatSettings^))
+ {$ENDIF}
+ else
+ Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args));
+ finally
+ PosSpec := Pos('%', PFormatString);
+ end;
+ end;
+ Output.AddString(PFormatString);
+ finally
+ Free;
+ end;
+ Result := Output.Value;
+ finally
+ Output.Free;
+ end;
+end;
+{$ENDIF}
+
+procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);
+var
+ PosSpec: Integer;
+begin
+ with TFormatStrParser.Create(_FormatString) do
+ try
+ FormatArgs.Clear;
+ // loop until no more '%'
+ PosSpec := Pos('%', PFormatString);
+ While PosSpec <> 0 do begin
+ try
+ // delete everything up until '%'
+ Inc(PFormatString, PosSpec - 1);
+ // add format specifier to list
+ ParsedString.Clear;
+ if ParseFormatSpecifier then
+ FormatArgs.Add(ParsedString.Value);
+ finally
+ PosSpec := Pos('%', PFormatString);
+ end;
+ end;
+ finally
+ Free;
+ end;
+end;
+
+function GetExplicitIndex(const FormatSpecifier: WideString): Integer;
+var
+ IndexStr: WideString;
+ PosColon: Integer;
+begin
+ result := -1;
+ PosColon := Pos(':', FormatSpecifier);
+ if PosColon <> 0 then begin
+ IndexStr := Copy(FormatSpecifier, 2, PosColon - 2);
+ result := StrToInt(IndexStr);
+ end;
+end;
+
+function GetMaxIndex(FormatArgs: TTntStrings): Integer;
+var
+ i: integer;
+ RunningIndex: Integer;
+ ExplicitIndex: Integer;
+begin
+ result := -1;
+ RunningIndex := -1;
+ for i := 0 to FormatArgs.Count - 1 do begin
+ ExplicitIndex := GetExplicitIndex(FormatArgs[i]);
+ if ExplicitIndex <> -1 then
+ RunningIndex := ExplicitIndex
+ else
+ inc(RunningIndex);
+ result := Max(result, RunningIndex);
+ end;
+end;
+
+procedure UpdateTypeList(FormatArgs, TypeList: TTntStrings);
+var
+ i: integer;
+ f: WideString;
+ SpecType: TFormatSpecifierType;
+ ExplicitIndex: Integer;
+ MaxIndex: Integer;
+ RunningIndex: Integer;
+begin
+ // set count of TypeList to accomodate maximum index
+ MaxIndex := GetMaxIndex(FormatArgs);
+ TypeList.Clear;
+ for i := 0 to MaxIndex do
+ TypeList.Add('');
+
+ // for each arg...
+ RunningIndex := -1;
+ for i := 0 to FormatArgs.Count - 1 do begin
+ f := FormatArgs[i];
+ ExplicitIndex := GetExplicitIndex(f);
+ SpecType := GetFormatSpecifierType(f);
+
+ // determine running arg index
+ if ExplicitIndex <> -1 then
+ RunningIndex := ExplicitIndex
+ else
+ inc(RunningIndex);
+
+ if TypeList[RunningIndex] <> '' then begin
+ // already exists in list, check for compatibility
+ if TypeList.Objects[RunningIndex] <> TObject(SpecType) then
+ raise ETntGeneralError.CreateFmt(SMismatchedArgumentTypes,
+ [RunningIndex, TypeList[RunningIndex], f]);
+ end else begin
+ // not in list so update it
+ TypeList[RunningIndex] := f;
+ TypeList.Objects[RunningIndex] := TObject(SpecType);
+ end;
+ end;
+end;
+
+procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
+var
+ ArgList1: TTntStringList;
+ ArgList2: TTntStringList;
+ TypeList1: TTntStringList;
+ TypeList2: TTntStringList;
+ i: integer;
+begin
+ ArgList1 := nil;
+ ArgList2 := nil;
+ TypeList1 := nil;
+ TypeList2 := nil;
+ try
+ ArgList1 := TTntStringList.Create;
+ ArgList2 := TTntStringList.Create;
+ TypeList1 := TTntStringList.Create;
+ TypeList2 := TTntStringList.Create;
+
+ GetFormatArgs(FormatStr1, ArgList1);
+ UpdateTypeList(ArgList1, TypeList1);
+
+ GetFormatArgs(FormatStr2, ArgList2);
+ UpdateTypeList(ArgList2, TypeList2);
+
+ if TypeList1.Count <> TypeList2.Count then
+ raise ETntGeneralError.Create(SMismatchedArgumentCounts);
+
+ for i := 0 to TypeList1.Count - 1 do begin
+ if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
+ raise ETntGeneralError.CreateFmt(SMismatchedArgumentTypes,
+ [i, TypeList1[i], TypeList2[i]]);
+ end;
+ end;
+
+ finally
+ ArgList1.Free;
+ ArgList2.Free;
+ TypeList1.Free;
+ TypeList2.Free;
+ end;
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntRegistry.pas
===================================================================
--- trunk/TntUnicodeControls/TntRegistry.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntRegistry.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,144 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntRegistry;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses Registry, Windows, TntClasses;
+
+{TNT-WARN TRegistry}
+type
+ TTntRegistry = class(TRegistry{TNT-ALLOW TRegistry})
+ private
+ procedure WriteStringEx(dwType: DWORD; const Name, Value: WideString);
+ public
+ procedure GetKeyNames(Strings: TTntStrings);
+ procedure GetValueNames(Strings: TTntStrings);
+ function ReadString(const Name: WideString): WideString;
+ procedure WriteString(const Name, Value: WideString);
+ procedure WriteExpandString(const Name, Value: WideString);
+ end;
+
+implementation
+
+uses {$IFDEF COMPILER_6_UP} RTLConsts, {$ELSE} Consts, {$ENDIF} TntSysUtils;
+
+{ TTntRegistry }
+
+procedure TTntRegistry.GetKeyNames(Strings: TTntStrings);
+var
+ Len: DWORD;
+ I: Integer;
+ Info: TRegKeyInfo;
+ S: WideString;
+begin
+ if (not Win32PlatformIsUnicode) then
+ inherited GetKeyNames(Strings.AnsiStrings)
+ else begin
+ Strings.Clear;
+ if GetKeyInfo(Info) then
+ begin
+ SetLength(S, Info.MaxSubKeyLen + 1);
+ for I := 0 to Info.NumSubKeys - 1 do
+ begin
+ Len := Info.MaxSubKeyLen + 1;
+ RegEnumKeyExW(CurrentKey, I, PWideChar(S), Len, nil, nil, nil, nil);
+ Strings.Add(PWideChar(S));
+ end;
+ end;
+ end;
+end;
+
+{$IFNDEF COMPILER_8_UP} // fix declaration for RegEnumValueW (lpValueName is a PWideChar)
+function RegEnumValueW(hKey: HKEY; dwIndex: DWORD; lpValueName: PWideChar;
+ var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD;
+ lpData: PByte; lpcbData: PDWORD): Longint; stdcall; external advapi32 name 'RegEnumValueW';
+{$ENDIF}
+
+procedure TTntRegistry.GetValueNames(Strings: TTntStrings);
+var
+ Len: DWORD;
+ I: Integer;
+ Info: TRegKeyInfo;
+ S: WideString;
+begin
+ if (not Win32PlatformIsUnicode) then
+ inherited GetValueNames(Strings.AnsiStrings)
+ else begin
+ Strings.Clear;
+ if GetKeyInfo(Info) then
+ begin
+ SetLength(S, Info.MaxValueLen + 1);
+ for I := 0 to Info.NumValues - 1 do
+ begin
+ Len := Info.MaxValueLen + 1;
+ RegEnumValueW(CurrentKey, I, PWideChar(S), Len, nil, nil, nil, nil);
+ Strings.Add(PWideChar(S));
+ end;
+ end;
+ end;
+end;
+
+function TTntRegistry.ReadString(const Name: WideString): WideString;
+var
+ DataType: Cardinal;
+ BufSize: Cardinal;
+begin
+ if (not Win32PlatformIsUnicode) then
+ result := inherited ReadString(Name)
+ else begin
+ // get length and type
+ DataType := REG_NONE;
+ if RegQueryValueExW(CurrentKey, PWideChar(Name), nil,
+ @DataType, nil, @BufSize) <> ERROR_SUCCESS then
+ Result := ''
+ else begin
+ // check type
+ if not (DataType in [REG_SZ, REG_EXPAND_SZ]) then
+ raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+ SetLength(Result, BufSize div SizeOf(WideChar));
+ if RegQueryValueExW(CurrentKey, PWideChar(Name), nil,
+ @DataType, PByte(PWideChar(Result)), @BufSize) <> ERROR_SUCCESS then
+ raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
+ Result := PWideChar(Result);
+ end
+ end
+end;
+
+procedure TTntRegistry.WriteStringEx(dwType: DWORD; const Name, Value: WideString);
+begin
+ Assert(dwType in [REG_SZ, REG_EXPAND_SZ]);
+ if (not Win32PlatformIsUnicode) then begin
+ if dwType = REG_SZ then
+ inherited WriteString(Name, Value)
+ else
+ inherited WriteExpandString(Name, Value);
+ end else begin
+ if RegSetValueExW(CurrentKey, PWideChar(Name), 0, dwType,
+ PWideChar(Value), (Length(Value) + 1) * SizeOf(WideChar)) <> ERROR_SUCCESS then
+ raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
+ end;
+end;
+
+procedure TTntRegistry.WriteString(const Name, Value: WideString);
+begin
+ WriteStringEx(REG_SZ, Name, Value);
+end;
+
+procedure TTntRegistry.WriteExpandString(const Name, Value: WideString);
+begin
+ WriteStringEx(REG_EXPAND_SZ, Name, Value);
+end;
+
+end.
Added: trunk/TntUnicodeControls/TntSysUtils.pas
===================================================================
--- trunk/TntUnicodeControls/TntSysUtils.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntSysUtils.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,1970 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntSysUtils;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ {$IFDEF COMPILER_6_UP} Types, {$ENDIF} SysUtils, Windows;
+
+//---------------------------------------------------------------------------------------------
+// Tnt - Types
+//---------------------------------------------------------------------------------------------
+
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+type
+ TWideStringDynArray = array of WideString;
+{$ENDIF}
+// ......... introduced .........
+type
+ // The user of the application did something plainly wrong.
+ ETntUserError = class(Exception);
+ // A general error occured. (ie. file didn't exist, server didn't return data, etc.)
+ ETntGeneralError = class(Exception);
+ // Like Assert(). An error occured that should never have happened, send me a bug report now!
+ ETntInternalError = class(Exception);
+
+//---------------------------------------------------------------------------------------------
+// Tnt - SysUtils
+//---------------------------------------------------------------------------------------------
+
+// ......... compatibility .........
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+resourcestring
+ SInvalidCurrency = '''%s'' is not a valid currency value';
+
+const sLineBreak = #13#10;
+const PathDelim = '\';
+const DriveDelim = ':';
+const PathSep = ';';
+
+procedure RaiseLastOSError;
+function WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
+function WideCompareStr(const W1, W2: WideString): Integer;
+function WideSameStr(const W1, W2: WideString): Boolean;
+function WideCompareText(const W1, W2: WideString): Integer;
+function WideSameText(const W1, W2: WideString): Boolean;
+function Supports(const Instance: TObject; const IID: TGUID): Boolean;
+{$ENDIF}
+
+// ......... SBCS and MBCS functions with WideString replacements in SysUtils.pas .........
+
+{TNT-WARN CompareStr} {TNT-WARN AnsiCompareStr}
+{TNT-WARN SameStr} {TNT-WARN AnsiSameStr}
+{TNT-WARN SameText} {TNT-WARN AnsiSameText}
+{TNT-WARN CompareText} {TNT-WARN AnsiCompareText}
+{TNT-WARN UpperCase} {TNT-WARN AnsiUpperCase}
+{TNT-WARN LowerCase} {TNT-WARN AnsiLowerCase}
+
+{TNT-WARN AnsiPos} { --> Pos() supports WideString. }
+{TNT-WARN FmtStr}
+{TNT-WARN Format}
+{TNT-WARN FormatBuf}
+
+// ......... MBCS Byte Type Procs .........
+
+{TNT-WARN ByteType}
+{TNT-WARN StrByteType}
+{TNT-WARN ByteToCharIndex}
+{TNT-WARN ByteToCharLen}
+{TNT-WARN CharToByteIndex}
+{TNT-WARN CharToByteLen}
+
+// ........ null-terminated string functions .........
+
+{TNT-WARN StrEnd}
+function StrEndW(Str: PWideChar): PWideChar;
+{TNT-WARN StrLen}
+function StrLenW(Str: PWideChar): Cardinal;
+{TNT-WARN StrLCopy}
+function StrLCopyW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
+{TNT-WARN StrCopy}
+function StrCopyW(Dest, Source: PWideChar): PWideChar;
+{TNT-WARN StrECopy}
+function StrECopyW(Dest, Source: PWideChar): PWideChar;
+{TNT-WARN StrPLCopy}
+{TNT-WARN StrPLCopyW} // <-- accepts ansi string parameter
+function StrPLCopyW{TNT-ALLOW StrPLCopyW}(Dest: PWideChar; const Source: AnsiString; MaxLen: Cardinal): PWideChar;
+{TNT-WARN StrPCopy}
+{TNT-WARN StrPCopyW} // < -- accepts ansi string parameter
+function StrPCopyW{TNT-ALLOW StrPCopyW}(Dest: PWideChar; const Source: AnsiString): PWideChar;
+{TNT-WARN StrLComp}
+{TNT-WARN AnsiStrLComp}
+function StrLCompW(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
+{TNT-WARN StrComp}
+{TNT-WARN AnsiStrComp}
+function StrCompW(Str1, Str2: PWideChar): Integer;
+{TNT-WARN StrLIComp}
+{TNT-WARN AnsiStrLIComp}
+function StrLICompW(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
+{TNT-WARN StrIComp}
+{TNT-WARN AnsiStrIComp}
+function StrICompW(Str1, Str2: PWideChar): Integer;
+{TNT-WARN StrLower}
+{TNT-WARN AnsiStrLower}
+function StrLowerW(Str: PWideChar): PWideChar;
+{TNT-WARN StrUpper}
+{TNT-WARN AnsiStrUpper}
+function StrUpperW(Str: PWideChar): PWideChar;
+{TNT-WARN StrPos}
+{TNT-WARN AnsiStrPos}
+function StrPosW(Str, SubStr: PWideChar): PWideChar;
+{TNT-WARN StrScan}
+{TNT-WARN AnsiStrScan}
+function StrScanW(const Str: PWideChar; Chr: WideChar): PWideChar;
+{TNT-WARN StrRScan}
+{TNT-WARN AnsiStrRScan}
+function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar;
+{TNT-WARN StrLCat}
+function StrLCatW(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
+{TNT-WARN StrCat}
+function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar;
+{TNT-WARN StrMove}
+function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
+{TNT-WARN StrPas}
+function StrPasW(const Str: PWideChar): WideString;
+{TNT-WARN StrAlloc}
+function StrAllocW(Size: Cardinal): PWideChar;
+{TNT-WARN StrBufSize}
+function StrBufSizeW(const Str: PWideChar): Cardinal;
+{TNT-WARN StrNew}
+function StrNewW(const Str: PWideChar): PWideChar;
+{TNT-WARN StrDispose}
+procedure StrDisposeW(Str: PWideChar);
+
+// ........ string functions .........
+
+{$IFDEF COMPILER_7_UP}
+type
+ PFormatSettings= ^TFormatSettings;
+{$ENDIF}
+
+{$IFDEF COMPILER_6_UP}
+{TNT-WARN WideFormatBuf} // SysUtils.WideFormatBuf doesn't correctly handle numeric specifiers.
+function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
+ FmtLen: Cardinal; const Args: array of const): Cardinal; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
+ FmtLen: Cardinal; const Args: array of const;
+ const FormatSettings: TFormatSettings): Cardinal; overload;
+{$ENDIF}
+
+{$IFDEF COMPILER_6_UP}
+{TNT-WARN WideFmtStr} // SysUtils.WideFmtStr doesn't handle string lengths > 4096.
+procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
+ const Args: array of const); {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
+ const Args: array of const; const FormatSettings: TFormatSettings); overload;
+{$ENDIF}
+
+{$IFDEF COMPILER_6_UP}
+{----------------------------------------------------------------------------------------
+ Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
+ TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
+ will fix WideFormat as well as WideFmtStr.
+----------------------------------------------------------------------------------------}
+function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
+ const FormatSettings: TFormatSettings): WideString; overload;
+{$ENDIF}
+
+{TNT-WARN WideUpperCase} // SysUtils.WideUpperCase is broken on Win9x.
+function Tnt_WideUpperCase(const S: WideString): WideString;
+
+{TNT-WARN WideLowerCase} // SysUtils.WideLowerCase is broken on Win9x.
+function Tnt_WideLowerCase(const S: WideString): WideString;
+
+{TNT-WARN AnsiLastChar}
+{TNT-WARN AnsiStrLastChar}
+function WideLastChar(W: WideString): WideChar;
+
+{TNT-WARN StringReplace}
+function WideStringReplace(const S, OldPattern, NewPattern: WideString;
+ Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;
+
+{TNT-WARN AdjustLineBreaks}
+type TTntTextLineBreakStyle = (tlbsLF, tlbsCRLF, tlbsCR);
+function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
+function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
+
+{TNT-WARN QuotedStr}
+{TNT-WARN AnsiQuotedStr}
+function WideQuotedStr(const S: WideString; Quote: WideChar = '"'): WideString;
+
+{TNT-WARN AnsiExtractQuotedStr}
+function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar = '"'): WideString;
+
+{TNT-WARN AnsiDequotedStr}
+function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
+
+{TNT-WARN WrapText}
+function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
+ MaxCol: Integer): WideString; overload;
+function WideWrapText(const Line: WideString; MaxCol: Integer): WideString; overload;
+
+// ........ filename manipulation .........
+
+{TNT-WARN SameFileName} // doesn't apply to Unicode filenames, use WideSameText
+{TNT-WARN AnsiCompareFileName} // doesn't apply to Unicode filenames, use WideCompareText
+{TNT-WARN AnsiLowerCaseFileName} // doesn't apply to Unicode filenames, use WideLowerCase
+{TNT-WARN AnsiUpperCaseFileName} // doesn't apply to Unicode filenames, use WideUpperCase
+
+{TNT-WARN IncludeTrailingBackslash}
+function WideIncludeTrailingBackslash(const S: WideString): WideString;
+{TNT-WARN ExcludeTrailingBackslash}
+function WideExcludeTrailingBackslash(const S: WideString): WideString;
+{TNT-WARN IsDelimiter}
+function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
+{TNT-WARN IsPathDelimiter}
+function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
+{TNT-WARN LastDelimiter}
+function WideLastDelimiter(const Delimiters, S: WideString): Integer;
+{TNT-WARN ChangeFileExt}
+function WideChangeFileExt(const FileName, Extension: WideString): WideString;
+{TNT-WARN ExtractFilePath}
+function WideExtractFilePath(const FileName: WideString): WideString;
+{TNT-WARN ExtractFileDir}
+function WideExtractFileDir(const FileName: WideString): WideString;
+{TNT-WARN ExtractFileDrive}
+function WideExtractFileDrive(const FileName: WideString): WideString;
+{TNT-WARN ExtractFileName}
+function WideExtractFileName(const FileName: WideString): WideString;
+{TNT-WARN ExtractFileExt}
+function WideExtractFileExt(const FileName: WideString): WideString;
+{TNT-WARN ExtractRelativePath}
+function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
+
+// ........ file management routines .........
+
+{TNT-WARN ExpandFileName}
+function WideExpandFileName(const FileName: WideString): WideString;
+{TNT-WARN ExtractShortPathName}
+function WideExtractShortPathName(const FileName: WideString): WideString;
+{TNT-WARN FileCreate}
+function WideFileCreate(const FileName: WideString): Integer;
+{TNT-WARN FileOpen}
+function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
+{TNT-WARN FileAge}
+function WideFileAge(const FileName: WideString): Integer;
+{TNT-WARN DirectoryExists}
+function WideDirectoryExists(const Name: WideString): Boolean;
+{TNT-WARN FileExists}
+function WideFileExists(const Name: WideString): Boolean;
+{TNT-WARN FileGetAttr}
+function WideFileGetAttr(const FileName: WideString): Cardinal;
+{TNT-WARN FileSetAttr}
+function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
+{TNT-WARN ForceDirectories}
+function WideForceDirectories(Dir: WideString): Boolean;
+{TNT-WARN FileSearch}
+function WideFileSearch(const Name, DirList: WideString): WideString;
+{TNT-WARN RenameFile}
+function WideRenameFile(const OldName, NewName: WideString): Boolean;
+{TNT-WARN DeleteFile}
+function WideDeleteFile(const FileName: WideString): Boolean;
+{TNT-WARN CopyFile}
+function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
+
+{TNT-WARN TSearchRec} // <-- FindFile - warning on TSearchRec is all that is necessary
+type
+ TSearchRecW = record
+ Time: Integer;
+ Size: Int64;
+ Attr: Integer;
+ Name: WideString;
+ ExcludeAttr: Integer;
+ FindHandle: THandle;
+ FindData: TWin32FindDataW;
+ end;
+function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
+function WideFindNext(var F: TSearchRecW): Integer;
+procedure WideFindClose(var F: TSearchRecW);
+
+{TNT-WARN RemoveDir}
+function WideRemoveDir(const Dir: WideString): Boolean;
+{TNT-WARN SetCurrentDir}
+function WideSetCurrentDir(const Dir: WideString): Boolean;
+
+// ........ date/time functions .........
+
+function ValidDateTimeStr(Str: WideString): Boolean;
+function ValidDateStr(Str: WideString): Boolean;
+function ValidTimeStr(Str: WideString): Boolean;
+
+{TNT-WARN StrToDateTime}
+function TntStrToDateTime(Str: WideString): TDateTime;
+{TNT-WARN StrToDate}
+function TntStrToDate(Str: WideString): TDateTime;
+{TNT-WARN StrToTime}
+function TntStrToTime(Str: WideString): TDateTime;
+{TNT-WARN StrToDateTimeDef}
+function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
+{TNT-WARN StrToDateDef}
+function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
+{TNT-WARN StrToTimeDef}
+function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
+
+{TNT-WARN CurrToStr}
+{TNT-WARN CurrToStrF}
+function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
+{TNT-WARN StrToCurr}
+function TntStrToCurr(const S: WideString): Currency;
+{TNT-WARN StrToCurrDef}
+function ValidCurrencyStr(const S: WideString): Boolean;
+function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
+function GetDefaultCurrencyFmt: TCurrencyFmtW;
+
+// ........ misc functions .........
+
+{TNT-WARN GetLocaleStr}
+function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
+
+// ......... introduced .........
+
+const
+ CR = WideChar(#13);
+ LF = WideChar(#10);
+ CRLF = WideString(#13#10);
+ WideLineSeparator = WideChar($2028);
+
+var
+ Win32PlatformIsUnicode: Boolean;
+ Win32PlatformIsXP: Boolean;
+
+{$IFNDEF COMPILER_7_UP}
+function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
+{$ENDIF}
+function WinCheckH(RetVal: Cardinal): Cardinal;
+function WinCheckFileH(RetVal: Cardinal): Cardinal;
+function WinCheckP(RetVal: Pointer): Pointer;
+
+function WideGetModuleFileName(Instance: HModule): WideString;
+function WideSafeLoadLibrary(const Filename: Widestring;
+ ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE;
+function WideLoadPackage(const Name: Widestring): HMODULE;
+
+function IsWideCharUpper(WC: WideChar): Boolean;
+function IsWideCharLower(WC: WideChar): Boolean;
+function IsWideCharDigit(WC: WideChar): Boolean;
+function IsWideCharSpace(WC: WideChar): Boolean;
+function IsWideCharPunct(WC: WideChar): Boolean;
+function IsWideCharCntrl(WC: WideChar): Boolean;
+function IsWideCharBlank(WC: WideChar): Boolean;
+function IsWideCharXDigit(WC: WideChar): Boolean;
+function IsWideCharAlpha(WC: WideChar): Boolean;
+function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
+
+function WideTextPos(const SubStr, S: WideString): Integer;
+
+function ExtractStringArrayStr(P: PWideChar): WideString;
+function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
+function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;
+
+function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
+function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
+function IsRTF(const Value: WideString): Boolean;
+
+function ENG_US_FloatToStr(Value: Extended): WideString;
+function ENG_US_StrToFloat(const S: WideString): Extended;
+
+//---------------------------------------------------------------------------------------------
+// Tnt - Variants
+//---------------------------------------------------------------------------------------------
+
+// ......... compatibility .........
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+function VarToWideStr(const V: Variant): WideString;
+function VarToWideStrDef(const V: Variant; const ADefault: WideString): WideString;
+{$ENDIF}
+
+// ........ Variants.pas has WideString versions of these functions .........
+{TNT-WARN VarToStr}
+{TNT-WARN VarToStrDef}
+
+var
+ _SettingChangeTime: Cardinal;
+
+implementation
+
+uses
+ ActiveX, ComObj, Math, SysConst, Consts,
+ TntSystem, TntWindows, TntFormatStrUtils;
+
+//---------------------------------------------------------------------------------------------
+// Tnt - SysUtils
+//---------------------------------------------------------------------------------------------
+
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+procedure RaiseLastOSError;
+begin
+ RaiseLastWin32Error;
+end;
+
+function WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
+begin
+ Result := Format{TNT-ALLOW Format}(FormatStr, Args);
+end;
+
+function WideCompareStr(const W1, W2: WideString): Integer;
+begin
+ Result := Tnt_CompareStringW(GetThreadLocale, 0,
+ PWideChar(W1), Length(W1), PWideChar(W2), Length(W2)) - 2;
+end;
+
+function WideSameStr(const W1, W2: WideString): Boolean;
+begin
+ Result := WideCompareStr(W1, W2) = 0;
+end;
+
+function WideCompareText(const W1, W2: WideString): Integer;
+begin
+ Result := Tnt_CompareStringW(GetThreadLocale, NORM_IGNORECASE,
+ PWideChar(W1), Length(W1), PWideChar(W2), Length(W2)) - 2;
+end;
+
+function WideSameText(const W1, W2: WideString): Boolean;
+begin
+ Result := WideCompareText(W1, W2) = 0;
+end;
+
+function Supports(const Instance: TObject; const IID: TGUID): Boolean;
+var
+ Temp: IUnknown;
+begin
+ Result := Instance.GetInterface(IID, Temp);
+end;
+{$ENDIF}
+
+function StrEndW(Str: PWideChar): PWideChar;
+begin
+ // returns a pointer to the end of a null terminated string
+ Result := Str;
+ While Result^ <> #0 do
+ Inc(Result);
+end;
+
+function StrLenW(Str: PWideChar): Cardinal;
+begin
+ Result := StrEndW(Str) - Str;
+end;
+
+function StrLCopyW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
+var
+ Count: Cardinal;
+begin
+ // copies a specified maximum number of characters from Source to Dest
+ Result := Dest;
+ Count := 0;
+ While (Count < MaxLen) and (Source^ <> #0) do begin
+ Dest^ := Source^;
+ Inc(Source);
+ Inc(Dest);
+ Inc(Count);
+ end;
+ Dest^ := #0;
+end;
+
+function StrCopyW(Dest, Source: PWideChar): PWideChar;
+begin
+ Result := StrLCopyW(Dest, Source, MaxInt);
+end;
+
+function StrECopyW(Dest, Source: PWideChar): PWideChar;
+begin
+ Result := StrEndW(StrCopyW(Dest, Source));
+end;
+
+function StrPLCopyW{TNT-ALLOW StrPLCopyW}(Dest: PWideChar; const Source: AnsiString; MaxLen: Cardinal): PWideChar;
+begin
+ Result := StrLCopyW(Dest, PWideChar(WideString(Source)), MaxLen);
+end;
+
+function StrPCopyW{TNT-ALLOW StrPCopyW}(Dest: PWideChar; const Source: AnsiString): PWideChar;
+begin
+ Result := StrPLCopyW{TNT-ALLOW StrPLCopyW}(Dest, Source, MaxInt);
+end;
+
+function StrCompW_EX(Str1, Str2: PWideChar; MaxLen: Cardinal; dwCmpFlags: Cardinal): Integer;
+var
+ Len1, Len2: Integer;
+begin
+ if MaxLen = Cardinal(MaxInt) then begin
+ Len1 := -1;
+ Len2 := -1;
+ end else begin
+ Len1 := Min(StrLenW(Str1), MaxLen);
+ Len2 := Min(StrLenW(Str2), MaxLen);
+ end;
+ Result := Tnt_CompareStringW(GetThreadLocale, dwCmpFlags, Str1, Len1, Str2, Len2) - 2;
+end;
+
+function StrLCompW(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
+begin
+ Result := StrCompW_EX(Str1, Str2, MaxLen, 0);
+end;
+
+function StrCompW(Str1, Str2: PWideChar): Integer;
+begin
+ Result := StrLCompW(Str1, Str2, MaxInt);
+end;
+
+function StrLICompW(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
+begin
+ Result := StrCompW_EX(Str1, Str2, MaxLen, NORM_IGNORECASE);
+end;
+
+function StrICompW(Str1, Str2: PWideChar): Integer;
+begin
+ Result := StrLICompW(Str1, Str2, MaxInt);
+end;
+
+function StrLowerW(Str: PWideChar): PWideChar;
+begin
+ Result := Str;
+ Tnt_CharLowerBuffW(Str, StrLenW(Str))
+end;
+
+function StrUpperW(Str: PWideChar): PWideChar;
+begin
+ Result := Str;
+ Tnt_CharUpperBuffW(Str, StrLenW(Str))
+end;
+
+function StrPosW(Str, SubStr: PWideChar): PWideChar;
+var
+ PSave: PWideChar;
+ P: PWideChar;
+ PSub: PWideChar;
+begin
+ // returns a pointer to the first occurance of SubStr in Str
+ Result := nil;
+ if (Str <> nil) and (Str^ <> #0) and (SubStr <> nil) and (SubStr^ <> #0) then begin
+ P := Str;
+ While P^ <> #0 do begin
+ if P^ = SubStr^ then begin
+ // investigate possibility here
+ PSave := P;
+ PSub := SubStr;
+ While (P^ = PSub^) do begin
+ Inc(P);
+ Inc(PSub);
+ if (PSub^ = #0) then begin
+ Result := PSave;
+ exit; // found a match
+ end;
+ if (P^ = #0) then
+ exit; // no match, hit end of string
+ end;
+ P := PSave;
+ end;
+ Inc(P);
+ end;
+ end;
+end;
+
+function StrScanW(const Str: PWideChar; Chr: WideChar): PWideChar;
+begin
+ Result := Str;
+ while Result^ <> Chr do
+ begin
+ if Result^ = #0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ Inc(Result);
+ end;
+end;
+
+function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar;
+var
+ MostRecentFound: PWideChar;
+begin
+ if Chr = #0 then
+ Result := StrEndW(Str)
+ else
+ begin
+ Result := nil;
+ MostRecentFound := Str;
+ while True do
+ begin
+ while MostRecentFound^ <> Chr do
+ begin
+ if MostRecentFound^ = #0 then
+ Exit;
+ Inc(MostRecentFound);
+ end;
+ Result := MostRecentFound;
+ Inc(MostRecentFound);
+ end;
+ end;
+end;
+
+function StrLCatW(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
+begin
+ Result := Dest;
+ StrLCopyW(StrEndW(Dest), Source, MaxLen - StrLenW(Dest));
+end;
+
+function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar;
+begin
+ Result := Dest;
+ StrCopyW(StrEndW(Dest), Source);
+end;
+
+function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
+var
+ Length: Integer;
+begin
+ Result := Dest;
+ Length := Count * SizeOf(WideChar);
+ Move(Source^, Dest^, Length);
+end;
+
+function StrPasW(const Str: PWideChar): WideString;
+begin
+ Result := Str;
+end;
+
+function StrAllocW(Size: Cardinal): PWideChar;
+begin
+ Size := SizeOf(Cardinal) + (Size * SizeOf(WideChar));
+ GetMem(Result, Size);
+ PCardinal(Result)^ := Size;
+ Inc(PAnsiChar(Result), SizeOf(Cardinal));
+end;
+
+function StrBufSizeW(const Str: PWideChar): Cardinal;
+var
+ P: PWideChar;
+begin
+ P := Str;
+ Dec(PAnsiChar(P), SizeOf(Cardinal));
+ Result := PCardinal(P)^ - SizeOf(Cardinal);
+ Result := Result div SizeOf(WideChar);
+end;
+
+function StrNewW(const Str: PWideChar): PWideChar;
+var
+ Size: Cardinal;
+begin
+ if Str = nil then Result := nil else
+ begin
+ Size := StrLenW(Str) + 1;
+ Result := StrMoveW(StrAllocW(Size), Str, Size);
+ end;
+end;
+
+procedure StrDisposeW(Str: PWideChar);
+begin
+ if Str <> nil then
+ begin
+ Dec(PAnsiChar(Str), SizeOf(Cardinal));
+ FreeMem(Str, Cardinal(Pointer(Str)^));
+ end;
+end;
+
+{$IFDEF COMPILER_6_UP}
+function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
+ FmtLen: Cardinal; const Args: array of const
+ {$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings {$ENDIF}): Cardinal;
+var
+ OldFormat: WideString;
+ NewFormat: WideString;
+begin
+ SetString(OldFormat, PWideChar(@FormatStr), FmtLen);
+ { The reason for this is that WideFormat doesn't correctly format floating point specifiers.
+ See QC#4254. }
+ NewFormat := ReplaceFloatingArgumentsInFormatString(OldFormat, Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
+ {$IFDEF COMPILER_7_UP}
+ if FormatSettings <> nil then
+ Result := WideFormatBuf{TNT-ALLOW WideFormatBuf}(Buffer, BufLen, Pointer(NewFormat)^,
+ Length(NewFormat), Args, FormatSettings^)
+ else
+ {$ENDIF}
+ Result := WideFormatBuf{TNT-ALLOW WideFormatBuf}(Buffer, BufLen, Pointer(NewFormat)^,
+ Length(NewFormat), Args);
+end;
+
+function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
+ FmtLen: Cardinal; const Args: array of const): Cardinal;
+begin
+ Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
+end;
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
+ FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
+begin
+ Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args, @FormatSettings);
+end;
+{$ENDIF}
+
+{$IFDEF COMPILER_6_UP}
+procedure _Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
+ const Args: array of const{$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings{$ENDIF});
+var
+ Len, BufLen: Integer;
+ Buffer: array[0..4095] of WideChar;
+begin
+ BufLen := Length(Buffer); // Fixes buffer overwrite issue. (See QC #4703, #4744)
+ if Length(FormatStr) < (Length(Buffer) - (Length(Buffer) div 4)) then
+ Len := _Tnt_WideFormatBuf(Buffer, Length(Buffer) - 1, Pointer(FormatStr)^,
+ Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF})
+ else
+ begin
+ BufLen := Length(FormatStr);
+ Len := BufLen;
+ end;
+ if Len >= BufLen - 1 then
+ begin
+ while Len >= BufLen - 1 do
+ begin
+ Inc(BufLen, BufLen);
+ Result := ''; // prevent copying of existing data, for speed
+ SetLength(Result, BufLen);
+ Len := _Tnt_WideFormatBuf(Pointer(Result)^, BufLen - 1, Pointer(FormatStr)^,
+ Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
+ end;
+ SetLength(Result, Len);
+ end
+ else
+ SetString(Result, Buffer, Len);
+end;
+
+procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
+ const Args: array of const);
+begin
+ _Tnt_WideFmtStr(Result, FormatStr, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
+end;
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
+ const Args: array of const; const FormatSettings: TFormatSettings);
+begin
+ _Tnt_WideFmtStr(Result, FormatStr, Args, @FormatSettings);
+end;
+{$ENDIF}
+
+{$IFDEF COMPILER_6_UP}
+{----------------------------------------------------------------------------------------
+ Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
+ TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
+ will fix WideFormat as well as WideFmtStr.
+----------------------------------------------------------------------------------------}
+function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
+begin
+ Tnt_WideFmtStr(Result, FormatStr, Args);
+end;
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
+ const FormatSettings: TFormatSettings): WideString;
+begin
+ Tnt_WideFmtStr(Result, FormatStr, Args, FormatSettings);
+end;
+{$ENDIF}
+
+function Tnt_WideUpperCase(const S: WideString): WideString;
+begin
+ { SysUtils.WideUpperCase is broken for Win9x. }
+ Result := S;
+ if Length(Result) > 0 then
+ Tnt_CharUpperBuffW(PWideChar(Result), Length(Result));
+end;
+
+function Tnt_WideLowerCase(const S: WideString): WideString;
+begin
+ { SysUtils.WideLowerCase is broken for Win9x. }
+ Result := S;
+ if Length(Result) > 0 then
+ Tnt_CharLowerBuffW(PWideChar(Result), Length(Result));
+end;
+
+function WideLastChar(W: WideString): WideChar;
+begin
+ if Length(W) = 0 then
+ Result := #0
+ else
+ Result := W[Length(W)];
+end;
+
+function WideStringReplace(const S, OldPattern, NewPattern: WideString;
+ Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;
+
+ function IsWordSeparator(WC: WideChar): Boolean;
+ begin
+ Result := (WC = WideChar(#0))
+ or IsWideCharSpace(WC)
+ or IsWideCharPunct(WC);
+ end;
+
+var
+ SearchStr, Patt, NewStr: WideString;
+ Offset: Integer;
+ PrevChar, NextChar: WideChar;
+begin
+ if rfIgnoreCase in Flags then
+ begin
+ SearchStr := Tnt_WideUpperCase(S);
+ Patt := Tnt_WideUpperCase(OldPattern);
+ end else
+ begin
+ SearchStr := S;
+ Patt := OldPattern;
+ end;
+ NewStr := S;
+ Result := '';
+ while SearchStr <> '' do
+ begin
+ Offset := Pos(Patt, SearchStr);
+ if Offset = 0 then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end; // done
+
+ if (WholeWord) then
+ begin
+ if (Offset = 1) then
+ PrevChar := WideLastChar(Result)
+ else
+ PrevChar := NewStr[Offset - 1];
+
+ if Offset + Length(OldPattern) <= Length(NewStr) then
+ NextChar := NewStr[Offset + Length(OldPattern)]
+ else
+ NextChar := WideChar(#0);
+
+ if (not IsWordSeparator(PrevChar))
+ or (not IsWordSeparator(NextChar)) then
+ begin
+ Result := Result + Copy(NewStr, 1, Offset + Length(OldPattern) - 1);
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
+ continue;
+ end;
+ end;
+
+ Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ if not (rfReplaceAll in Flags) then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
+ end;
+end;
+
+function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
+var
+ Source, SourceEnd: PWideChar;
+begin
+ Source := Pointer(S);
+ SourceEnd := Source + Length(S);
+ Result := Length(S);
+ while Source < SourceEnd do
+ begin
+ case Source^ of
+ #10, WideLineSeparator:
+ if Style = tlbsCRLF then
+ Inc(Result);
+ #13:
+ if Style = tlbsCRLF then
+ if Source[1] = #10 then
+ Inc(Source)
+ else
+ Inc(Result)
+ else
+ if Source[1] = #10 then
+ Dec(Result);
+ end;
+ Inc(Source);
+ end;
+end;
+
+function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
+var
+ Source, SourceEnd, Dest: PWideChar;
+ DestLen: Integer;
+begin
+ Source := Pointer(S);
+ SourceEnd := Source + Length(S);
+ DestLen := TntAdjustLineBreaksLength(S, Style);
+ SetString(Result, nil, DestLen);
+ Dest := Pointer(Result);
+ while Source < SourceEnd do begin
+ case Source^ of
+ #10, WideLineSeparator:
+ begin
+ if Style in [tlbsCRLF, tlbsCR] then
+ begin
+ Dest^ := #13;
+ Inc(Dest);
+ end;
+ if Style in [tlbsCRLF, tlbsLF] then
+ begin
+ Dest^ := #10;
+ Inc(Dest);
+ end;
+ Inc(Source);
+ end;
+ #13:
+ begin
+ if Style in [tlbsCRLF, tlbsCR] then
+ begin
+ Dest^ := #13;
+ Inc(Dest);
+ end;
+ if Style in [tlbsCRLF, tlbsLF] then
+ begin
+ Dest^ := #10;
+ Inc(Dest);
+ end;
+ Inc(Source);
+ if Source^ = #10 then Inc(Source);
+ end;
+ else
+ Dest^ := Source^;
+ Inc(Dest);
+ Inc(Source);
+ end;
+ end;
+end;
+
+function WideQuotedStr(const S: WideString; Quote: WideChar = '"'): WideString;
+var
+ P, Src,
+ Dest: PWideChar;
+ AddCount: Integer;
+begin
+ AddCount := 0;
+ P := StrScanW(PWideChar(S), Quote);
+ while (P <> nil) do
+ begin
+ Inc(P);
+ Inc(AddCount);
+ P := StrScanW(P, Quote);
+ end;
+
+ if AddCount = 0 then
+ Result := Quote + S + Quote
+ else
+ begin
+ SetLength(Result, Length(S) + AddCount + 2);
+ Dest := PWideChar(Result);
+ Dest^ := Quote;
+ Inc(Dest);
+ Src := PWideChar(S);
+ P := StrScanW(Src, Quote);
+ repeat
+ Inc(P);
+ Move(Src^, Dest^, 2 * (P - Src));
+ Inc(Dest, P - Src);
+ Dest^ := Quote;
+ Inc(Dest);
+ Src := P;
+ P := StrScanW(Src, Quote);
+ until P = nil;
+ P := StrEndW(Src);
+ Move(Src^, Dest^, 2 * (P - Src));
+ Inc(Dest, P - Src);
+ Dest^ := Quote;
+ end;
+end;
+
+function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar = '"'): WideString;
+var
+ P, Dest: PWideChar;
+ DropCount: Integer;
+begin
+ Result := '';
+ if (Src = nil) or (Src^ <> Quote) then
+ Exit;
+
+ Inc(Src);
+ DropCount := 1;
+ P := Src;
+ Src := StrScanW(Src, Quote);
+
+ while Src <> nil do // count adjacent pairs of quote chars
+ begin
+ Inc(Src);
+ if Src^ <> Quote then
+ Break;
+ Inc(Src);
+ Inc(DropCount);
+ Src := StrScanW(Src, Quote);
+ end;
+
+ if Src = nil then
+ Src := StrEndW(P);
+ if (Src - P) <= 1 then
+ Exit;
+
+ if DropCount = 1 then
+ SetString(Result, P, Src - P - 1)
+ else
+ begin
+ SetLength(Result, Src - P - DropCount);
+ Dest := PWideChar(Result);
+ Src := StrScanW(P, Quote);
+ while Src <> nil do
+ begin
+ Inc(Src);
+ if Src^ <> Quote then
+ Break;
+ Move(P^, Dest^, 2 * (Src - P));
+ Inc(Dest, Src - P);
+ Inc(Src);
+ P := Src;
+ Src := StrScanW(Src, Quote);
+ end;
+ if Src = nil then
+ Src := StrEndW(P);
+ Move(P^, Dest^, 2 * (Src - P - 1));
+ end;
+end;
+
+function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
+var
+ LText : PWideChar;
+begin
+ LText := PWideChar(S);
+ Result := WideExtractQuotedStr(LText, AQuote);
+ if Result = '' then
+ Result := S;
+end;
+
+function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
+ MaxCol: Integer): WideString;
+
+ function WideCharIn(C: WideChar; SysCharSet: TSysCharSet): Boolean;
+ begin
+ Result := (C <= High(AnsiChar)) and (AnsiChar(C) in SysCharSet);
+ end;
+
+const
+ QuoteChars = ['''', '"'];
+var
+ Col, Pos: Integer;
+ LinePos, LineLen: Integer;
+ BreakLen, BreakPos: Integer;
+ QuoteChar, CurChar: WideChar;
+ ExistingBreak: Boolean;
+begin
+ Col := 1;
+ Pos := 1;
+ LinePos := 1;
+ BreakPos := 0;
+ QuoteChar := ' ';
+ ExistingBreak := False;
+ LineLen := Length(Line);
+ BreakLen := Length(BreakStr);
+ Result := '';
+ while Pos <= LineLen do
+ begin
+ CurChar := Line[Pos];
+ if CurChar = BreakStr[1] then
+ begin
+ if QuoteChar = ' ' then
+ begin
+ ExistingBreak := WideSameText(BreakStr, Copy(Line, Pos, BreakLen));
+ if ExistingBreak then
+ begin
+ Inc(Pos, BreakLen-1);
+ BreakPos := Pos;
+ end;
+ end
+ end
+ else if WideCharIn(CurChar, BreakChars) then
+ begin
+ if QuoteChar = ' ' then BreakPos := Pos
+ end
+ else if WideCharIn(CurChar, QuoteChars) then
+ begin
+ if CurChar = QuoteChar then
+ QuoteChar := ' '
+ else if QuoteChar = ' ' then
+ QuoteChar := CurChar;
+ end;
+ Inc(Pos);
+ Inc(Col);
+ if not (WideCharIn(QuoteChar, QuoteChars)) and (ExistingBreak or
+ ((Col > MaxCol) and (BreakPos > LinePos))) then
+ begin
+ Col := Pos - BreakPos;
+ Result := Result + Copy(Line, LinePos, BreakPos - LinePos + 1);
+ if not (WideCharIn(CurChar, QuoteChars)) then
+ while Pos <= LineLen do
+ begin
+ if WideCharIn(Line[Pos], BreakChars) then
+ Inc(Pos)
+ else if Copy(Line, Pos, Length(sLineBreak)) = sLineBreak then
+ Inc(Pos, Length(sLineBreak))
+ else
+ break;
+ end;
+ if not ExistingBreak and (Pos < LineLen) then
+ Result := Result + BreakStr;
+ Inc(BreakPos);
+ LinePos := BreakPos;
+ ExistingBreak := False;
+ end;
+ end;
+ Result := Result + Copy(Line, LinePos, MaxInt);
+end;
+
+function WideWrapText(const Line: WideString; MaxCol: Integer): WideString;
+begin
+ Result := WideWrapText(Line, sLineBreak, [' ', '-', #9], MaxCol); { do not localize }
+end;
+
+function WideIncludeTrailingBackslash(const S: WideString): WideString;
+begin
+ Result := S;
+ if not WideIsPathDelimiter(Result, Length(Result)) then Result := Result + PathDelim;
+end;
+
+function WideExcludeTrailingBackslash(const S: WideString): WideString;
+begin
+ Result := S;
+ if WideIsPathDelimiter(Result, Length(Result)) then
+ SetLength(Result, Length(Result)-1);
+end;
+
+function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
+begin
+ Result := False;
+ if (Index <= 0) or (Index > Length(S)) then exit;
+ Result := StrScanW(PWideChar(Delimiters), S[Index]) <> nil;
+end;
+
+function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
+begin
+ Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = PathDelim);
+end;
+
+function WideLastDelimiter(const Delimiters, S: WideString): Integer;
+var
+ P: PWideChar;
+begin
+ Result := Length(S);
+ P := PWideChar(Delimiters);
+ while Result > 0 do
+ begin
+ if (S[Result] <> #0) and (StrScanW(P, S[Result]) <> nil) then
+ Exit;
+ Dec(Result);
+ end;
+end;
+
+function WideChangeFileExt(const FileName, Extension: WideString): WideString;
+var
+ I: Integer;
+begin
+ I := WideLastDelimiter('.\:',Filename);
+ if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
+ Result := Copy(FileName, 1, I - 1) + Extension;
+end;
+
+function WideExtractFilePath(const FileName: WideString): WideString;
+var
+ I: Integer;
+begin
+ I := WideLastDelimiter('\:', FileName);
+ Result := Copy(FileName, 1, I);
+end;
+
+function WideExtractFileDir(const FileName: WideString): WideString;
+var
+ I: Integer;
+begin
+ I := WideLastDelimiter(DriveDelim + PathDelim,Filename);
+ if (I > 1) and (FileName[I] = PathDelim) and
+ (not (FileName[I - 1] in [WideChar(PathDelim), WideChar(DriveDelim)])) then Dec(I);
+ Result := Copy(FileName, 1, I);
+end;
+
+function WideExtractFileDrive(const FileName: WideString): WideString;
+var
+ I, J: Integer;
+begin
+ if (Length(FileName) >= 2) and (FileName[2] = DriveDelim) then
+ Result := Copy(FileName, 1, 2)
+ else if (Length(FileName) >= 2) and (FileName[1] = PathDelim) and
+ (FileName[2] = PathDelim) then
+ begin
+ J := 0;
+ I := 3;
+ While (I < Length(FileName)) and (J < 2) do
+ begin
+ if FileName[I] = PathDelim then Inc(J);
+ if J < 2 then Inc(I);
+ end;
+ if FileName[I] = PathDelim then Dec(I);
+ Result := Copy(FileName, 1, I);
+ end else Result := '';
+end;
+
+function WideExtractFileName(const FileName: WideString): WideString;
+var
+ I: Integer;
+begin
+ I := WideLastDelimiter('\:', FileName);
+ Result := Copy(FileName, I + 1, MaxInt);
+end;
+
+function WideExtractFileExt(const FileName: WideString): WideString;
+var
+ I: Integer;
+begin
+ I := WideLastDelimiter('.\:', FileName);
+ if (I > 0) and (FileName[I] = '.') then
+ Result := Copy(FileName, I, MaxInt) else
+ Result := '';
+end;
+
+function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
+var
+ BasePath, DestPath: WideString;
+ BaseLead, DestLead: PWideChar;
+ BasePtr, DestPtr: PWideChar;
+
+ function WideExtractFilePathNoDrive(const FileName: WideString): WideString;
+ begin
+ Result := WideExtractFilePath(FileName);
+ Delete(Result, 1, Length(WideExtractFileDrive(FileName)));
+ end;
+
+ function Next(var Lead: PWideChar): PWideChar;
+ begin
+ Result := Lead;
+ if Result = nil then Exit;
+ Lead := StrScanW(Lead, PathDelim);
+ if Lead <> nil then
+ begin
+ Lead^ := #0;
+ Inc(Lead);
+ end;
+ end;
+
+begin
+ if WideSameText(WideExtractFileDrive(BaseName), WideExtractFileDrive(DestName)) then
+ begin
+ BasePath := WideExtractFilePathNoDrive(BaseName);
+ DestPath := WideExtractFilePathNoDrive(DestName);
+ BaseLead := Pointer(BasePath);
+ BasePtr := Next(BaseLead);
+ DestLead := Pointer(DestPath);
+ DestPtr := Next(DestLead);
+ while (BasePtr <> nil) and (DestPtr <> nil) and WideSameText(BasePtr, DestPtr) do
+ begin
+ BasePtr := Next(BaseLead);
+ DestPtr := Next(DestLead);
+ end;
+ Result := '';
+ while BaseLead <> nil do
+ begin
+ Result := Result + '..' + PathDelim; { Do not localize }
+ Next(BaseLead);
+ end;
+ if (DestPtr <> nil) and (DestPtr^ <> #0) then
+ Result := Result + DestPtr + PathDelim;
+ if DestLead <> nil then
+ Result := Result + DestLead; // destlead already has a trailing backslash
+ Result := Result + WideExtractFileName(DestName);
+ end
+ else
+ Result := DestName;
+end;
+
+function WideExpandFileName(const FileName: WideString): WideString;
+var
+ FName: PWideChar;
+ Buffer: array[0..MAX_PATH - 1] of WideChar;
+begin
+ SetString(Result, Buffer, Tnt_GetFullPathNameW(PWideChar(FileName), MAX_PATH, Buffer, FName));
+end;
+
+function WideExtractShortPathName(const FileName: WideString): WideString;
+var
+ Buffer: array[0..MAX_PATH - 1] of WideChar;
+begin
+ SetString(Result, Buffer, Tnt_GetShortPathNameW(PWideChar(FileName), Buffer, MAX_PATH));
+end;
+
+function WideFileCreate(const FileName: WideString): Integer;
+begin
+ Result := Integer(Tnt_CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
+ 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0))
+end;
+
+function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
+const
+ AccessMode: array[0..2] of LongWord = (
+ GENERIC_READ,
+ GENERIC_WRITE,
+ GENERIC_READ or GENERIC_WRITE);
+ ShareMode: array[0..4] of LongWord = (
+ 0,
+ 0,
+ FILE_SHARE_READ,
+ FILE_SHARE_WRITE,
+ FILE_SHARE_READ or FILE_SHARE_WRITE);
+begin
+ Result := Integer(Tnt_CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
+ ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL, 0));
+end;
+
+function WideFileAge(const FileName: WideString): Integer;
+var
+ Handle: THandle;
+ FindData: TWin32FindDataW;
+ LocalFileTime: TFileTime;
+begin
+ Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
+ if Handle <> INVALID_HANDLE_VALUE then
+ begin
+ Windows.FindClose(Handle);
+ if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
+ begin
+ FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
+ if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
+ LongRec(Result).Lo) then Exit;
+ end;
+ end;
+ Result := -1;
+end;
+
+function WideDirectoryExists(const Name: WideString): Boolean;
+var
+ Code: Cardinal;
+begin
+ Code := WideFileGetAttr(Name);
+ Result := (Code <> INVALID_FILE_ATTRIBUTES) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
+end;
+
+function WideFileExists(const Name: WideString): Boolean;
+var
+ Code: Cardinal;
+begin
+ Code := WideFileGetAttr(Name);
+ Result := (Code <> INVALID_FILE_ATTRIBUTES) and ((FILE_ATTRIBUTE_DIRECTORY and Code) = 0);
+end;
+
+function WideFileGetAttr(const FileName: WideString): Cardinal;
+begin
+ Result := Tnt_GetFileAttributesW(PWideChar(FileName));
+end;
+
+function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
+begin
+ Result := Tnt_SetFileAttributesW(PWideChar(FileName), Attr)
+end;
+
+function WideForceDirectories(Dir: WideString): Boolean;
+begin
+ Result := True;
+ if Length(Dir) = 0 then
+ raise ETntGeneralError.Create(SCannotCreateDir);
+ Dir := WideExcludeTrailingBackslash(Dir);
+ if (Length(Dir) < 3) or WideDirectoryExists(Dir)
+ or (WideExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
+ Result := WideForceDirectories(WideExtractFilePath(Dir));
+ if Result then
+ Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil)
+end;
+
+function WideFileSearch(const Name, DirList: WideString): WideString;
+var
+ I, P, L: Integer;
+ C: WideChar;
+begin
+ Result := Name;
+ P := 1;
+ L := Length(DirList);
+ while True do
+ begin
+ if WideFileExists(Result) then Exit;
+ while (P <= L) and (DirList[P] = PathSep) do Inc(P);
+ if P > L then Break;
+ I := P;
+ while (P <= L) and (DirList[P] <> PathSep) do
+ Inc(P);
+ Result := Copy(DirList, I, P - I);
+ C := WideLastChar(Result);
+ if (C <> DriveDelim) and (C <> PathDelim) then
+ Result := Result + PathDelim;
+ Result := Result + Name;
+ end;
+ Result := '';
+end;
+
+function WideRenameFile(const OldName, NewName: WideString): Boolean;
+begin
+ Result := Tnt_MoveFileW(PWideChar(OldName), PWideChar(NewName))
+end;
+
+function WideDeleteFile(const FileName: WideString): Boolean;
+begin
+ Result := Tnt_DeleteFileW(PWideChar(FileName))
+end;
+
+function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
+begin
+ Result := Tnt_CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists)
+end;
+
+function _WideFindMatchingFile(var F: TSearchRecW): Integer;
+var
+ LocalFileTime: TFileTime;
+begin
+ with F do
+ begin
+ while FindData.dwFileAttributes and ExcludeAttr <> 0 do
+ if not Tnt_FindNextFileW(FindHandle, FindData) then
+ begin
+ Result := GetLastError;
+ Exit;
+ end;
+ FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
+ FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
+ Size := (Int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
+ Attr := FindData.dwFileAttributes;
+ Name := FindData.cFileName;
+ end;
+ Result := 0;
+end;
+
+function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
+const
+ faSpecial = faHidden or faSysFile {$IFNDEF COMPILER_9_UP} or faVolumeID {$ENDIF} or faDirectory;
+begin
+ F.ExcludeAttr := not Attr and faSpecial;
+ F.FindHandle := Tnt_FindFirstFileW(PWideChar(Path), F.FindData);
+ if F.FindHandle <> INVALID_HANDLE_VALUE then
+ begin
+ Result := _WideFindMatchingFile(F);
+ if Result <> 0 then WideFindClose(F);
+ end else
+ Result := GetLastError;
+end;
+
+function WideFindNext(var F: TSearchRecW): Integer;
+begin
+ if Tnt_FindNextFileW(F.FindHandle, F.FindData) then
+ Result := _WideFindMatchingFile(F) else
+ Result := GetLastError;
+end;
+
+procedure WideFindClose(var F: TSearchRecW);
+begin
+ if F.FindHandle <> INVALID_HANDLE_VALUE then
+ begin
+ Windows.FindClose(F.FindHandle);
+ F.FindHandle := INVALID_HANDLE_VALUE;
+ end;
+end;
+
+function WideRemoveDir(const Dir: WideString): Boolean;
+begin
+ Result := Tnt_RemoveDirectoryW(PWideChar(Dir));
+end;
+
+function WideSetCurrentDir(const Dir: WideString): Boolean;
+begin
+ Result := Tnt_SetCurrentDirectoryW(PWideChar(Dir));
+end;
+
+function _ValidDateTimeStrEx(Str: WideString; Flags: Integer): Boolean;
+var
+ TheDateTime: Double;
+begin
+ Result := Succeeded(VarDateFromStr(Str, GetThreadLocale, Flags, TheDateTime));
+end;
+
+function ValidDateTimeStr(Str: WideString): Boolean;
+begin
+ Result := _ValidDateTimeStrEx(Str, 0);
+end;
+
+function ValidDateStr(Str: WideString): Boolean;
+begin
+ Result := _ValidDateTimeStrEx(Str, VAR_DATEVALUEONLY);
+end;
+
+function ValidTimeStr(Str: WideString): Boolean;
+begin
+ Result := _ValidDateTimeStrEx(Str, VAR_TIMEVALUEONLY);
+end;
+
+function IntStrToDateTime(Str: WideString; Flags: Integer; ErrorFormatStr: WideString): TDateTime;
+var
+ TheDateTime: Double;
+begin
+ try
+ OleCheck(VarDateFromStr(Str, GetThreadLocale, Flags, TheDateTime));
+ Result := TheDateTime;
+ except
+ on E: Exception do begin
+ E.Message := E.Message + CRLF + WideFormat(ErrorFormatStr, [Str]);
+ raise EConvertError.Create(E.Message);
+ end;
+ end;
+end;
+
+function TntStrToDateTime(Str: WideString): TDateTime;
+begin
+ Result := IntStrToDateTime(Str, 0, SInvalidDateTime);
+end;
+
+function TntStrToDate(Str: WideString): TDateTime;
+begin
+ Result := IntStrToDateTime(Str, VAR_DATEVALUEONLY, SInvalidDate);
+end;
+
+function TntStrToTime(Str: WideString): TDateTime;
+begin
+ Result := IntStrToDateTime(Str, VAR_TIMEVALUEONLY, SInvalidTime);
+end;
+
+function TryStrToDateTime(Str: WideString; Flags: Integer; out DateTime: TDateTime): Boolean;
+var
+ ADouble: Double;
+begin
+ Result := Succeeded(VarDateFromStr(Str, GetThreadLocale, Flags, ADouble));
+ if Result then
+ DateTime := ADouble;
+end;
+
+function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
+begin
+ if not TryStrToDateTime(Str, 0, Result) then
+ Result := Default;
+end;
+
+function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
+begin
+ if not TryStrToDateTime(Str, VAR_DATEVALUEONLY, Result) then
+ Result := Default;
+end;
+
+function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
+begin
+ if not TryStrToDateTime(Str, VAR_TIMEVALUEONLY, Result) then
+ Result := Default;
+end;
+
+function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
+const
+ MAX_BUFF_SIZE = 64; // can a currency string actually be larger?
+var
+ ValueStr: WideString;
+begin
+ // format lpValue using ENG-US settings
+ ValueStr := ENG_US_FloatToStr(Value);
+ // get currency format
+ SetLength(Result, MAX_BUFF_SIZE);
+ if 0 = Tnt_GetCurrencyFormatW(GetThreadLocale, 0, PWideChar(ValueStr),
+ lpFormat, PWideChar(Result), Length(Result))
+ then begin
+ RaiseLastOSError;
+ end;
+ Result := PWideChar(Result);
+end;
+
+function TntStrToCurr(const S: WideString): Currency;
+begin
+ try
+ OleCheck(VarCyFromStr(S, GetThreadLocale, 0, Result));
+ except
+ on E: Exception do begin
+ E.Message := E.Message + CRLF + WideFormat(SInvalidCurrency, [S]);
+ raise EConvertError.Create(E.Message);
+ end;
+ end;
+end;
+
+function ValidCurrencyStr(const S: WideString): Boolean;
+var
+ Dummy: Currency;
+begin
+ Result := Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Dummy));
+end;
+
+function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
+begin
+ if not Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Result)) then
+ Result := Default;
+end;
+
+threadvar
+ Currency_DecimalSep: WideString;
+ Currency_ThousandSep: WideString;
+ Currency_CurrencySymbol: WideString;
+
+function GetDefaultCurrencyFmt: TCurrencyFmtW;
+begin
+ ZeroMemory(@Result, SizeOf(Result));
+ Result.NumDigits := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRDIGITS, '2'), 2);
+ Result.LeadingZero := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ILZERO, '1'), 1);
+ Result.Grouping := StrToIntDef(Copy(WideGetLocaleStr(GetThreadLocale, LOCALE_SMONGROUPING, '3;0'), 1, 1), 3);
+ Currency_DecimalSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONDECIMALSEP, '.');
+ Result.lpDecimalSep := PWideChar(Currency_DecimalSep);
+ Currency_ThousandSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONTHOUSANDSEP, ',');
+ Result.lpThousandSep := PWideChar(Currency_ThousandSep);
+ Result.NegativeOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_INEGCURR, '0'), 0);
+ Result.PositiveOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRENCY, '0'), 0);
+ Currency_CurrencySymbol := WideGetLocaleStr(GetThreadLocale, LOCALE_SCURRENCY, '');
+ Result.lpCurrencySymbol := PWideChar(Currency_CurrencySymbol);
+end;
+
+function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
+var
+ L: Integer;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := GetLocaleStr{TNT-ALLOW GetLocaleStr}(LocaleID, LocaleType, Default)
+ else begin
+ SetLength(Result, 255);
+ L := GetLocaleInfoW(LocaleID, LocaleType, PWideChar(Result), Length(Result));
+ if L > 0 then
+ SetLength(Result, L - 1)
+ else
+ Result := Default;
+ end;
+end;
+
+{$IFNDEF COMPILER_7_UP}
+function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
+begin
+ Result := (Win32MajorVersion > AMajor) or
+ ((Win32MajorVersion = AMajor) and
+ (Win32MinorVersion >= AMinor));
+end;
+{$ENDIF}
+
+function WinCheckH(RetVal: Cardinal): Cardinal;
+begin
+ if RetVal = 0 then RaiseLastOSError;
+ Result := RetVal;
+end;
+
+function WinCheckFileH(RetVal: Cardinal): Cardinal;
+begin
+ if RetVal = INVALID_HANDLE_VALUE then RaiseLastOSError;
+ Result := RetVal;
+end;
+
+function WinCheckP(RetVal: Pointer): Pointer;
+begin
+ if RetVal = nil then RaiseLastOSError;
+ Result := RetVal;
+end;
+
+function WideGetModuleFileName(Instance: HModule): WideString;
+begin
+ SetLength(Result, MAX_PATH);
+ WinCheckH(Tnt_GetModuleFileNameW(Instance, PWideChar(Result), Length(Result)));
+ Result := PWideChar(Result)
+end;
+
+function WideSafeLoadLibrary(const Filename: Widestring; ErrorMode: UINT): HMODULE;
+var
+ OldMode: UINT;
+ FPUControlWord: Word;
+begin
+ OldMode := SetErrorMode(ErrorMode);
+ try
+ asm
+ FNSTCW FPUControlWord
+ end;
+ try
+ Result := Tnt_LoadLibraryW(PWideChar(Filename));
+ finally
+ asm
+ FNCLEX
+ FLDCW FPUControlWord
+ end;
+ end;
+ finally
+ SetErrorMode(OldMode);
+ end;
+end;
+
+function WideLoadPackage(const Name: Widestring): HMODULE;
+begin
+ Result := WideSafeLoadLibrary(Name);
+ if Result = 0 then
+ begin
+ raise EPackageError.CreateFmt(sErrorLoadingPackage, [Name, SysErrorMessage(GetLastError)]);
+ end;
+ try
+ InitializePackage(Result);
+ except
+ FreeLibrary(Result);
+ raise;
+ end;
+end;
+
+function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
+begin
+ Win32Check(Tnt_GetStringTypeExW(GetThreadLocale, dwInfoType, PWideChar(@WC), 1, Result))
+end;
+
+function IsWideCharUpper(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_UPPER) <> 0;
+end;
+
+function IsWideCharLower(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_LOWER) <> 0;
+end;
+
+function IsWideCharDigit(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_DIGIT) <> 0;
+end;
+
+function IsWideCharSpace(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_SPACE) <> 0;
+end;
+
+function IsWideCharPunct(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_PUNCT) <> 0;
+end;
+
+function IsWideCharCntrl(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_CNTRL) <> 0;
+end;
+
+function IsWideCharBlank(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_BLANK) <> 0;
+end;
+
+function IsWideCharXDigit(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_XDIGIT) <> 0;
+end;
+
+function IsWideCharAlpha(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_ALPHA) <> 0;
+end;
+
+function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and (C1_ALPHA + C1_DIGIT)) <> 0;
+end;
+
+function WideTextPos(const SubStr, S: WideString): Integer;
+begin
+ Result := Pos(Tnt_WideUpperCase(SubStr), Tnt_WideUpperCase(S));
+end;
+
+function FindDoubleTerminator(P: PWideChar): PWideChar;
+begin
+ Result := P;
+ while True do begin
+ Result := StrScanW(Result, #0);
+ Inc(Result);
+ if Result^ = #0 then begin
+ Dec(Result);
+ break;
+ end;
+ end;
+end;
+
+function ExtractStringArrayStr(P: PWideChar): WideString;
+var
+ PEnd: PWideChar;
+begin
+ PEnd := FindDoubleTerminator(P);
+ Inc(PEnd, 2); // move past #0#0
+ SetString(Result, P, PEnd - P);
+end;
+
+function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
+var
+ Start: PWideChar;
+begin
+ Start := P;
+ P := StrScanW(Start, Separator);
+ if P = nil then begin
+ Result := Start;
+ P := StrEndW(Start);
+ end else begin
+ SetString(Result, Start, P - Start);
+ Inc(P);
+ end;
+end;
+
+function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;
+const
+ GROW_COUNT = 256;
+var
+ Count: Integer;
+ Item: WideString;
+begin
+ Count := 0;
+ SetLength(Result, GROW_COUNT);
+ Item := ExtractStringFromStringArray(P, Separator);
+ While Item <> '' do begin
+ if Count > High(Result) then
+ SetLength(Result, Length(Result) + GROW_COUNT);
+ Result[Count] := Item;
+ Inc(Count);
+ Item := ExtractStringFromStringArray(P, Separator);
+ end;
+ SetLength(Result, Count);
+end;
+
+function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
+var
+ UsedDefaultChar: BOOL;
+begin
+ WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(@WC), 1, nil, 0, nil, @UsedDefaultChar);
+ Result := not UsedDefaultChar;
+end;
+
+function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
+var
+ UsedDefaultChar: BOOL;
+begin
+ WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(WS), Length(WS), nil, 0, nil, @UsedDefaultChar);
+ Result := not UsedDefaultChar;
+end;
+
+function IsRTF(const Value: WideString): Boolean;
+const
+ RTF_BEGIN_1 = WideString('{\RTF');
+ RTF_BEGIN_2 = WideString('{URTF');
+begin
+ Result := (WideTextPos(RTF_BEGIN_1, Value) = 1)
+ or (WideTextPos(RTF_BEGIN_2, Value) = 1);
+end;
+
+{$IFDEF COMPILER_7_UP}
+var
+ Cached_ENG_US_FormatSettings: TFormatSettings;
+ Cached_ENG_US_FormatSettings_Time: Cardinal;
+
+function ENG_US_FormatSettings: TFormatSettings;
+begin
+ if Cached_ENG_US_FormatSettings_Time = _SettingChangeTime then
+ Result := Cached_ENG_US_FormatSettings
+ else begin
+ GetLocaleFormatSettings(MAKELCID(MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US)), Result);
+ Result.DecimalSeparator := '.'; // ignore overrides
+ Cached_ENG_US_FormatSettings := Result;
+ Cached_ENG_US_FormatSettings_Time := _SettingChangeTime;
+ end;
+ end;
+
+function ENG_US_FloatToStr(Value: Extended): WideString;
+begin
+ Result := FloatToStr(Value, ENG_US_FormatSettings);
+end;
+
+function ENG_US_StrToFloat(const S: WideString): Extended;
+begin
+ if not TextToFloat(PAnsiChar(AnsiString(S)), Result, fvExtended, ENG_US_FormatSettings) then
+ Result := StrToFloat(S); // try using native format
+end;
+
+{$ELSE}
+
+function ENG_US_FloatToStr(Value: Extended): WideString;
+var
+ SaveDecimalSep: AnsiChar;
+begin
+ SaveDecimalSep := SysUtils.DecimalSeparator;
+ try
+ SysUtils.DecimalSeparator := '.';
+ Result := FloatToStr(Value);
+ finally
+ SysUtils.DecimalSeparator := SaveDecimalSep;
+ end;
+end;
+
+function ENG_US_StrToFloat(const S: WideString): Extended;
+var
+ SaveDecimalSep: AnsiChar;
+begin
+ try
+ SaveDecimalSep := SysUtils.DecimalSeparator;
+ try
+ SysUtils.DecimalSeparator := '.';
+ Result := StrToFloat(S);
+ finally
+ SysUtils.DecimalSeparator := SaveDecimalSep;
+ end;
+ except
+ if SysUtils.DecimalSeparator <> '.' then
+ Result := StrToFloat(S) // try using native format
+ else
+ raise;
+ end;
+end;
+{$ENDIF}
+
+//---------------------------------------------------------------------------------------------
+// Tnt - Variants
+//---------------------------------------------------------------------------------------------
+
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+function VarToWideStr(const V: Variant): WideString;
+begin
+ Result := VarToWideStrDef(V, '');
+end;
+
+function VarToWideStrDef(const V: Variant; const ADefault: WideString): WideString;
+begin
+ if not VarIsNull(V) then
+ Result := V
+ else
+ Result := ADefault;
+end;
+{$ENDIF}
+
+initialization
+ Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
+ Win32PlatformIsXP := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1))
+ or (Win32MajorVersion > 5);
+
+finalization
+ Currency_DecimalSep := ''; {make memory sleuth happy}
+ Currency_ThousandSep := ''; {make memory sleuth happy}
+ Currency_CurrencySymbol := ''; {make memory sleuth happy}
+
+end.
Added: trunk/TntUnicodeControls/TntSystem.pas
===================================================================
--- trunk/TntUnicodeControls/TntSystem.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntSystem.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,1470 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntSystem;
+
+{$INCLUDE TntCompilers.inc}
+
+{*****************************************************************************}
+{ Special thanks go to Francisco Leong for originating the design for }
+{ WideString-enabled resourcestrings. }
+{*****************************************************************************}
+
+interface
+
+uses Windows;
+
+// These functions should not be used by Delphi code since conversions are implicit.
+{TNT-WARN WideCharToString}
+{TNT-WARN WideCharLenToString}
+{TNT-WARN WideCharToStrVar}
+{TNT-WARN WideCharLenToStrVar}
+{TNT-WARN StringToWideChar}
+
+// ......... compatibility .........
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+type PCardinal = ^Cardinal;
+type UTF8String = type AnsiString;
+function UTF8Encode(const WS: WideString): UTF8String;
+function UTF8Decode(const S: UTF8String): WideString;
+{$ENDIF}
+
+// ................ ANSI TYPES ................
+{TNT-WARN Char}
+{TNT-WARN PChar}
+{TNT-WARN String}
+
+{TNT-WARN CP_ACP} // <-- use DefaultSystemCodePage
+var
+ DefaultSystemCodePage: Cardinal; // implicitly used when converting AnsiString <--> WideString.
+
+var
+ WideCustomLoadResString: function(ResStringRec: PResStringRec; var Value: WideString): Boolean;
+
+{TNT-WARN LoadResString}
+function WideLoadResString(ResStringRec: PResStringRec): WideString;
+{TNT-WARN ParamCount}
+function WideParamCount: Integer;
+{TNT-WARN ParamStr}
+function WideParamStr(Index: Integer): WideString;
+
+// ......... introduced .........
+
+const
+ { Each Unicode stream should begin with the code U+FEFF, }
+ { which the standard defines as the *byte order mark*. }
+ UNICODE_BOM = WideChar($FEFF);
+ UNICODE_BOM_SWAPPED = WideChar($FFFE);
+ UTF8_BOM = AnsiString(#$EF#$BB#$BF);
+
+function WideStringToUTF8(const S: WideString): AnsiString;
+function UTF8ToWideString(const S: AnsiString): WideString;
+
+function WideStringToUTF7(const W: WideString): AnsiString;
+function UTF7ToWideString(const S: AnsiString): WideString;
+
+function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
+function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
+
+function UCS2ToWideString(const Value: AnsiString): WideString;
+function WideStringToUCS2(const Value: WideString): AnsiString;
+
+function CharSetToCodePage(ciCharset: UINT): Cardinal;
+function LCIDToCodePage(ALcid: LCID): Cardinal;
+function KeyboardCodePage: Cardinal;
+function KeyUnicode(CharCode: Word): WideChar;
+
+procedure StrSwapByteOrder(Str: PWideChar);
+
+type
+ TTntSystemUpdate =
+ (tsWideResourceStrings
+ {$IFNDEF COMPILER_9_UP}, tsFixImplicitCodePage, tsFixWideStrConcat
+ {$IFDEF COMPILER_6_UP}, tsFixWideFormat {$ENDIF}
+ {$ENDIF});
+ TTntSystemUpdateSet = set of TTntSystemUpdate;
+
+const
+ AllTntSystemUpdates = [Low(TTntSystemUpdate)..High(TTntSystemUpdate)];
+
+procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
+
+implementation
+
+uses
+ SysUtils, {$IFDEF COMPILER_6_UP} Variants, {$ENDIF} TntWindows, TntSysUtils;
+
+var
+ IsDebugging: Boolean;
+
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+function Utf8Encode(const WS: WideString): UTF8String;
+
+ function UnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal;
+ Source: PWideChar; SourceChars: Cardinal): Cardinal;
+ var
+ i, count: Cardinal;
+ c: Cardinal;
+ begin
+ Result := 0;
+ if Source = nil then Exit;
+ count := 0;
+ i := 0;
+ if Dest <> nil then
+ begin
+ while (i < SourceChars) and (count < MaxDestBytes) do
+ begin
+ c := Cardinal(Source[i]);
+ Inc(i);
+ if c <= $7F then
+ begin
+ Dest[count] := AnsiChar(c);
+ Inc(count);
+ end
+ else if c > $7FF then
+ begin
+ if count + 3 > MaxDestBytes then
+ break;
+ Dest[count] := AnsiChar($E0 or (c shr 12));
+ Dest[count+1] := AnsiChar($80 or ((c shr 6) and $3F));
+ Dest[count+2] := AnsiChar($80 or (c and $3F));
+ Inc(count,3);
+ end
+ else // $7F < Source[i] <= $7FF
+ begin
+ if count + 2 > MaxDestBytes then
+ break;
+ Dest[count] := AnsiChar($C0 or (c shr 6));
+ Dest[count+1] := AnsiChar($80 or (c and $3F));
+ Inc(count,2);
+ end;
+ end;
+ if count >= MaxDestBytes then count := MaxDestBytes-1;
+ Dest[count] := #0;
+ end
+ else
+ begin
+ while i < SourceChars do
+ begin
+ c := Integer(Source[i]);
+ Inc(i);
+ if c > $7F then
+ begin
+ if c > $7FF then
+ Inc(count);
+ Inc(count);
+ end;
+ Inc(count);
+ end;
+ end;
+ Result := count+1; // convert zero based index to byte count
+ end;
+
+var
+ L: Integer;
+ Temp: UTF8String;
+begin
+ Result := '';
+ if WS = '' then Exit;
+ SetLength(Temp, Length(WS) * 3); // SetLength includes space for null terminator
+
+ L := UnicodeToUtf8(PAnsiChar(Temp), Length(Temp)+1, PWideChar(WS), Length(WS));
+ if L > 0 then
+ SetLength(Temp, L-1)
+ else
+ Temp := '';
+ Result := Temp;
+end;
+
+function Utf8Decode(const S: UTF8String): WideString;
+
+ function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal;
+ Source: PAnsiChar; SourceBytes: Cardinal): Integer;
+ var
+ i, count: Cardinal;
+ c: Byte;
+ wc: Cardinal;
+ begin
+ if Source = nil then
+ begin
+ Result := 0;
+ Exit;
+ end;
+ Result := -1;
+ count := 0;
+ i := 0;
+ if Dest <> nil then
+ begin
+ while (i < SourceBytes) and (count < MaxDestChars) do
+ begin
+ wc := Cardinal(Source[i]);
+ Inc(i);
+ if (wc and $80) <> 0 then
+ begin
+ if i >= SourceBytes then Exit; // incomplete multibyte char
+ wc := wc and $3F;
+ if (wc and $20) <> 0 then
+ begin
+ c := Byte(Source[i]);
+ Inc(i);
+ if (c and $C0) <> $80 then Exit; // malformed trail byte or out of range char
+ if i >= SourceBytes then Exit; // incomplete multibyte char
+ wc := (wc shl 6) or (c and $3F);
+ end;
+ c := Byte(Source[i]);
+ Inc(i);
+ if (c and $C0) <> $80 then Exit; // malformed trail byte
+
+ Dest[count] := WideChar((wc shl 6) or (c and $3F));
+ end
+ else
+ Dest[count] := WideChar(wc);
+ Inc(count);
+ end;
+ if count >= MaxDestChars then count := MaxDestChars-1;
+ Dest[count] := #0;
+ end
+ else
+ begin
+ while (i < SourceBytes) do
+ begin
+ c := Byte(Source[i]);
+ Inc(i);
+ if (c and $80) <> 0 then
+ begin
+ if i >= SourceBytes then Exit; // incomplete multibyte char
+ c := c and $3F;
+ if (c and $20) <> 0 then
+ begin
+ c := Byte(Source[i]);
+ Inc(i);
+ if (c and $C0) <> $80 then Exit; // malformed trail byte or out of range char
+ if i >= SourceBytes then Exit; // incomplete multibyte char
+ end;
+ c := Byte(Source[i]);
+ Inc(i);
+ if (c and $C0) <> $80 then Exit; // malformed trail byte
+ end;
+ Inc(count);
+ end;
+ end;
+ Result := count + 1;
+ end;
+
+var
+ L: Integer;
+ Temp: WideString;
+begin
+ Result := '';
+ if S = '' then Exit;
+ SetLength(Temp, Length(S));
+
+ L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PAnsiChar(S), Length(S));
+ if L > 0 then
+ SetLength(Temp, L-1)
+ else
+ Temp := '';
+ Result := Temp;
+end;
+{$ENDIF}
+
+function WideLoadResString(ResStringRec: PResStringRec): WideString;
+const
+ MAX_RES_STRING_SIZE = 4097; { MSDN documents this as the maximum size of a string in table. }
+var
+ Buffer: array [0..MAX_RES_STRING_SIZE] of WideChar; { Buffer leaves room for null terminator. }
+ PCustom: PAnsiChar;
+begin
+ if Assigned(WideCustomLoadResString) and WideCustomLoadResString(ResStringRec, Result) then
+ exit; { a custom resourcestring has been loaded. }
+
+ if ResStringRec = nil then
+ Result := ''
+ else if ResStringRec.Identifier < 64*1024 then
+ SetString(Result, Buffer,
+ Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^),
+ ResStringRec.Identifier, Buffer, MAX_RES_STRING_SIZE))
+ else begin
+ // custom string pointer
+ PCustom := PAnsiChar(ResStringRec.Identifier); { I would like to use PWideChar, but this would break legacy code. }
+ if (StrLen{TNT-ALLOW StrLen}(PCustom) > Cardinal(Length(UTF8_BOM)))
+ and CompareMem(PCustom, PAnsiChar(UTF8_BOM), Length(UTF8_BOM)) then
+ // detected UTF8
+ Result := UTF8ToWideString(PAnsiChar(PCustom + Length(UTF8_BOM)))
+ else
+ // normal
+ Result := PCustom;
+ end;
+end;
+
+function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar;
+var
+ Len: Integer;
+ Buffer: array[0..4095] of WideChar;
+begin
+ while True do
+ begin
+ while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
+ if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
+ end;
+ Len := 0;
+ while (P[0] > ' ') and (Len < SizeOf(Buffer)) do
+ if P[0] = '"' then
+ begin
+ Inc(P);
+ while (P[0] <> #0) and (P[0] <> '"') do
+ begin
+ Buffer[Len] := P[0];
+ Inc(Len);
+ Inc(P);
+ end;
+ if P[0] <> #0 then Inc(P);
+ end else
+ begin
+ Buffer[Len] := P[0];
+ Inc(Len);
+ Inc(P);
+ end;
+ SetString(Param, Buffer, Len);
+ Result := P;
+end;
+
+function WideParamCount: Integer;
+var
+ P: PWideChar;
+ S: WideString;
+begin
+ P := WideGetParamStr(GetCommandLineW, S);
+ Result := 0;
+ while True do
+ begin
+ P := WideGetParamStr(P, S);
+ if S = '' then Break;
+ Inc(Result);
+ end;
+end;
+
+function WideParamStr(Index: Integer): WideString;
+var
+ P: PWideChar;
+begin
+ if Index = 0 then
+ Result := WideGetModuleFileName(0)
+ else
+ begin
+ P := GetCommandLineW;
+ while True do
+ begin
+ P := WideGetParamStr(P, Result);
+ if (Index = 0) or (Result = '') then Break;
+ Dec(Index);
+ end;
+ end;
+end;
+
+function WideStringToUTF8(const S: WideString): AnsiString;
+begin
+ Result := UTF8Encode(S);
+end;
+
+function UTF8ToWideString(const S: AnsiString): WideString;
+begin
+ Result := UTF8Decode(S);
+end;
+
+ { ======================================================================= }
+ { Original File: ConvertUTF7.c }
+ { Author: David B. Goldsmith }
+ { Copyright (C) 1994, 1996 Taligent, Inc. All rights reserved. }
+ { }
+ { This code is copyrighted. Under the copyright laws, this code may not }
+ { be copied, in whole or part, without prior written consent of Taligent. }
+ { }
+ { Taligent grants the right to use this code as long as this ENTIRE }
+ { copyright notice is reproduced in the code. The code is provided }
+ { AS-IS, AND TALIGENT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR }
+ { IMPLIED, INCLUDING, BUT NOT LIMITED TO IMPLIED WARRANTIES OF }
+ { MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT }
+ { WILL TALIGENT BE LIABLE FOR ANY DAMAGES WHATSOEVER (INCLUDING, }
+ { WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS }
+ { INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR OTHER PECUNIARY }
+ { LOSS) ARISING OUT OF THE USE OR INABILITY TO USE THIS CODE, EVEN }
+ { IF TALIGENT HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. }
+ { BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF }
+ { LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE ABOVE }
+ { LIMITATION MAY NOT APPLY TO YOU. }
+ { }
+ { RESTRICTED RIGHTS LEGEND: Use, duplication, or disclosure by the }
+ { government is subject to restrictions as set forth in subparagraph }
+ { (c)(l)(ii) of the Rights in Technical Data and Computer Software }
+ { clause at DFARS 252.227-7013 and FAR 52.227-19. }
+ { }
+ { This code may be protected by one or more U.S. and International }
+ { Patents. }
+ { }
+ { TRADEMARKS: Taligent and the Taligent Design Mark are registered }
+ { trademarks of Taligent, Inc. }
+ { ======================================================================= }
+
+type UCS2 = Word;
+
+const
+ _base64: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+ _direct: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789''(),-./:?';
+ _optional: AnsiString = '!"#$%&*;<=>@[]^_`{|}';
+ _spaces: AnsiString = #9#13#10#32;
+
+var
+ base64: PAnsiChar;
+ invbase64: array[0..127] of SmallInt;
+ direct: PAnsiChar;
+ optional: PAnsiChar;
+ spaces: PAnsiChar;
+ mustshiftsafe: array[0..127] of AnsiChar;
+ mustshiftopt: array[0..127] of AnsiChar;
+
+var
+ needtables: Boolean = True;
+
+procedure Initialize_UTF7_Data;
+begin
+ base64 := PAnsiChar(_base64);
+ direct := PAnsiChar(_direct);
+ optional := PAnsiChar(_optional);
+ spaces := PAnsiChar(_spaces);
+end;
+
+procedure tabinit;
+var
+ i: Integer;
+ limit: Integer;
+begin
+ i := 0;
+ while (i < 128) do
+ begin
+ mustshiftopt[i] := #1;
+ mustshiftsafe[i] := #1;
+ invbase64[i] := -1;
+ Inc(i);
+ end { For };
+ limit := Length(_Direct);
+ i := 0;
+ while (i < limit) do
+ begin
+ mustshiftopt[Integer(direct[i])] := #0;
+ mustshiftsafe[Integer(direct[i])] := #0;
+ Inc(i);
+ end { For };
+ limit := Length(_Spaces);
+ i := 0;
+ while (i < limit) do
+ begin
+ mustshiftopt[Integer(spaces[i])] := #0;
+ mustshiftsafe[Integer(spaces[i])] := #0;
+ Inc(i);
+ end { For };
+ limit := Length(_Optional);
+ i := 0;
+ while (i < limit) do
+ begin
+ mustshiftopt[Integer(optional[i])] := #0;
+ Inc(i);
+ end { For };
+ limit := Length(_Base64);
+ i := 0;
+ while (i < limit) do
+ begin
+ invbase64[Integer(base64[i])] := i;
+ Inc(i);
+ end { For };
+ needtables := False;
+end; { tabinit }
+
+function WRITE_N_BITS(x: UCS2; n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): Integer;
+begin
+ BITbuffer := BITbuffer or (x and (not (-1 shl n))) shl (32 - n - bufferbits);
+ bufferbits := bufferbits + n;
+ Result := bufferbits;
+end; { WRITE_N_BITS }
+
+function READ_N_BITS(n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): UCS2;
+var
+ buffertemp: Cardinal;
+begin
+ buffertemp := BITbuffer shr (32 - n);
+ BITbuffer := BITbuffer shl n;
+ bufferbits := bufferbits - n;
+ Result := UCS2(buffertemp);
+end; { READ_N_BITS }
+
+function ConvertUCS2toUTF7(var sourceStart: PWideChar; sourceEnd: PWideChar;
+ var targetStart: PAnsiChar; targetEnd: PAnsiChar; optional: Boolean;
+ verbose: Boolean): Integer;
+var
+ r: UCS2;
+ target: PAnsiChar;
+ source: PWideChar;
+ BITbuffer: Cardinal;
+ bufferbits: Integer;
+ shifted: Boolean;
+ needshift: Boolean;
+ done: Boolean;
+ mustshift: PAnsiChar;
+begin
+ Initialize_UTF7_Data;
+ Result := 0;
+ BITbuffer := 0;
+ bufferbits := 0;
+ shifted := False;
+ source := sourceStart;
+ target := targetStart;
+ r := 0;
+ if needtables then
+ tabinit;
+ if optional then
+ mustshift := @mustshiftopt[0]
+ else
+ mustshift := @mustshiftsafe[0];
+ repeat
+ done := source >= sourceEnd;
+ if not Done then
+ begin
+ r := Word(source^);
+ Inc(Source);
+ end { If };
+ needshift := (not done) and ((r > $7F) or (mustshift[r] <> #0));
+ if needshift and (not shifted) then
+ begin
+ if (Target >= TargetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ target^ := '+';
+ Inc(target);
+ { Special case handling of the SHIFT_IN character }
+ if (r = UCS2('+')) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end;
+ target^ := '-';
+ Inc(target);
+ end
+ else
+ shifted := True;
+ end { If };
+ if shifted then
+ begin
+ { Either write the character to the bit buffer, or pad }
+ { the bit buffer out to a full base64 character. }
+ { }
+ if needshift then
+ WRITE_N_BITS(r, 16, BITbuffer, bufferbits)
+ else
+ WRITE_N_BITS(0, (6 - (bufferbits mod 6)) mod 6, BITbuffer,
+ bufferbits);
+ { Flush out as many full base64 characters as possible }
+ { from the bit buffer. }
+ { }
+ while (target < targetEnd) and (bufferbits >= 6) do
+ begin
+ Target^ := base64[READ_N_BITS(6, BITbuffer, bufferbits)];
+ Inc(Target);
+ end { While };
+ if (bufferbits >= 6) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ end { If };
+ if (not needshift) then
+ begin
+ { Write the explicit shift out character if }
+ { 1) The caller has requested we always do it, or }
+ { 2) The directly encoded character is in the }
+ { base64 set, or }
+ { 3) The directly encoded character is SHIFT_OUT. }
+ { }
+ if verbose or ((not done) and ((invbase64[r] >= 0) or (r =
+ Integer('-')))) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ Break;
+ end { If };
+ Target^ := '-';
+ Inc(Target);
+ end { If };
+ shifted := False;
+ end { If };
+ { The character can be directly encoded as ASCII. }
+ end { If };
+ if (not needshift) and (not done) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ Target^ := AnsiChar(r);
+ Inc(Target);
+ end { If };
+ until (done);
+ sourceStart := source;
+ targetStart := target;
+end; { ConvertUCS2toUTF7 }
+
+function ConvertUTF7toUCS2(var sourceStart: PAnsiChar; sourceEnd: PAnsiChar;
+ var targetStart: PWideChar; targetEnd: PWideChar): Integer;
+var
+ target: PWideChar { Register };
+ source: PAnsiChar { Register };
+ BITbuffer: Cardinal { & "Address Of" Used };
+ bufferbits: Integer { & "Address Of" Used };
+ shifted: Boolean { Used In Boolean Context };
+ first: Boolean { Used In Boolean Context };
+ wroteone: Boolean;
+ base64EOF: Boolean;
+ base64value: Integer;
+ done: Boolean;
+ c: UCS2;
+ prevc: UCS2;
+ junk: UCS2 { Used In Boolean Context };
+begin
+ Initialize_UTF7_Data;
+ Result := 0;
+ BITbuffer := 0;
+ bufferbits := 0;
+ shifted := False;
+ first := False;
+ wroteone := False;
+ source := sourceStart;
+ target := targetStart;
+ c := 0;
+ if needtables then
+ tabinit;
+ repeat
+ { read an ASCII character c }
+ done := Source >= SourceEnd;
+ if (not done) then
+ begin
+ c := Word(Source^);
+ Inc(Source);
+ end { If };
+ if shifted then
+ begin
+ { We're done with a base64 string if we hit EOF, it's not a valid }
+ { ASCII character, or it's not in the base64 set. }
+ { }
+ base64value := invbase64[c];
+ base64EOF := (done or (c > $7F)) or (base64value < 0);
+ if base64EOF then
+ begin
+ shifted := False;
+ { If the character causing us to drop out was SHIFT_IN or }
+ { SHIFT_OUT, it may be a special escape for SHIFT_IN. The }
+ { test for SHIFT_IN is not necessary, but allows an alternate }
+ { form of UTF-7 where SHIFT_IN is escaped by SHIFT_IN. This }
+ { only works for some values of SHIFT_IN. }
+ { }
+ if ((not done) and ((c = Integer('+')) or (c = Integer('-')))) then
+ begin
+ { get another character c }
+ prevc := c;
+ Done := Source >= SourceEnd;
+ if (not Done) then
+ begin
+ c := Word(Source^);
+ Inc(Source);
+ { If no base64 characters were encountered, and the }
+ { character terminating the shift sequence was }
+ { SHIFT_OUT, then it's a special escape for SHIFT_IN. }
+ { }
+ end;
+ if first and (prevc = Integer('-')) then
+ begin
+ { write SHIFT_IN unicode }
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ Target^ := WideChar('+');
+ Inc(Target);
+ end
+ else
+ begin
+ if (not wroteone) then
+ begin
+ Result := 1;
+ end { If };
+ end { Else };
+ ;
+ end { If }
+ else
+ begin
+ if (not wroteone) then
+ begin
+ Result := 1;
+ end { If };
+ end { Else };
+ end { If }
+ else
+ begin
+ { Add another 6 bits of base64 to the bit buffer. }
+ WRITE_N_BITS(base64value, 6, BITbuffer,
+ bufferbits);
+ first := False;
+ end { Else };
+ { Extract as many full 16 bit characters as possible from the }
+ { bit buffer. }
+ { }
+ while (bufferbits >= 16) and (target < targetEnd) do
+ begin
+ { write a unicode }
+ Target^ := WideChar(READ_N_BITS(16, BITbuffer, bufferbits));
+ Inc(Target);
+ wroteone := True;
+ end { While };
+ if (bufferbits >= 16) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ Break;
+ end;
+ end { If };
+ if (base64EOF) then
+ begin
+ junk := READ_N_BITS(bufferbits, BITbuffer, bufferbits);
+ if (junk <> 0) then
+ begin
+ Result := 1;
+ end { If };
+ end { If };
+ end { If };
+ if (not shifted) and (not done) then
+ begin
+ if (c = Integer('+')) then
+ begin
+ shifted := True;
+ first := True;
+ wroteone := False;
+ end { If }
+ else
+ begin
+ { It must be a directly encoded character. }
+ if (c > $7F) then
+ begin
+ Result := 1;
+ end { If };
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ Target^ := WideChar(c);
+ Inc(Target);
+ end { Else };
+ end { If };
+ until (done);
+ sourceStart := source;
+ targetStart := target;
+end; { ConvertUTF7toUCS2 }
+
+ {*****************************************************************************}
+ { Thanks to Francisco Leong for providing the Pascal conversion of }
+ { ConvertUTF7.c (by David B. Goldsmith) }
+ {*****************************************************************************}
+
+resourcestring
+ SBufferOverflow = 'Buffer overflow';
+ SInvalidUTF7 = 'Invalid UTF7';
+
+function WideStringToUTF7(const W: WideString): AnsiString;
+var
+ SourceStart, SourceEnd: PWideChar;
+ TargetStart, TargetEnd: PAnsiChar;
+begin
+ if W = '' then
+ Result := ''
+ else
+ begin
+ SetLength(Result, Length(W) * 7); // Assume worst case
+ SourceStart := PWideChar(@W[1]);
+ SourceEnd := PWideChar(@W[Length(W)]) + 1;
+ TargetStart := PAnsiChar(@Result[1]);
+ TargetEnd := PAnsiChar(@Result[Length(Result)]) + 1;
+ if ConvertUCS2toUTF7(SourceStart, SourceEnd, TargetStart,
+ TargetEnd, True, False) <> 0
+ then
+ raise ETntInternalError.Create(SBufferOverflow);
+ SetLength(Result, TargetStart - PAnsiChar(@Result[1]));
+ end;
+end;
+
+function UTF7ToWideString(const S: AnsiString): WideString;
+var
+ SourceStart, SourceEnd: PAnsiChar;
+ TargetStart, TargetEnd: PWideChar;
+begin
+ if (S = '') then
+ Result := ''
+ else
+ begin
+ SetLength(Result, Length(S)); // Assume Worst case
+ SourceStart := PAnsiChar(@S[1]);
+ SourceEnd := PAnsiChar(@S[Length(S)]) + 1;
+ TargetStart := PWideChar(@Result[1]);
+ TargetEnd := PWideChar(@Result[Length(Result)]) + 1;
+ case ConvertUTF7toUCS2(SourceStart, SourceEnd, TargetStart,
+ TargetEnd) of
+ 1: raise ETntGeneralError.Create(SInvalidUTF7);
+ 2: raise ETntInternalError.Create(SBufferOverflow);
+ end;
+ SetLength(Result, TargetStart - PWideChar(@Result[1]));
+ end;
+end;
+
+function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
+var
+ InputLength,
+ OutputLength: Integer;
+begin
+ if CodePage = CP_UTF7 then
+ Result := UTF7ToWideString(S) // CP_UTF7 not supported on Windows 95
+ else if CodePage = CP_UTF8 then
+ Result := UTF8ToWideString(S) // CP_UTF8 not supported on Windows 95
+ else begin
+ InputLength := Length(S);
+ OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0);
+ SetLength(Result, OutputLength);
+ MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength);
+ end;
+end;
+
+function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
+var
+ InputLength,
+ OutputLength: Integer;
+begin
+ if CodePage = CP_UTF7 then
+ Result := WideStringToUTF7(WS) // CP_UTF7 not supported on Windows 95
+ else if CodePage = CP_UTF8 then
+ Result := WideStringToUTF8(WS) // CP_UTF8 not supported on Windows 95
+ else begin
+ InputLength := Length(WS);
+ OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil);
+ SetLength(Result, OutputLength);
+ WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil);
+ end;
+end;
+
+function UCS2ToWideString(const Value: AnsiString): WideString;
+begin
+ if Length(Value) = 0 then
+ Result := ''
+ else
+ SetString(Result, PWideChar(@Value[1]), Length(Value) div SizeOf(WideChar))
+end;
+
+function WideStringToUCS2(const Value: WideString): AnsiString;
+begin
+ if Length(Value) = 0 then
+ Result := ''
+ else
+ SetString(Result, PAnsiChar(@Value[1]), Length(Value) * SizeOf(WideChar))
+end;
+
+{ Windows.pas doesn't declare TranslateCharsetInfo() correctly. }
+function TranslateCharsetInfo(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo';
+
+function CharSetToCodePage(ciCharset: UINT): Cardinal;
+var
+ C: TCharsetInfo;
+begin
+ Win32Check(TranslateCharsetInfo(PDWORD(ciCharset), C, TCI_SRCCHARSET));
+ Result := C.ciACP
+end;
+
+function LCIDToCodePage(ALcid: LCID): Cardinal;
+var
+ Buf: array[0..6] of AnsiChar;
+begin
+ GetLocaleInfo(ALcid, LOCALE_IDefaultAnsiCodePage, Buf, 6);
+ Result := StrToIntDef(Buf, GetACP);
+end;
+
+function KeyboardCodePage: Cardinal;
+begin
+ Result := LCIDToCodePage(GetKeyboardLayout(0) and $FFFF);
+end;
+
+function KeyUnicode(CharCode: Word): WideChar;
+var
+ AChar: AnsiChar;
+begin
+ // converts the given character (as it comes with a WM_CHAR message) into its
+ // corresponding Unicode character depending on the active keyboard layout
+ if CharCode <= Word(High(AnsiChar)) then begin
+ AChar := AnsiChar(CharCode);
+ MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @AChar, 1, @Result, 1);
+ end else
+ Result := WideChar(CharCode);
+end;
+
+procedure StrSwapByteOrder(Str: PWideChar);
+var
+ P: PWord;
+begin
+ P := PWord(Str);
+ While (P^ <> 0) do begin
+ P^ := MakeWord(HiByte(P^), LoByte(P^));
+ Inc(P);
+ end;
+end;
+
+//--------------------------------------------------------------------
+// LoadResString()
+//
+// This system function is used to retrieve a resourcestring and
+// return the result as an AnsiString. If we believe that the result
+// is only a temporary value, and that it will be immediately
+// assigned to a WideString or a Variant, then we will save the
+// Unicode result as well as a reference to the original Ansi string.
+// WStrFromPCharLen() or VarFromLStr() will return this saved
+// Unicode string if it appears to receive the most recent result
+// of LoadResString.
+//--------------------------------------------------------------------
+
+
+ //===========================================================================================
+ //
+ // function CodeMatchesPatternForUnicode(...);
+ //
+ // GIVEN: SomeWideString := SSomeResString; { WideString := resourcestring }
+ //
+ // Delphi will compile this statement into the following:
+ // -------------------------------------------------
+ // TempAnsiString := LoadResString(@SSomeResString);
+ // LINE 1: lea edx,[SomeTempAnsiString]
+ // LINE 2: mov eax,[@SomeResString]
+ // LINE 3: call LoadResString
+ //
+ // WStrFromLStr(SomeWideString, TempAnsiString); { SomeWideString := TempAnsiString }
+ // LINE 4: mov edx,[SomeTempAnsiString]
+ // LINE 5: mov/lea eax [@SomeWideString]
+ // LINE 6: call @WStrFromLStr
+ // -------------------------------------------------
+ //
+ // The order in which the parameters are prepared for WStrFromLStr (ie LINE 4 & 5) is
+ // reversed when assigning a non-temporary AnsiString to a WideString.
+ //
+ // This code, for example, results in LINE 4 and LINE 5 being swapped.
+ //
+ // SomeAnsiString := SSomeResString;
+ // SomeWideString := SomeAnsiString;
+ //
+ // Since we know the "signature" used by the compiler, we can detect this pattern.
+ // If we believe it is only temporary, we can save the Unicode results for later
+ // retrieval from WStrFromLStr.
+ //
+ // One final note: When assigning a resourcestring to a Variant, the same patterns exist.
+ //===========================================================================================
+
+function CodeMatchesPatternForUnicode(PLine4: PAnsiChar): Boolean;
+const
+ SIZEOF_OPCODE = 1 {byte};
+ MOV_16_OPCODE = AnsiChar($8B); { we'll assume operand size is 16 bits }
+ MOV_32_OPCODE = AnsiChar($B8); { we'll assume operand size is 32 bits }
+ LEA_OPCODE = AnsiChar($8D); { operand size can be 16 or 40 bits }
+ CALL_OPCODE = AnsiChar($E8); { assumed operand size is 32 bits }
+ BREAK_OPCODE = AnsiChar($CC); {in a breakpoint}
+var
+ PLine1: PAnsiChar;
+ PLine2: PAnsiChar;
+ PLine3: PAnsiChar;
+ DataSize: Integer; // bytes in first LEA operand
+begin
+ Result := False;
+
+ PLine3 := PLine4 - SizeOf(CALL_OPCODE) - 4;
+ PLine2 := PLine3 - SizeOf(MOV_32_OPCODE) - 4;
+
+ // figure PLine1 and operand size
+ DataSize := 2; { try 16 bit operand for line 1 }
+ PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
+ if (PLine1^ <> LEA_OPCODE) and (not (IsDebugging and (PLine1^ = BREAK_OPCODE))) then
+ begin
+ DataSize := 5; { try 40 bit operand for line 1 }
+ PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
+ end;
+ if (PLine1^ = LEA_OPCODE) or (IsDebugging and (PLine1^ = BREAK_OPCODE)) then
+ begin
+ if CompareMem(PLine1 + SIZEOF_OPCODE, PLine4 + SIZEOF_OPCODE, DataSize) then
+ begin
+ // After this check, it seems to match the WideString <- (temp) AnsiString pattern
+ Result := True; // It is probably OK. (The side effects of being wrong aren't very bad.)
+ end;
+ end;
+end;
+
+threadvar
+ PLastResString: PAnsiChar;
+ LastResStringValue: AnsiString;
+ LastWideResString: WideString;
+
+function Custom_System_LoadResString(ResStringRec: PResStringRec): AnsiString;
+var
+ ReturnAddr: Pointer;
+begin
+ // get return address
+ asm
+ PUSH ECX
+ MOV ECX, [EBP + 4]
+ MOV ReturnAddr, ECX
+ POP ECX
+ end;
+ // check calling code pattern
+ if CodeMatchesPatternForUnicode(ReturnAddr) then begin
+ // result will probably be assigned to an intermediate AnsiString
+ // on its way to either a WideString or Variant.
+ LastWideResString := WideLoadResString(ResStringRec);
+ Result := LastWideResString;
+ LastResStringValue := Result;
+ if Result = '' then
+ PLastResString := nil
+ else
+ PLastResString := PAnsiChar(Result);
+ end else begin
+ // result will probably be assigned to an actual AnsiString variable.
+ PLastResString := nil;
+ Result := WideLoadResString(ResStringRec);
+ end;
+end;
+
+//--------------------------------------------------------------------
+// WStrFromPCharLen()
+//
+// This system function is used to assign an AnsiString to a WideString.
+// It has been modified to assign Unicode results from LoadResString.
+// Another purpose of this function is to specify the code page.
+//--------------------------------------------------------------------
+
+procedure Custom_System_WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
+var
+ DestLen: Integer;
+ Buffer: array[0..2047] of WideChar;
+ Local_PLastResString: Pointer;
+begin
+ Local_PLastResString := PLastResString;
+ if (Local_PLastResString <> nil)
+ and (Local_PLastResString = Source)
+ and (System.Length(LastResStringValue) = Length)
+ and (LastResStringValue = Source) then begin
+ // use last unicode resource string
+ PLastResString := nil; { clear for further use }
+ Dest := LastWideResString;
+ end else begin
+ if Local_PLastResString <> nil then
+ PLastResString := nil; { clear for further use }
+ if Length <= 0 then
+ begin
+ Dest := '';
+ Exit;
+ end;
+ if Length + 1 < High(Buffer) then
+ begin
+ DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Buffer,
+ High(Buffer));
+ if DestLen > 0 then
+ begin
+ SetLength(Dest, DestLen);
+ Move(Pointer(@Buffer[0])^, Pointer(Dest)^, DestLen * SizeOf(WideChar));
+ Exit;
+ end;
+ end;
+ DestLen := (Length + 1);
+ SetLength(Dest, DestLen); // overallocate, trim later
+ DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest),
+ DestLen);
+ if DestLen < 0 then
+ DestLen := 0;
+ SetLength(Dest, DestLen);
+ end;
+end;
+
+//--------------------------------------------------------------------
+// LStrFromPWCharLen()
+//
+// This system function is used to assign an WideString to an AnsiString.
+// It has not been modified from its original purpose other than to specify the code page.
+//--------------------------------------------------------------------
+
+procedure Custom_System_LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
+var
+ DestLen: Integer;
+ Buffer: array[0..4095] of AnsiChar;
+begin
+ if Length <= 0 then
+ begin
+ Dest := '';
+ Exit;
+ end;
+ if Length + 1 < (High(Buffer) div sizeof(WideChar)) then
+ begin
+ DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source,
+ Length, Buffer, High(Buffer),
+ nil, nil);
+ if DestLen >= 0 then
+ begin
+ SetLength(Dest, DestLen);
+ Move(Pointer(@Buffer[0])^, PAnsiChar(Dest)^, DestLen);
+ Exit;
+ end;
+ end;
+
+ DestLen := (Length + 1) * sizeof(WideChar);
+ SetLength(Dest, DestLen); // overallocate, trim later
+ DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest), DestLen,
+ nil, nil);
+ if DestLen < 0 then
+ DestLen := 0;
+ SetLength(Dest, DestLen);
+end;
+
+//--------------------------------------------------------------------
+// WStrToString()
+//
+// This system function is used to assign an WideString to an short string.
+// It has not been modified from its original purpose other than to specify the code page.
+//--------------------------------------------------------------------
+
+procedure Custom_System_WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
+var
+ SourceLen, DestLen: Integer;
+ Buffer: array[0..511] of AnsiChar;
+begin
+ if MaxLen > 255 then MaxLen := 255;
+ SourceLen := Length(Source);
+ if SourceLen >= MaxLen then SourceLen := MaxLen;
+ if SourceLen = 0 then
+ DestLen := 0
+ else begin
+ DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Pointer(Source), SourceLen,
+ Buffer, SizeOf(Buffer), nil, nil);
+ if DestLen > MaxLen then DestLen := MaxLen;
+ end;
+ Dest^[0] := Chr(DestLen);
+ if DestLen > 0 then Move(Buffer, Dest^[1], DestLen);
+end;
+
+//--------------------------------------------------------------------
+// VarFromLStr()
+//
+// This system function is used to assign an AnsiString to a Variant.
+// It has been modified to assign Unicode results from LoadResString.
+//--------------------------------------------------------------------
+
+procedure Custom_System_VarFromLStr(var V: TVarData; const Value: AnsiString);
+const
+ varDeepData = $BFE8;
+var
+ Local_PLastResString: Pointer;
+begin
+ if (V.VType and varDeepData) <> 0 then
+ VarClear(PVariant(@V)^);
+
+ Local_PLastResString := PLastResString;
+ if (Local_PLastResString <> nil)
+ and (Local_PLastResString = PAnsiChar(Value))
+ and (LastResStringValue = Value) then begin
+ // use last unicode resource string
+ PLastResString := nil; { clear for further use }
+ V.VOleStr := nil;
+ V.VType := varOleStr;
+ WideString(Pointer(V.VOleStr)) := Copy(LastWideResString, 1, MaxInt);
+ end else begin
+ if Local_PLastResString <> nil then
+ PLastResString := nil; { clear for further use }
+ V.VString := nil;
+ V.VType := varString;
+ AnsiString(V.VString) := Value;
+ end;
+end;
+
+//--------------------------------------------------------------------
+// WStrCat3() A := B + C;
+//
+// This system function is used to concatenate two strings into one result.
+// This function is added because A := '' + '' doesn't necessarily result in A = '';
+//--------------------------------------------------------------------
+
+procedure Custom_System_WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
+
+ function NewWideString(CharLength: Longint): Pointer;
+ var
+ _NewWideString: function(CharLength: Longint): Pointer;
+ begin
+ asm
+ PUSH ECX
+ MOV ECX, offset System. at NewWideString;
+ MOV _NewWideString, ECX
+ POP ECX
+ end;
+ Result := _NewWideString(CharLength);
+ end;
+
+ procedure WStrSet(var S: WideString; P: PWideChar);
+ var
+ Temp: Pointer;
+ begin
+ Temp := Pointer(InterlockedExchange(Integer(S), Integer(P)));
+ if Temp <> nil then
+ WideString(Temp) := '';
+ end;
+
+var
+ Source1Len, Source2Len: Integer;
+ NewStr: PWideChar;
+begin
+ Source1Len := Length(Source1);
+ Source2Len := Length(Source2);
+ if (Source1Len <> 0) or (Source2Len <> 0) then
+ begin
+ NewStr := NewWideString(Source1Len + Source2Len);
+ Move(Pointer(Source1)^, Pointer(NewStr)^, Source1Len * sizeof(WideChar));
+ Move(Pointer(Source2)^, NewStr[Source1Len], Source2Len * sizeof(WideChar));
+ WStrSet(Dest, NewStr);
+ end else
+ Dest := '';
+end;
+
+//--------------------------------------------------------------------
+// System proc replacements
+//--------------------------------------------------------------------
+
+type
+ POverwrittenData = ^TOverwrittenData;
+ TOverwrittenData = record
+ Location: Pointer;
+ OldCode: array[0..6] of Byte;
+ end;
+
+procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer; Data: POverwrittenData = nil);
+{ OverwriteProcedure originally from Igor Siticov }
+{ Modified by Jacques Garcia Vazquez }
+var
+ x: PAnsiChar;
+ y: integer;
+ ov2, ov: cardinal;
+ p: pointer;
+begin
+ if Assigned(Data) and (Data.Location <> nil) then
+ exit; { procedure already overwritten }
+
+ // need six bytes in place of 5
+ x := PAnsiChar(OldProcedure);
+ if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
+ RaiseLastOSError;
+
+ // if a jump is present then a redirect is found
+ // $FF25 = jmp dword ptr [xxx]
+ // This redirect is normally present in bpl files, but not in exe files
+ p := OldProcedure;
+
+ if Word(p^) = $25FF then
+ begin
+ Inc(Integer(p), 2); // skip the jump
+ // get the jump address p^ and dereference it p^^
+ p := Pointer(Pointer(p^)^);
+
+ // release the memory
+ if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
+ RaiseLastOSError;
+
+ // re protect the correct one
+ x := PAnsiChar(p);
+ if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
+ RaiseLastOSError;
+ end;
+
+ if Assigned(Data) then
+ begin
+ Move(x^, Data.OldCode, 6);
+ { Assign Location last so that Location <> nil only if OldCode is properly initialized. }
+ Data.Location := x;
+ end;
+
+ x[0] := AnsiChar($E9);
+ y := integer(NewProcedure) - integer(p) - 5;
+ x[1] := AnsiChar(y and 255);
+ x[2] := AnsiChar((y shr 8) and 255);
+ x[3] := AnsiChar((y shr 16) and 255);
+ x[4] := AnsiChar((y shr 24) and 255);
+
+ if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
+ RaiseLastOSError;
+end;
+
+procedure RestoreProcedure(OriginalProc: Pointer; Data: TOverwrittenData);
+var
+ ov, ov2: Cardinal;
+begin
+ if Data.Location <> nil then begin
+ if not VirtualProtect(Data.Location, 6, PAGE_EXECUTE_READWRITE, @ov) then
+ RaiseLastOSError;
+ Move(Data.OldCode, Data.Location^, 6);
+ if not VirtualProtect(Data.Location, 6, ov, @ov2) then
+ RaiseLastOSError;
+ end;
+end;
+
+function Addr_System_LoadResString: Pointer;
+begin
+ Result := @System.LoadResString{TNT-ALLOW LoadResString};
+end;
+
+function Addr_System_WStrFromPCharLen: Pointer;
+asm
+ mov eax, offset System. at WStrFromPCharLen;
+end;
+
+function Addr_System_LStrFromPWCharLen: Pointer;
+asm
+ mov eax, offset System. at LStrFromPWCharLen;
+end;
+
+function Addr_System_WStrToString: Pointer;
+asm
+ mov eax, offset System. at WStrToString;
+end;
+
+function Addr_System_VarFromLStr: Pointer;
+asm
+ mov eax, offset System. at VarFromLStr;
+end;
+
+function Addr_System_WStrCat3: Pointer;
+asm
+ mov eax, offset System. at WStrCat3;
+end;
+
+var
+ System_LoadResString_Code,
+ System_WStrFromPCharLen_Code,
+ System_LStrFromPWCharLen_Code,
+ System_WStrToString_Code,
+ System_VarFromLStr_Code,
+ System_WStrCat3_Code
+ {$IFDEF COMPILER_6_UP}
+ ,
+ SysUtils_WideFmtStr_Code
+ {$ENDIF}
+ : TOverwrittenData;
+
+procedure InstallStringConversionOverrides;
+begin
+ OverwriteProcedure(Addr_System_WStrFromPCharLen, @Custom_System_WStrFromPCharLen, @System_WStrFromPCharLen_Code);
+ OverwriteProcedure(Addr_System_LStrFromPWCharLen, @Custom_System_LStrFromPWCharLen, @System_LStrFromPWCharLen_Code);
+ OverwriteProcedure(Addr_System_WStrToString, @Custom_System_WStrToString, @System_WStrToString_Code);
+end;
+
+procedure InstallWideResourceStrings;
+begin
+ OverwriteProcedure(Addr_System_LoadResString, @Custom_System_LoadResString, @System_LoadResString_Code);
+ OverwriteProcedure(Addr_System_VarFromLStr, @Custom_System_VarFromLStr, @System_VarFromLStr_Code);
+end;
+
+procedure InstallWideStringConcatenationFix;
+begin
+ OverwriteProcedure(Addr_System_WStrCat3, @Custom_System_WStrCat3, @System_WStrCat3_Code);
+end;
+
+{$IFDEF COMPILER_6_UP}
+procedure InstallWideFormatFixes;
+begin
+ OverwriteProcedure(@SysUtils.WideFmtStr{TNT-ALLOW WideFmtStr}, @TntSysUtils.Tnt_WideFmtStr, @SysUtils_WideFmtStr_Code);
+end;
+{$ENDIF}
+
+procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
+begin
+ if tsWideResourceStrings in Updates then begin
+ InstallStringConversionOverrides;
+ InstallWideResourceStrings;
+ end;
+ {$IFNDEF COMPILER_9_UP}
+ if tsFixImplicitCodePage in Updates then begin
+ InstallStringConversionOverrides;
+ { CP_ACP is the code page used by the non-Unicode Windows API. }
+ DefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
+ end;
+ if tsFixWideStrConcat in Updates then begin
+ InstallWideStringConcatenationFix;
+ end;
+ {$IFDEF COMPILER_6_UP}
+ if tsFixWideFormat in Updates then begin
+ InstallWideFormatFixes;
+ end;
+ {$ENDIF}
+ {$ENDIF}
+end;
+
+var
+ StartupDefaultUserCodePage: Cardinal;
+
+procedure UninstallSystemOverrides;
+begin
+ // String Conversion
+ RestoreProcedure(Addr_System_WStrFromPCharLen, System_WStrFromPCharLen_Code);
+ RestoreProcedure(Addr_System_LStrFromPWCharLen, System_LStrFromPWCharLen_Code);
+ RestoreProcedure(Addr_System_WStrToString, System_WStrToString_Code);
+ DefaultSystemCodePage := StartupDefaultUserCodePage;
+ // Wide resourcestring
+ RestoreProcedure(Addr_System_LoadResString, System_LoadResString_Code);
+ RestoreProcedure(Addr_System_VarFromLStr, System_VarFromLStr_Code);
+ // WideString concat fix
+ RestoreProcedure(Addr_System_WStrCat3, System_WStrCat3_Code);
+ {$IFDEF COMPILER_6_UP}
+ // WideFormat fixes
+ RestoreProcedure(@SysUtils.WideFmtStr{TNT-ALLOW WideFmtStr}, SysUtils_WideFmtStr_Code);
+ {$ENDIF}
+end;
+
+initialization
+ {$IFDEF COMPILER_9_UP}
+ DefaultSystemCodePage := GetACP;
+ {$ELSE}
+ {$IFDEF COMPILER_7_UP}
+ if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
+ DefaultSystemCodePage := CP_THREAD_ACP // Win 2K/XP/...
+ else
+ DefaultSystemCodePage := LCIDToCodePage(GetThreadLocale); // Win NT4/95/98/ME
+ {$ELSE}
+ DefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
+ {$ENDIF}
+ {$ENDIF}
+ StartupDefaultUserCodePage := DefaultSystemCodePage;
+ IsDebugging := DebugHook > 0;
+
+finalization
+ UninstallSystemOverrides;
+ LastResStringValue := ''; { Make MemorySleuth happy. }
+ LastWideResString := ''; { Make MemorySleuth happy. }
+
+end.
Added: trunk/TntUnicodeControls/TntTypInfo.pas
===================================================================
--- trunk/TntUnicodeControls/TntTypInfo.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntTypInfo.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,124 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntTypInfo;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ TypInfo;
+
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
+procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
+{$ENDIF}
+
+implementation
+
+{$IFNDEF COMPILER_6_UP}
+procedure AssignWideStr(var Dest: WideString; const Source: WideString);
+begin
+ Dest := Source;
+end;
+
+procedure IntGetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
+ var Value: WideString); assembler;
+asm
+ { -> EAX Pointer to instance }
+ { EDX Pointer to property info }
+ { ECX Pointer to result string }
+
+ PUSH ESI
+ PUSH EDI
+ MOV EDI,EDX
+
+ MOV EDX,[EDI].TPropInfo.Index { pass index in EDX }
+ CMP EDX,$80000000
+ JNE @@hasIndex
+ MOV EDX,ECX { pass value in EDX }
+@@hasIndex:
+ MOV ESI,[EDI].TPropInfo.GetProc
+ CMP [EDI].TPropInfo.GetProc.Byte[3],$FE
+ JA @@isField
+ JB @@isStaticMethod
+
+@@isVirtualMethod:
+ MOVSX ESI,SI { sign extend slot offset }
+ ADD ESI,[EAX] { vmt + slot offset }
+ CALL DWORD PTR [ESI]
+ JMP @@exit
+
+@@isStaticMethod:
+ CALL ESI
+ JMP @@exit
+
+@@isField:
+ AND ESI,$00FFFFFF
+ MOV EDX,[EAX+ESI]
+ MOV EAX,ECX
+ CALL AssignWideStr
+
+@@exit:
+ POP EDI
+ POP ESI
+end;
+
+function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
+begin
+ IntGetWideStrProp(Instance, PropInfo, Result);
+end;
+
+procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
+ const Value: WideString); assembler;
+asm
+ { -> EAX Pointer to instance }
+ { EDX Pointer to property info }
+ { ECX Pointer to string value }
+
+ PUSH ESI
+ PUSH EDI
+ MOV ESI,EDX
+
+ MOV EDX,[ESI].TPropInfo.Index { pass index in EDX }
+ CMP EDX,$80000000
+ JNE @@hasIndex
+ MOV EDX,ECX { pass value in EDX }
+@@hasIndex:
+ MOV EDI,[ESI].TPropInfo.SetProc
+ CMP [ESI].TPropInfo.SetProc.Byte[3],$FE
+ JA @@isField
+ JB @@isStaticMethod
+
+@@isVirtualMethod:
+ MOVSX EDI,DI
+ ADD EDI,[EAX]
+ CALL DWORD PTR [EDI]
+ JMP @@exit
+
+@@isStaticMethod:
+ CALL EDI
+ JMP @@exit
+
+@@isField:
+ AND EDI,$00FFFFFF
+ ADD EAX,EDI
+ MOV EDX,ECX
+ CALL AssignWideStr
+
+@@exit:
+ POP EDI
+ POP ESI
+end;
+{$ENDIF}
+
+end.
Added: trunk/TntUnicodeControls/TntWindows.pas
===================================================================
--- trunk/TntUnicodeControls/TntWindows.pas 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/TntUnicodeControls/TntWindows.pas 2006-07-31 03:46:13 UTC (rev 435)
@@ -0,0 +1,1363 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://tnt.ccci.org/delphi_unicode_controls/ }
+{ Version: 2.1.11 }
+{ }
+{ Copyright (c) 2002-2004, Troy Wolbrink (troy.wolbrink at ccci.org) }
+{ }
+{*****************************************************************************}
+
+unit TntWindows;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Windows, ShellApi, ShlObj;
+
+// ......... compatibility
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+const
+ WS_EX_LAYERED = $00080000;
+{$ENDIF}
+
+const
+ DT_NOFULLWIDTHCHARBREAK = $00080000;
+
+const
+ INVALID_FILE_ATTRIBUTES = DWORD(-1);
+
+// ................ ANSI TYPES ................
+{TNT-WARN LPSTR}
+{TNT-WARN PLPSTR}
+{TNT-WARN LPCSTR}
+{TNT-WARN LPCTSTR}
+{TNT-WARN LPTSTR}
+
+// ........ EnumResourceTypesW, EnumResourceNamesW and EnumResourceLanguagesW are supposed ....
+// ........ to work on Win95/98/ME but have caused access violations in testing on Win95 ......
+// .. TNT--WARN EnumResourceTypes ..
+// .. TNT--WARN EnumResourceTypesA ..
+// .. TNT--WARN EnumResourceNames ..
+// .. TNT--WARN EnumResourceNamesA ..
+// .. TNT--WARN EnumResourceLanguages ..
+// .. TNT--WARN EnumResourceLanguagesA ..
+
+//------------------------------------------------------------------------------------------
+
+// ......... The Unicode form of these functions are supported on Windows 95/98/ME .........
+{TNT-WARN ExtTextOut}
+{TNT-WARN ExtTextOutA}
+{TNT-WARN Tnt_ExtTextOutW}
+
+{TNT-WARN FindResource}
+{TNT-WARN FindResourceA}
+{TNT-WARN Tnt_FindResourceW}
+
+{TNT-WARN FindResourceEx}
+{TNT-WARN FindResourceExA}
+{TNT-WARN Tnt_FindResourceExW}
+
+{TNT-WARN GetCharWidth}
+{TNT-WARN GetCharWidthA}
+{TNT-WARN Tnt_GetCharWidthW}
+
+{TNT-WARN GetCommandLine}
+{TNT-WARN GetCommandLineA}
+{TNT-WARN Tnt_GetCommandLineW}
+
+{TNT-WARN GetTextExtentPoint}
+{TNT-WARN GetTextExtentPointA}
+{TNT-WARN Tnt_GetTextExtentPointW}
+
+{TNT-WARN GetTextExtentPoint32}
+{TNT-WARN GetTextExtentPoint32A}
+{TNT-WARN Tnt_GetTextExtentPoint32W}
+
+{TNT-WARN lstrcat}
+{TNT-WARN lstrcatA}
+{TNT-WARN Tnt_lstrcatW}
+
+{TNT-WARN lstrcpy}
+{TNT-WARN lstrcpyA}
+{TNT-WARN Tnt_lstrcpyW}
+
+{TNT-WARN lstrlen}
+{TNT-WARN lstrlenA}
+{TNT-WARN Tnt_lstrlenW}
+
+{TNT-WARN MessageBox}
+{TNT-WARN MessageBoxA}
+{TNT-WARN Tnt_MessageBoxW}
+
+{TNT-WARN MessageBoxEx}
+{TNT-WARN MessageBoxExA}
+{TNT-WARN Tnt_MessageBoxExA}
+
+{TNT-WARN TextOut}
+{TNT-WARN TextOutA}
+{TNT-WARN Tnt_TextOutW}
+
+//------------------------------------------------------------------------------------------
+
+{TNT-WARN LOCALE_USER_DEFAULT} // <-- use GetThreadLocale
+{TNT-WARN LOCALE_SYSTEM_DEFAULT} // <-- use GetThreadLocale
+
+//------------------------------------------------------------------------------------------
+// compatiblity
+//------------------------------------------------------------------------------------------
+{$IFNDEF COMPILER_9_UP}
+type
+ TStartupInfoA = _STARTUPINFOA;
+ TStartupInfoW = record
+ cb: DWORD;
+ lpReserved: PWideChar;
+ lpDesktop: PWideChar;
+ lpTitle: PWideChar;
+ dwX: DWORD;
+ dwY: DWORD;
+ dwXSize: DWORD;
+ dwYSize: DWORD;
+ dwXCountChars: DWORD;
+ dwYCountChars: DWORD;
+ dwFillAttribute: DWORD;
+ dwFlags: DWORD;
+ wShowWindow: Word;
+ cbReserved2: Word;
+ lpReserved2: PByte;
+ hStdInput: THandle;
+ hStdOutput: THandle;
+ hStdError: THandle;
+ end;
+
+function CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
+ lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
+ bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
+ lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
+ var lpProcessInformation: TProcessInformation): BOOL; stdcall; external kernel32 name 'CreateProcessW';
+
+{$ENDIF}
+//------------------------------------------------------------------------------------------
+
+{TNT-WARN SetWindowText}
+{TNT-WARN SetWindowTextA}
+{TNT-WARN SetWindowTextW}
+function Tnt_SetWindowTextW(hWnd: HWND; lpString: PWideChar): BOOL;
+
+{TNT-WARN RemoveDirectory}
+{TNT-WARN RemoveDirectoryA}
+{TNT-WARN RemoveDirectoryW}
+function Tnt_RemoveDirectoryW(lpPathName: PWideChar): BOOL;
+
+{TNT-WARN GetShortPathName}
+{TNT-WARN GetShortPathNameA}
+{TNT-WARN GetShortPathNameW}
+function Tnt_GetShortPathNameW(lpszLongPath: PWideChar; lpszShortPath: PWideChar;
+ cchBuffer: DWORD): DWORD;
+
+{TNT-WARN GetFullPathName}
+{TNT-WARN GetFullPathNameA}
+{TNT-WARN GetFullPathNameW}
+function Tnt_GetFullPathNameW(lpFileName: PWideChar; nBufferLength: DWORD;
+ lpBuffer: PWideChar; var lpFilePart: PWideChar): DWORD;
+
+{TNT-WARN CreateFile}
+{TNT-WARN CreateFileA}
+{TNT-WARN CreateFileW}
+function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
+ lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
+ hTemplateFile: THandle): THandle;
+
+{TNT-WARN FindFirstFile}
+{TNT-WARN FindFirstFileA}
+{TNT-WARN FindFirstFileW}
+function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
+
+{TNT-WARN FindNextFile}
+{TNT-WARN FindNextFileA}
+{TNT-WARN FindNextFileW}
+function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
+
+{TNT-WARN GetFileAttributes}
+{TNT-WARN GetFileAttributesA}
+{TNT-WARN GetFileAttributesW}
+function Tnt_GetFileAttributesW(lpFileName: PWideChar): DWORD;
+
+{TNT-WARN SetFileAttributes}
+{TNT-WARN SetFileAttributesA}
+{TNT-WARN SetFileAttributesW}
+function Tnt_SetFileAttributesW(lpFileName: PWideChar; dwFileAttributes: DWORD): BOOL;
+
+{TNT-WARN CreateDirectory}
+{TNT-WARN CreateDirectoryA}
+{TNT-WARN CreateDirectoryW}
+function Tnt_CreateDirectoryW(lpPathName: PWideChar;
+ lpSecurityAttributes: PSecurityAttributes): BOOL;
+
+{TNT-WARN MoveFile}
+{TNT-WARN MoveFileA}
+{TNT-WARN MoveFileW}
+function Tnt_MoveFileW(lpExistingFileName, lpNewFileName: PWideChar): BOOL;
+
+{TNT-WARN CopyFile}
+{TNT-WARN CopyFileA}
+{TNT-WARN CopyFileW}
+function Tnt_CopyFileW(lpExistingFileName, lpNewFileName: PWideChar; bFailIfExists: BOOL): BOOL;
+
+{TNT-WARN DeleteFile}
+{TNT-WARN DeleteFileA}
+{TNT-WARN DeleteFileW}
+function Tnt_DeleteFileW(lpFileName: PWideChar): BOOL;
+
+{TNT-WARN DrawText}
+{TNT-WARN DrawTextA}
+{TNT-WARN DrawTextW}
+function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
+ var lpRect: TRect; uFormat: UINT): Integer;
+
+{TNT-WARN GetDiskFreeSpace}
+{TNT-WARN GetDiskFreeSpaceA}
+{TNT-WARN GetDiskFreeSpaceW}
+function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
+ lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
+
+{TNT-WARN GetModuleFileName}
+{TNT-WARN GetModuleFileNameA}
+{TNT-WARN GetModuleFileNameW}
+function Tnt_GetModuleFileNameW(hModule: HINST; lpFilename: PWideChar; nSize: DWORD): DWORD;
+
+{TNT-WARN GetTempPath}
+{TNT-WARN GetTempPathA}
+{TNT-WARN GetTempPathW}
+function Tnt_GetTempPathW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
+
+{TNT-WARN GetWindowsDirectory}
+{TNT-WARN GetWindowsDirectoryA}
+{TNT-WARN GetWindowsDirectoryW}
+function Tnt_GetWindowsDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
+
+{TNT-WARN GetSystemDirectory}
+{TNT-WARN GetSystemDirectoryA}
+{TNT-WARN GetSystemDirectoryW}
+function Tnt_GetSystemDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
+
+{TNT-WARN SetCurrentDirectory}
+{TNT-WARN SetCurrentDirectoryA}
+{TNT-WARN SetCurrentDirectoryW}
+function Tnt_SetCurrentDirectoryW(lpPathName: PWideChar): BOOL;
+
+{TNT-WARN GetComputerName}
+{TNT-WARN GetComputerNameA}
+{TNT-WARN GetComputerNameW}
+function Tnt_GetComputerNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
+
+{TNT-WARN GetUserName}
+{TNT-WARN GetUserNameA}
+{TNT-WARN GetUserNameW}
+function Tnt_GetUserNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
+
+{TNT-WARN ShellExecute}
+{TNT-WARN ShellExecuteA}
+{TNT-WARN ShellExecuteW}
+function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
+ Directory: PWideChar; ShowCmd: Integer): HINST;
+
+{TNT-WARN LoadLibrary}
+{TNT-WARN LoadLibraryA}
+{TNT-WARN LoadLibraryW}
+function Tnt_LoadLibraryW(lpLibFileName: PWideChar): HMODULE;
+
+{TNT-WARN LoadLibraryEx}
+{TNT-WARN LoadLibraryExA}
+{TNT-WARN LoadLibraryExW}
+function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
+
+{TNT-WARN CreateProcess}
+{TNT-WARN CreateProcessA}
+{TNT-WARN CreateProcessW}
+function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
+ lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
+ bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
+ lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
+ var lpProcessInformation: TProcessInformation): BOOL;
+
+{TNT-WARN GetCurrencyFormat}
+{TNT-WARN GetCurrencyFormatA}
+{TNT-WARN GetCurrencyFormatW}
+function Tnt_GetCurrencyFormatW(Locale: LCID; dwFlags: DWORD; lpValue: PWideChar;
+ lpFormat: PCurrencyFmtW; lpCurrencyStr: PWideChar; cchCurrency: Integer): Integer;
+
+{TNT-WARN CompareString}
+{TNT-WARN CompareStringA}
+{TNT-WARN CompareStringW}
+function Tnt_CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
+ cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer;
+
+{TNT-WARN CharUpper}
+{TNT-WARN CharUpperA}
+{TNT-WARN CharUpperW}
+function Tnt_CharUpperW(lpsz: PWideChar): PWideChar;
+
+{TNT-WARN CharUpperBuff}
+{TNT-WARN CharUpperBuffA}
+{TNT-WARN CharUpperBuffW}
+function Tnt_CharUpperBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
+
+{TNT-WARN CharLower}
+{TNT-WARN CharLowerA}
+{TNT-WARN CharLowerW}
+function Tnt_CharLowerW(lpsz: PWideChar): PWideChar;
+
+{TNT-WARN CharLowerBuff}
+{TNT-WARN CharLowerBuffA}
+{TNT-WARN CharLowerBuffW}
+function Tnt_CharLowerBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
+
+{TNT-WARN GetStringTypeEx}
+{TNT-WARN GetStringTypeExA}
+{TNT-WARN GetStringTypeExW}
+function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
+ lpSrcStr: PWideChar; cchSrc: Integer; var lpCharType): BOOL;
+
+{TNT-WARN LoadString}
+{TNT-WARN LoadStringA}
+{TNT-WARN LoadStringW}
+function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
+
+{TNT-WARN InsertMenuItem}
+{TNT-WARN InsertMenuItemA}
+{TNT-WARN InsertMenuItemW}
+function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: tagMenuItemINFOW): BOOL;
+
+{TNT-WARN ExtractAssociatedIcon}
+{TNT-WARN ExtractAssociatedIconA}
+{TNT-WARN ExtractAssociatedIconW}
+function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
+ var lpiIcon: Word): HICON;
+
+{TNT-WARN GetFileVersionInfoSize}
+{TNT-WARN GetFileVersionInfoSizeA}
+{TNT-WARN GetFileVersionInfoSizeW}
+function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
+
+{TNT-WARN GetFileVersionInfo}
+{TNT-WARN GetFileVersionInfoA}
+{TNT-WARN GetFileVersionInfoW}
+function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
+ lpData: Pointer): BOOL;
+
+const
+ VQV_FIXEDFILEINFO = '\';
+ VQV_VARFILEINFO_TRANSLATION = '\VarFileInfo\Translation';
+ VQV_STRINGFILEINFO = '\StringFileInfo';
+
+ VER_COMMENTS = 'Comments';
+ VER_INTERNALNAME = 'InternalName';
+ VER_PRODUCTNAME = 'ProductName';
+ VER_COMPANYNAME = 'CompanyName';
+ VER_LEGALCOPYRIGHT = 'LegalCopyright';
+ VER_PRODUCTVERSION = 'ProductVersion';
+ VER_FILEDESCRIPTION = 'FileDescription';
+ VER_LEGALTRADEMARKS = 'LegalTrademarks';
+ VER_PRIVATEBUILD = 'PrivateBuild';
+ VER_FILEVERSION = 'FileVersion';
+ VER_ORIGINALFILENAME = 'OriginalFilename';
+ VER_SPECIALBUILD = 'SpecialBuild';
+
+{TNT-WARN VerQueryValue}
+{TNT-WARN VerQueryValueA}
+{TNT-WARN VerQueryValueW}
+function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
+ var lplpBuffer: Pointer; var puLen: UINT): BOOL;
+
+type
+ TSHNameMappingHeaderA = record
+ cNumOfMappings: Cardinal;
+ lpNM: PSHNAMEMAPPINGA;
+ end;
+ PSHNameMappingHeaderA = ^TSHNameMappingHeaderA;
+
+ TSHNameMappingHeaderW = record
+ cNumOfMappings: Cardinal;
+ lpNM: PSHNAMEMAPPINGW;
+ end;
+ PSHNameMappingHeaderW = ^TSHNameMappingHeaderW;
+
+{TNT-WARN SHFileOperation}
+{TNT-WARN SHFileOperationA}
+{TNT-WARN SHFileOperationW} // <-- no stub on early Windows 95
+function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;
+
+{TNT-WARN SHFreeNameMappings}
+procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);
+
+{TNT-WARN SHBrowseForFolder}
+{TNT-WARN SHBrowseForFolderA}
+{TNT-WARN SHBrowseForFolderW} // <-- no stub on early Windows 95
+function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;
+
+{TNT-WARN SHGetPathFromIDList}
+{TNT-WARN SHGetPathFromIDListA}
+{TNT-WARN SHGetPathFromIDListW} // <-- no stub on early Windows 95
+function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;
+
+{TNT-WARN SHGetFileInfo}
+{TNT-WARN SHGetFileInfoA}
+{TNT-WARN SHGetFileInfoW} // <-- no stub on early Windows 95
+function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
+ var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;
+
+// ......... introduced .........
+function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
+
+function LANGIDFROMLCID(lcid: LCID): WORD;
+function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
+function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
+function PRIMARYLANGID(lgid: WORD): WORD;
+function SORTIDFROMLCID(lcid: LCID): WORD;
+function SUBLANGID(lgid: WORD): WORD;
+
+implementation
+
+uses
+ SysUtils, Math, TntSystem, TntSysUtils;
+
+function _PAnsiCharWithNil(const S: AnsiString): PAnsiChar;
+begin
+ if S = '' then
+ Result := nil {Win9x needs nil for some parameters instead of empty strings}
+ else
+ Result := PAnsiChar(S);
+end;
+
+function _PWideCharWithNil(const S: WideString): PWideChar;
+begin
+ if S = '' then
+ Result := nil {Win9x needs nil for some parameters instead of empty strings}
+ else
+ Result := PWideChar(S);
+end;
+
+function _WStr(lpString: PWideChar; cchCount: Integer): WideString;
+begin
+ if cchCount = -1 then
+ Result := lpString
+ else
+ Result := Copy(WideString(lpString), 1, cchCount);
+end;
+
+procedure _MakeWideWin32FindData(var WideFindData: TWIN32FindDataW; AnsiFindData: TWIN32FindDataA);
+begin
+ CopyMemory(@WideFindData, @AnsiFindData,
+ Integer(@WideFindData.cFileName) - Integer(@WideFindData));
+ StrPCopyW{TNT-ALLOW StrPCopyW}(WideFindData.cFileName, AnsiFindData.cFileName);
+ StrPCopyW{TNT-ALLOW StrPCopyW}(WideFindData.cAlternateFileName, AnsiFindData.cAlternateFileName);
+end;
+
+function Tnt_SetWindowTextW(hWnd: HWND; lpString: PWideChar): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := SetWindowTextW{TNT-ALLOW SetWindowTextW}(hWnd, lpString)
+ else
+ Result := SetWindowTextA{TNT-ALLOW SetWindowTextA}(hWnd, PAnsiChar(AnsiString(lpString)));
+end;
+
+//-----------------------------
+
+type
+ TPathLengthResultOption = (poAllowDirectoryMode, poZeroSmallBuff, poExactCopy, poExactCopySubPaths);
+ TPathLengthResultOptions = set of TPathLengthResultOption;
+
+procedure _ExactStrCopyW(pDest, pSource: PWideChar; Count: Integer);
+var
+ i: integer;
+begin
+ for i := 1 to Count do begin
+ pDest^ := pSource^;
+ Inc(PSource);
+ Inc(pDest);
+ end;
+end;
+
+procedure _ExactCopySubPaths(pDest, pSource: PWideChar; Count: Integer);
+var
+ i: integer;
+ OriginalSource: PWideChar;
+ PNextSlash: PWideChar;
+begin
+ if Count >= 4 then begin
+ OriginalSource := pSource;
+ PNextSlash := StrScanW(pSource, '\');
+ for i := 1 to Count - 1 do begin
+ // determine next path delimiter
+ if pSource > pNextSlash then begin
+ PNextSlash := StrScanW(pSource, '\');
+ end;
+ // leave if no more sub paths
+ if (PNextSlash = nil)
+ or ((pNextSlash - OriginalSource) >= Count) then begin
+ exit;
+ end;
+ // copy char
+ pDest^ := pSource^;
+ Inc(PSource);
+ Inc(pDest);
+ end;
+ end;
+end;
+
+function _HandlePathLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
+var
+ WideBuff: WideString;
+begin
+ WideBuff := AnsiBuff;
+ if nBufferLength > Cardinal(Length(WideBuff)) then begin
+ // normal
+ Result := Length(WideBuff);
+ StrLCopyW(lpBuffer, PWideChar(WideBuff), nBufferLength);
+ end else if (poExactCopy in Options) then begin
+ // exact
+ Result := nBufferLength;
+ _ExactStrCopyW(lpBuffer, PWideChar(WideBuff), nBufferLength);
+ end else begin
+ // other
+ if (poAllowDirectoryMode in Options)
+ and (nBufferLength = Cardinal(Length(WideBuff))) then begin
+ Result := Length(WideBuff) + 1;
+ StrLCopyW(lpBuffer, PWideChar(WideBuff), nBufferLength - 1);
+ end else begin
+ Result := Length(WideBuff) + 1;
+ if (nBufferLength > 0) then begin
+ if (poZeroSmallBuff in Options) then
+ lpBuffer^ := #0
+ else if (poExactCopySubPaths in Options) then
+ _ExactCopySubPaths(lpBuffer, PWideChar(WideBuff), nBufferLength);
+ end;
+ end;
+ end;
+end;
+
+function _HandleStringLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
+var
+ WideBuff: WideString;
+begin
+ WideBuff := AnsiBuff;
+ if nBufferLength >= Cardinal(Length(WideBuff)) then begin
+ // normal
+ Result := Length(WideBuff);
+ StrLCopyW(lpBuffer, PWideChar(WideBuff), nBufferLength);
+ end else if nBufferLength = 0 then
+ Result := Length(WideBuff)
+ else
+ Result := 0;
+end;
+
+//-------------------------------------------
+
+function Tnt_RemoveDirectoryW(lpPathName: PWideChar): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := RemoveDirectoryW{TNT-ALLOW RemoveDirectoryW}(PWideChar(lpPathName))
+ else
+ Result := RemoveDirectoryA{TNT-ALLOW RemoveDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
+end;
+
+function Tnt_GetShortPathNameW(lpszLongPath: PWideChar; lpszShortPath: PWideChar;
+ cchBuffer: DWORD): DWORD;
+var
+ AnsiBuff: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetShortPathNameW{TNT-ALLOW GetShortPathNameW}(lpszLongPath, lpszShortPath, cchBuffer)
+ else begin
+ SetLength(AnsiBuff, MAX_PATH * 2);
+ SetLength(AnsiBuff, GetShortPathNameA{TNT-ALLOW GetShortPathNameA}(PAnsiChar(AnsiString(lpszLongPath)),
+ PAnsiChar(AnsiBuff), Length(AnsiBuff)));
+ Result := _HandlePathLengthResult(cchBuffer, lpszShortPath, AnsiBuff, [poExactCopySubPaths]);
+ end;
+end;
+
+function Tnt_GetFullPathNameW(lpFileName: PWideChar; nBufferLength: DWORD;
+ lpBuffer: PWideChar; var lpFilePart: PWideChar): DWORD;
+var
+ AnsiBuff: AnsiString;
+ AnsiFilePart: PAnsiChar;
+ AnsiLeadingChars: Integer;
+ WideLeadingChars: Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetFullPathNameW{TNT-ALLOW GetFullPathNameW}(lpFileName, nBufferLength, lpBuffer, lpFilePart)
+ else begin
+ SetLength(AnsiBuff, MAX_PATH * 2);
+ SetLength(AnsiBuff, GetFullPathNameA{TNT-ALLOW GetFullPathNameA}(PAnsiChar(AnsiString(lpFileName)),
+ Length(AnsiBuff), PAnsiChar(AnsiBuff), AnsiFilePart));
+ Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poZeroSmallBuff]);
+ // deal w/ lpFilePart
+ if (AnsiFilePart = nil) or (nBufferLength < Result) then
+ lpFilePart := nil
+ else begin
+ AnsiLeadingChars := AnsiFilePart - PAnsiChar(AnsiBuff);
+ WideLeadingChars := Length(WideString(Copy(AnsiBuff, 1, AnsiLeadingChars)));
+ lpFilePart := lpBuffer + WideLeadingChars;
+ end;
+ end;
+end;
+
+function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
+ lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
+ hTemplateFile: THandle): THandle;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CreateFileW{TNT-ALLOW CreateFileW}(lpFileName, dwDesiredAccess, dwShareMode,
+ lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
+ else
+ Result := CreateFileA{TNT-ALLOW CreateFileA}(PAnsiChar(AnsiString(lpFileName)), dwDesiredAccess, dwShareMode,
+ lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
+end;
+
+function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
+var
+ Ansi_lpFindFileData: TWIN32FindDataA;
+begin
+ if Win32PlatformIsUnicode then
+ Result := FindFirstFileW{TNT-ALLOW FindFirstFileW}(lpFileName, lpFindFileData)
+ else begin
+ Result := FindFirstFileA{TNT-ALLOW FindFirstFileA}(PAnsiChar(AnsiString(lpFileName)),
+ Ansi_lpFindFileData);
+ if Result <> INVALID_HANDLE_VALUE then
+ _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
+ end;
+end;
+
+function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
+var
+ Ansi_lpFindFileData: TWIN32FindDataA;
+begin
+ if Win32PlatformIsUnicode then
+ Result := FindNextFileW{TNT-ALLOW FindNextFileW}(hFindFile, lpFindFileData)
+ else begin
+ Result := FindNextFileA{TNT-ALLOW FindNextFileA}(hFindFile, Ansi_lpFindFileData);
+ if Result then
+ _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
+ end;
+end;
+
+function Tnt_GetFileAttributesW(lpFileName: PWideChar): DWORD;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetFileAttributesW{TNT-ALLOW GetFileAttributesW}(lpFileName)
+ else
+ Result := GetFileAttributesA{TNT-ALLOW GetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)));
+end;
+
+function Tnt_SetFileAttributesW(lpFileName: PWideChar; dwFileAttributes: DWORD): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := SetFileAttributesW{TNT-ALLOW SetFileAttributesW}(lpFileName, dwFileAttributes)
+ else
+ Result := SetFileAttributesA{TNT-ALLOW SetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)), dwFileAttributes);
+end;
+
+function Tnt_CreateDirectoryW(lpPathName: PWideChar;
+ lpSecurityAttributes: PSecurityAttributes): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CreateDirectoryW{TNT-ALLOW CreateDirectoryW}(lpPathName, lpSecurityAttributes)
+ else
+ Result := CreateDirectoryA{TNT-ALLOW CreateDirectoryA}(PAnsiChar(AnsiString(lpPathName)), lpSecurityAttributes);
+end;
+
+function Tnt_MoveFileW(lpExistingFileName, lpNewFileName: PWideChar): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := MoveFileW{TNT-ALLOW MoveFileW}(lpExistingFileName, lpNewFileName)
+ else
+ Result := MoveFileA{TNT-ALLOW MoveFileA}(PAnsiChar(AnsiString(lpExistingFileName)), PAnsiChar(AnsiString(lpNewFileName)));
+end;
+
+function Tnt_CopyFileW(lpExistingFileName, lpNewFileName: PWideChar; bFailIfExists: BOOL): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CopyFileW{TNT-ALLOW CopyFileW}(lpExistingFileName, lpNewFileName, bFailIfExists)
+ else
+ Result := CopyFileA{TNT-ALLOW CopyFileA}(PAnsiChar(AnsiString(lpExistingFileName)),
+ PAnsiChar(AnsiString(lpNewFileName)), bFailIfExists);
+end;
+
+function Tnt_DeleteFileW(lpFileName: PWideChar): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := DeleteFileW{TNT-ALLOW DeleteFileW}(lpFileName)
+ else
+ Result := DeleteFileA{TNT-ALLOW DeleteFileA}(PAnsiChar(AnsiString(lpFileName)));
+end;
+
+function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
+ var lpRect: TRect; uFormat: UINT): Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := DrawTextW{TNT-ALLOW DrawTextW}(hDC, lpString, nCount, lpRect, uFormat)
+ else
+ Result := DrawTextA{TNT-ALLOW DrawTextA}(hDC,
+ PAnsiChar(AnsiString(_WStr(lpString, nCount))), -1, lpRect, uFormat);
+end;
+
+function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
+ lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetDiskFreeSpaceW{TNT-ALLOW GetDiskFreeSpaceW}(lpRootPathName,
+ lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
+ else
+ Result := GetDiskFreeSpaceA{TNT-ALLOW GetDiskFreeSpaceA}(PAnsiChar(AnsiString(lpRootPathName)),
+ lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
+end;
+
+function Tnt_GetModuleFileNameW(hModule: HINST; lpFilename: PWideChar; nSize: DWORD): DWORD;
+var
+ AnsiBuff: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetModuleFileNameW{TNT-ALLOW GetModuleFileNameW}(hModule, lpFilename, nSize)
+ else begin
+ SetLength(AnsiBuff, MAX_PATH);
+ SetLength(AnsiBuff, GetModuleFileNameA{TNT-ALLOW GetModuleFileNameA}(hModule, PAnsiChar(AnsiBuff), Length(AnsiBuff)));
+ Result := _HandlePathLengthResult(nSize, lpFilename, AnsiBuff, [poExactCopy]);
+ end;
+end;
+
+function Tnt_GetTempPathW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
+var
+ AnsiBuff: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetTempPathW{TNT-ALLOW GetTempPathW}(nBufferLength, lpBuffer)
+ else begin
+ SetLength(AnsiBuff, MAX_PATH);
+ SetLength(AnsiBuff, GetTempPathA{TNT-ALLOW GetTempPathA}(Length(AnsiBuff), PAnsiChar(AnsiBuff)));
+ Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poAllowDirectoryMode, poZeroSmallBuff]);
+ end;
+end;
+
+function Tnt_GetWindowsDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
+var
+ AnsiBuff: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetWindowsDirectoryW{TNT-ALLOW GetWindowsDirectoryW}(lpBuffer, uSize)
+ else begin
+ SetLength(AnsiBuff, MAX_PATH);
+ SetLength(AnsiBuff, GetWindowsDirectoryA{TNT-ALLOW GetWindowsDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
+ Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
+ end;
+end;
+
+function Tnt_GetSystemDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
+var
+ AnsiBuff: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetSystemDirectoryW{TNT-ALLOW GetSystemDirectoryW}(lpBuffer, uSize)
+ else begin
+ SetLength(AnsiBuff, MAX_PATH);
+ SetLength(AnsiBuff, GetSystemDirectoryA{TNT-ALLOW GetSystemDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
+ Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
+ end;
+end;
+
+function Tnt_SetCurrentDirectoryW(lpPathName: PWideChar): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := SetCurrentDirectoryW{TNT-ALLOW SetCurrentDirectoryW}(lpPathName)
+ else
+ Result := SetCurrentDirectoryA{TNT-ALLOW SetCurrentDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
+end;
+
+function Tnt_GetComputerNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
+var
+ AnsiBuff: AnsiString;
+ AnsiBuffLen: DWORD;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetComputerNameW{TNT-ALLOW GetComputerNameW}(lpBuffer, nSize)
+ else begin
+ SetLength(AnsiBuff, MAX_COMPUTERNAME_LENGTH + 1);
+ AnsiBuffLen := Length(AnsiBuff);
+ Result := GetComputerNameA{TNT-ALLOW GetComputerNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
+ if Result then begin
+ SetLength(AnsiBuff, AnsiBuffLen);
+ if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
+ nSize := AnsiBuffLen + 1;
+ Result := False;
+ end else begin
+ StrPLCopyW{TNT-ALLOW StrPLCopyW}(lpBuffer, AnsiBuff, nSize);
+ nSize := StrLenW(lpBuffer);
+ end;
+ end;
+ end;
+end;
+
+function Tnt_GetUserNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
+var
+ AnsiBuff: AnsiString;
+ AnsiBuffLen: DWORD;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetUserNameW{TNT-ALLOW GetUserNameW}(lpBuffer, nSize)
+ else begin
+ SetLength(AnsiBuff, 255);
+ AnsiBuffLen := Length(AnsiBuff);
+ Result := GetUserNameA{TNT-ALLOW GetUserNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
+ if Result then begin
+ SetLength(AnsiBuff, AnsiBuffLen);
+ if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
+ nSize := AnsiBuffLen + 1;
+ Result := False;
+ end else begin
+ StrPLCopyW{TNT-ALLOW StrPLCopyW}(lpBuffer, AnsiBuff, nSize);
+ nSize := StrLenW(lpBuffer);
+ end;
+ end;
+ end;
+end;
+
+function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
+ Directory: PWideChar; ShowCmd: Integer): HINST;
+begin
+ if Win32PlatformIsUnicode then
+ Result := ShellExecuteW{TNT-ALLOW ShellExecuteW}(hWnd, _PWideCharWithNil(WideString(Operation)),
+ FileName, Parameters,
+ Directory, ShowCmd)
+ else begin
+ Result := ShellExecuteA{TNT-ALLOW ShellExecuteA}(hWnd, _PAnsiCharWithNil(AnsiString(Operation)),
+ _PAnsiCharWithNil(AnsiString(FileName)), _PAnsiCharWithNil(AnsiString(Parameters)),
+ _PAnsiCharWithNil(AnsiString(Directory)), ShowCmd)
+ end;
+end;
+
+function Tnt_LoadLibraryW(lpLibFileName: PWideChar): HMODULE;
+begin
+ if Win32PlatformIsUnicode then
+ Result := LoadLibraryW{TNT-ALLOW LoadLibraryW}(lpLibFileName)
+ else
+ Result := LoadLibraryA{TNT-ALLOW LoadLibraryA}(PAnsiChar(AnsiString(lpLibFileName)));
+end;
+
+function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
+begin
+ if Win32PlatformIsUnicode then
+ Result := LoadLibraryExW{TNT-ALLOW LoadLibraryExW}(lpLibFileName, hFile, dwFlags)
+ else
+ Result := LoadLibraryExA{TNT-ALLOW LoadLibraryExA}(PAnsiChar(AnsiString(lpLibFileName)), hFile, dwFlags);
+end;
+
+function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
+ lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
+ bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
+ lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
+ var lpProcessInformation: TProcessInformation): BOOL;
+var
+ AnsiStartupInfo: TStartupInfoA;
+begin
+ if Win32PlatformIsUnicode then begin
+ Result := CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName, lpCommandLine,
+ lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
+ lpCurrentDirectory, lpStartupInfo, lpProcessInformation)
+ end else begin
+ CopyMemory(@AnsiStartupInfo, @lpStartupInfo, SizeOf(TStartupInfo));
+ AnsiStartupInfo.lpReserved := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpReserved));
+ AnsiStartupInfo.lpDesktop := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpDesktop));
+ AnsiStartupInfo.lpTitle := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpTitle));
+ Result := CreateProcessA{TNT-ALLOW CreateProcessA}(_PAnsiCharWithNil(AnsiString(lpApplicationName)),
+ _PAnsiCharWithNil(AnsiString(lpCommandLine)),
+ lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
+ _PAnsiCharWithNil(AnsiString(lpCurrentDirectory)), AnsiStartupInfo, lpProcessInformation);
+ end;
+end;
+
+function Tnt_GetCurrencyFormatW(Locale: LCID; dwFlags: DWORD; lpValue: PWideChar;
+ lpFormat: PCurrencyFmtW; lpCurrencyStr: PWideChar; cchCurrency: Integer): Integer;
+const
+ MAX_ANSI_BUFF_SIZE = 64; // can a currency string actually be larger?
+var
+ AnsiFormat: TCurrencyFmtA;
+ PAnsiFormat: PCurrencyFmtA;
+ AnsiBuff: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue, lpFormat, lpCurrencyStr, cchCurrency)
+ else begin
+ if lpFormat = nil then
+ PAnsiFormat := nil
+ else begin
+ ZeroMemory(@AnsiFormat, SizeOf(AnsiFormat));
+ AnsiFormat.NumDigits := lpFormat.NumDigits;
+ AnsiFormat.LeadingZero := lpFormat.LeadingZero;
+ AnsiFormat.Grouping := lpFormat.Grouping;
+ AnsiFormat.lpDecimalSep := PAnsiChar(AnsiString(lpFormat.lpDecimalSep));
+ AnsiFormat.lpThousandSep := PAnsiChar(AnsiString(lpFormat.lpThousandSep));
+ AnsiFormat.NegativeOrder := lpFormat.NegativeOrder;
+ AnsiFormat.PositiveOrder := lpFormat.PositiveOrder;
+ AnsiFormat.lpCurrencySymbol := PAnsiChar(AnsiString(lpFormat.lpCurrencySymbol));
+ PAnsiFormat := @AnsiFormat;
+ end;
+ SetLength(AnsiBuff, MAX_ANSI_BUFF_SIZE);
+ SetLength(AnsiBuff, GetCurrencyFormatA{TNT-ALLOW GetCurrencyFormatA}(Locale, dwFlags,
+ PAnsiChar(AnsiString(lpValue)), PAnsiFormat, PAnsiChar(AnsiBuff), MAX_ANSI_BUFF_SIZE));
+ Result := _HandleStringLengthResult(cchCurrency, lpCurrencyStr, AnsiBuff, []);
+ end;
+end;
+
+function Tnt_CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
+ cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer;
+var
+ WideStr1, WideStr2: WideString;
+ AnsiStr1, AnsiStr2: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CompareStringW{TNT-ALLOW CompareStringW}(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2)
+ else begin
+ WideStr1 := _WStr(lpString1, cchCount1);
+ WideStr2 := _WStr(lpString2, cchCount2);
+ if (dwCmpFlags = 0) then begin
+ // binary comparison
+ if WideStr1 < WideStr2 then
+ Result := 1
+ else if WideStr1 = WideStr2 then
+ Result := 2
+ else
+ Result := 3;
+ end else begin
+ AnsiStr1 := WideStr1;
+ AnsiStr2 := WideStr2;
+ Result := CompareStringA{TNT-ALLOW CompareStringA}(Locale, dwCmpFlags,
+ PAnsiChar(AnsiStr1), -1, PAnsiChar(AnsiStr2), -1);
+ end;
+ end;
+end;
+
+function Tnt_CharUpperW(lpsz: PWideChar): PWideChar;
+var
+ AStr: AnsiString;
+ WStr: WideString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CharUpperW{TNT-ALLOW CharUpperW}(lpsz)
+ else begin
+ if HiWord(Cardinal(lpsz)) = 0 then begin
+ // literal char mode
+ Result := lpsz;
+ if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
+ AStr := WideChar(lpsz); // single character may be more than one byte
+ CharUpperA{TNT-ALLOW CharUpperA}(PAnsiChar(AStr));
+ WStr := AStr; // should always be single wide char
+ if Length(WStr) = 1 then
+ Result := PWideChar(WStr[1]);
+ end
+ end else begin
+ // null-terminated string mode
+ Result := lpsz;
+ while lpsz^ <> #0 do begin
+ lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
+ Inc(lpsz);
+ end;
+ end;
+ end;
+end;
+
+function Tnt_CharUpperBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
+var
+ i: integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CharUpperBuffW{TNT-ALLOW CharUpperBuffW}(lpsz, cchLength)
+ else begin
+ Result := cchLength;
+ for i := 1 to cchLength do begin
+ lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
+ Inc(lpsz);
+ end;
+ end;
+end;
+
+function Tnt_CharLowerW(lpsz: PWideChar): PWideChar;
+var
+ AStr: AnsiString;
+ WStr: WideString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CharLowerW{TNT-ALLOW CharLowerW}(lpsz)
+ else begin
+ if HiWord(Cardinal(lpsz)) = 0 then begin
+ // literal char mode
+ Result := lpsz;
+ if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
+ AStr := WideChar(lpsz); // single character may be more than one byte
+ CharLowerA{TNT-ALLOW CharLowerA}(PAnsiChar(AStr));
+ WStr := AStr; // should always be single wide char
+ if Length(WStr) = 1 then
+ Result := PWideChar(WStr[1]);
+ end
+ end else begin
+ // null-terminated string mode
+ Result := lpsz;
+ while lpsz^ <> #0 do begin
+ lpsz^ := WideChar(Tnt_CharLowerW(PWideChar(lpsz^)));
+ Inc(lpsz);
+ end;
+ end;
+ end;
+end;
+
+function Tnt_CharLowerBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
+var
+ i: integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := CharLowerBuffW{TNT-ALLOW CharLowerBuffW}(lpsz, cchLength)
+ else begin
+ Result := cchLength;
+ for i := 1 to cchLength do begin
+ lpsz^ := WideChar(Tnt_CharLowerW(PWideChar(lpsz^)));
+ Inc(lpsz);
+ end;
+ end;
+end;
+
+function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
+ lpSrcStr: PWideChar; cchSrc: Integer; var lpCharType): BOOL;
+var
+ AStr: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetStringTypeExW{TNT-ALLOW GetStringTypeExW}(Locale, dwInfoType, lpSrcStr, cchSrc, lpCharType)
+ else begin
+ AStr := _WStr(lpSrcStr, cchSrc);
+ Result := GetStringTypeExA{TNT-ALLOW GetStringTypeExA}(Locale, dwInfoType,
+ PAnsiChar(AStr), -1, lpCharType);
+ end;
+end;
+
+function Win9x_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
+// This function originated by the WINE Project.
+// It was translated to Pascal by Francisco Leong.
+// It was further modified by Troy Wolbrink.
+var
+ hmem: HGLOBAL;
+ hrsrc: THandle;
+ p: PWideChar;
+ string_num, i: Integer;
+ block: Integer;
+begin
+ Result := 0;
+ // Netscape v3 fix...
+ if (HIWORD(uID) = $FFFF) then begin
+ uID := UINT(-(Integer(uID)));
+ end;
+ // figure block, string_num
+ block := ((uID shr 4) and $FFFF) + 1; // bits 4 - 19, mask out bits 20 - 31, inc by 1
+ string_num := uID and $000F;
+ // get handle & pointer to string block
+ hrsrc := FindResource{TNT-ALLOW FindResource}(hInstance, MAKEINTRESOURCE(block), RT_STRING);
+ if (hrsrc <> 0) then
+ begin
+ hmem := LoadResource(hInstance, hrsrc);
+ if (hmem <> 0) then
+ begin
+ p := LockResource(hmem);
+ // walk the block to the requested string
+ for i := 0 to string_num - 1 do begin
+ p := p + Integer(p^) + 1;
+ end;
+ Result := Integer(p^); { p points to the length of string }
+ Inc(p); { p now points to the actual string }
+ if (lpBuffer <> nil) and (nBufferMax > 0) then
+ begin
+ Result := min(nBufferMax - 1, Result); { max length to copy }
+ if (Result > 0) then begin
+ CopyMemory(lpBuffer, p, Result * sizeof(WideChar));
+ end;
+ lpBuffer[Result] := WideChar(0); { null terminate }
+ end;
+ end;
+ end;
+end;
+
+function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := Windows.LoadStringW{TNT-ALLOW LoadStringW}(hInstance, uID, lpBuffer, nBufferMax)
+ else
+ Result := Win9x_LoadStringW(hInstance, uID, lpBuffer, nBufferMax);
+end;
+
+function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: TMenuItemInfoW): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition, lpmii)
+ else begin
+ TMenuItemInfoA(lpmii).dwTypeData := PAnsiChar(AnsiString(lpmii.dwTypeData));
+ Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition, TMenuItemInfoA(lpmii));
+ end;
+end;
+
+function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
+ var lpiIcon: Word): HICON;
+begin
+ if Win32PlatformIsUnicode then
+ Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst, lpIconPath, lpiIcon)
+ else
+ Result := ExtractAssociatedIconA{TNT-ALLOW ExtractAssociatedIconA}(hInst,
+ PAnsiChar(AnsiString(lpIconPath)), lpiIcon)
+end;
+
+function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetFileVersionInfoSizeW{TNT-ALLOW GetFileVersionInfoSizeW}(lptstrFilename, lpdwHandle)
+ else
+ Result := GetFileVersionInfoSizeA{TNT-ALLOW GetFileVersionInfoSizeA}(PAnsiChar(AnsiString(lptstrFilename)), lpdwHandle);
+end;
+
+function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
+ lpData: Pointer): BOOL;
+begin
+ if Win32PlatformIsUnicode then
+ Result := GetFileVersionInfoW{TNT-ALLOW GetFileVersionInfoW}(lptstrFilename, dwHandle, dwLen, lpData)
+ else
+ Result := GetFileVersionInfoA{TNT-ALLOW GetFileVersionInfoA}(PAnsiChar(AnsiString(lptstrFilename)), dwHandle, dwLen, lpData);
+end;
+
+var
+ Last_VerQueryValue_String: WideString;
+
+function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
+ var lplpBuffer: Pointer; var puLen: UINT): BOOL;
+var
+ AnsiBuff: AnsiString;
+begin
+ if Win32PlatformIsUnicode then
+ Result := VerQueryValueW{TNT-ALLOW VerQueryValueW}(pBlock, lpSubBlock, lplpBuffer, puLen)
+ else begin
+ Result := VerQueryValueA{TNT-ALLOW VerQueryValueA}(pBlock, PAnsiChar(AnsiString(lpSubBlock)), lplpBuffer, puLen);
+ if WideTextPos(VQV_STRINGFILEINFO, lpSubBlock) <> 1 then
+ else begin
+ { /StringFileInfo, convert ansi result to unicode }
+ SetString(AnsiBuff, PAnsiChar(lplpBuffer), puLen);
+ Last_VerQueryValue_String := AnsiBuff;
+ lplpBuffer := PWideChar(Last_VerQueryValue_String);
+ puLen := Length(Last_VerQueryValue_String);
+ end;
+ end;
+end;
+
+//---------------------------------------------------------------------------------------
+// Wide functions from Shell32.dll should be loaded dynamically (no stub on early Win95)
+//---------------------------------------------------------------------------------------
+
+type
+ TSHFileOperationW = function(var lpFileOp: TSHFileOpStructW): Integer; stdcall;
+ TSHBrowseForFolderW = function(var lpbi: TBrowseInfoW): PItemIDList; stdcall;
+ TSHGetPathFromIDListW = function(pidl: PItemIDList; pszPath: PWideChar): BOOL; stdcall;
+ TSHGetFileInfoW = function(pszPath: PWideChar; dwFileAttributes: DWORD;
+ var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD; stdcall;
+
+var
+ Safe_SHFileOperationW: TSHFileOperationW = nil;
+ Safe_SHBrowseForFolderW: TSHBrowseForFolderW = nil;
+ Safe_SHGetPathFromIDListW: TSHGetPathFromIDListW = nil;
+ Safe_SHGetFileInfoW: TSHGetFileInfoW = nil;
+
+var Shell32DLL: HModule = 0;
+
+procedure LoadWideShell32Procs;
+begin
+ if Shell32DLL = 0 then begin
+ Shell32DLL := WinCheckH(Tnt_LoadLibraryW('shell32.dll'));
+ Safe_SHFileOperationW := WinCheckP(GetProcAddress(Shell32DLL, 'SHFileOperationW'));
+ Safe_SHBrowseForFolderW := WinCheckP(GetProcAddress(Shell32DLL, 'SHBrowseForFolderW'));
+ Safe_SHGetPathFromIDListW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetPathFromIDListW'));
+ Safe_SHGetFileInfoW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetFileInfoW'));
+ end;
+end;
+
+function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;
+var
+ AnsiFileOp: TSHFileOpStructA;
+ MapCount: Integer;
+ PAnsiMap: PSHNameMappingA;
+ PWideMap: PSHNameMappingW;
+ OldPath: WideString;
+ NewPath: WideString;
+ i: integer;
+begin
+ if Win32PlatformIsUnicode then begin
+ LoadWideShell32Procs;
+ Result := Safe_SHFileOperationW(lpFileOp);
+ end else begin
+ AnsiFileOp := TSHFileOpStructA(lpFileOp);
+ // convert PChar -> PWideChar
+ if lpFileOp.pFrom = nil then
+ AnsiFileOp.pFrom := nil
+ else
+ AnsiFileOp.pFrom := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pFrom)));
+ if lpFileOp.pTo = nil then
+ AnsiFileOp.pTo := nil
+ else
+ AnsiFileOp.pTo := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pTo)));
+ AnsiFileOp.lpszProgressTitle := PAnsiChar(AnsiString(lpFileOp.lpszProgressTitle));
+ Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}(AnsiFileOp);
+ // return struct results
+ lpFileOp.fAnyOperationsAborted := AnsiFileOp.fAnyOperationsAborted;
+ lpFileOp.hNameMappings := nil;
+ if (AnsiFileOp.hNameMappings <> nil)
+ and ((FOF_WANTMAPPINGHANDLE and AnsiFileOp.fFlags) <> 0) then begin
+ // alloc mem
+ MapCount := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).cNumOfMappings;
+ lpFileOp.hNameMappings :=
+ AllocMem(SizeOf({hNameMappings}Cardinal) + SizeOf(TSHNameMappingW) * MapCount);
+ PSHNameMappingHeaderW(lpFileOp.hNameMappings).cNumOfMappings := MapCount;
+ // init pointers
+ PAnsiMap := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).lpNM;
+ PWideMap := PSHNameMappingHeaderW(lpFileOp.hNameMappings).lpNM;
+ for i := 1 to MapCount do begin
+ // old path
+ OldPath := Copy(PAnsiMap.pszOldPath, 1, PAnsiMap.cchOldPath);
+ PWideMap.pszOldPath := StrNewW(PWideChar(OldPath));
+ PWideMap.cchOldPath := StrLenW(PWideMap.pszOldPath);
+ // new path
+ NewPath := Copy(PAnsiMap.pszNewPath, 1, PAnsiMap.cchNewPath);
+ PWideMap.pszNewPath := StrNewW(PWideChar(NewPath));
+ PWideMap.cchNewPath := StrLenW(PWideMap.pszNewPath);
+ // next record
+ Inc(PAnsiMap);
+ Inc(PWideMap);
+ end;
+ end;
+ end;
+end;
+
+procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);
+var
+ i: integer;
+ MapCount: Integer;
+ PWideMap: PSHNameMappingW;
+begin
+ if Win32PlatformIsUnicode then
+ SHFreeNameMappings{TNT-ALLOW SHFreeNameMappings}(hNameMappings)
+ else begin
+ // free strings
+ MapCount := PSHNameMappingHeaderW(hNameMappings).cNumOfMappings;
+ PWideMap := PSHNameMappingHeaderW(hNameMappings).lpNM;
+ for i := 1 to MapCount do begin
+ StrDisposeW(PWideMap.pszOldPath);
+ StrDisposeW(PWideMap.pszNewPath);
+ Inc(PWideMap);
+ end;
+ // free struct
+ FreeMem(Pointer(hNameMappings));
+ end;
+end;
+
+function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;
+var
+ AnsiInfo: TBrowseInfoA;
+ AnsiBuffer: array[0..MAX_PATH] of AnsiChar;
+begin
+ if Win32PlatformIsUnicode then begin
+ LoadWideShell32Procs;
+ Result := Safe_SHBrowseForFolderW(lpbi);
+ end else begin
+ AnsiInfo := TBrowseInfoA(lpbi);
+ AnsiInfo.lpszTitle := PAnsiChar(AnsiString(lpbi.lpszTitle));
+ if lpbi.pszDisplayName <> nil then
+ AnsiInfo.pszDisplayName := AnsiBuffer;
+ Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}(AnsiInfo);
+ if lpbi.pszDisplayName <> nil then
+ StrPCopyW{TNT-ALLOW StrPCopyW}(lpbi.pszDisplayName, AnsiInfo.pszDisplayName);
+ lpbi.iImage := AnsiInfo.iImage;
+ end;
+end;
+
+function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;
+var
+ AnsiPath: AnsiString;
+begin
+ if Win32PlatformIsUnicode then begin
+ LoadWideShell32Procs;
+ Result := Safe_SHGetPathFromIDListW(pidl, pszPath);
+ end else begin
+ SetLength(AnsiPath, MAX_PATH);
+ Result := SHGetPathFromIDListA{TNT-ALLOW SHGetPathFromIDListA}(pidl, PAnsiChar(AnsiPath));
+ if Result then
+ StrPCopyW{TNT-ALLOW StrPCopyW}(pszPath, PAnsiChar(AnsiPath))
+ end;
+end;
+
+function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
+ var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;
+var
+ SHFileInfoA: TSHFileInfoA;
+begin
+ if Win32PlatformIsUnicode then begin
+ LoadWideShell32Procs;
+ Result := Safe_SHGetFileInfoW(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags)
+ end else begin
+ Result := SHGetFileInfoA{TNT-ALLOW SHGetFileInfoA}(PAnsiChar(AnsiString(pszPath)),
+ dwFileAttributes, SHFileInfoA, SizeOf(TSHFileInfoA), uFlags);
+ // update pfsi...
+ ZeroMemory(@psfi, SizeOf(TSHFileInfoW));
+ psfi.hIcon := SHFileInfoA.hIcon;
+ psfi.iIcon := SHFileInfoA.iIcon;
+ psfi.dwAttributes := SHFileInfoA.dwAttributes;
+ StrPLCopyW{TNT-ALLOW StrPLCopyW}(psfi.szDisplayName, SHFileInfoA.szDisplayName, MAX_PATH);
+ StrPLCopyW{TNT-ALLOW StrPLCopyW}(psfi.szTypeName, SHFileInfoA.szTypeName, 80);
+ end;
+end;
+
+
+function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
+begin
+ Result := HiWord(Cardinal(ResStr)) = 0;
+end;
+
+function LANGIDFROMLCID(lcid: LCID): WORD;
+begin
+ Result := LoWord(lcid);
+end;
+
+function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
+begin
+ Result := (usSubLanguage shl 10) or usPrimaryLanguage;
+end;
+
+function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
+begin
+ Result := MakeLong(wLanguageID, wSortID);
+end;
+
+function PRIMARYLANGID(lgid: WORD): WORD;
+begin
+ Result := lgid and $03FF;
+end;
+
+function SORTIDFROMLCID(lcid: LCID): WORD;
+begin
+ Result := HiWord(lcid);
+end;
+
+function SUBLANGID(lgid: WORD): WORD;
+begin
+ Result := lgid shr 10;
+end;
+
+initialization
+
+finalization
+ if Shell32DLL <> 0 then
+ FreeLibrary(Shell32DLL);
+
+end.
Modified: trunk/stage/layout.conf
===================================================================
--- trunk/stage/layout.conf 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/stage/layout.conf 2006-07-31 03:46:13 UTC (rev 435)
@@ -12,14 +12,14 @@
LastParaMod01=
LastParaMod02=
LastParaMod03=
-LastTextModule=ESV
-LastVerse=마태복음 19:11
+LastTextModule=NASB
+LastVerse=마태복음 19:25
LookupSaveCount=5
+LookupText=마태복음 19:11
LookupText=마태복음 19:9
LookupText=마태복음 19:5
LookupText=Matthäus 19:3
LookupText=Matthew 19:1
-LookupText=Matthew 19:27
SearchSaveCount=5
SearchText=God love +world
SearchText=God love world
Modified: trunk/sword.bpr
===================================================================
--- trunk/sword.bpr 2006-07-31 00:29:57 UTC (rev 434)
+++ trunk/sword.bpr 2006-07-31 03:46:13 UTC (rev 435)
@@ -43,7 +43,7 @@
<DEBUGLIBPATH value="$(BCB)\lib\debug"/>
<RELEASELIBPATH value="$(BCB)\lib\release"/>
<LINKER value="ilink32"/>
- <USERDEFINES value="_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_CL_DISABLE_MULTITHREADING;_DEBUG"/>
+ <USERDEFINES value="_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_CL_DISABLE_MULTITHREADING"/>
<SYSDEFINES value="NO_STRICT"/>
<MAINSOURCE value="sword.cpp"/>
<INCLUDEPATH value="..\sword\src\modules\filters;D:\;TntUnicodeControls;..\icu-sword\source\common;..\icu-sword\source\i18n;..\sword\include;$(BCB)\include;$(BCB)\include\vcl;rxlib"/>
@@ -57,11 +57,11 @@
-I$(BCB)\include -I$(BCB)\include\vcl -Irxlib -src_suffix cpp -D_ICU_
-D_ICUSWORD_ -DUSBINARY -DU_HAVE_PLACEMENT_NEW=0 -DUSELUCENE
-D_CL_DISABLE_MULTITHREADING"/>
- <CFLAG1 value="-Od -Vx -X- -r- -a8 -4 -b- -k -y -v -vi- -c -tW -tWM"/>
- <PFLAGS value="-N2obj -N0obj -$Y+ -$W -$O- -v -M -JPHNE"/>
+ <CFLAG1 value="-O2 -Vx -X- -a8 -4 -b- -k- -vi -c -tW -tWM"/>
+ <PFLAGS value="-N2obj -N0obj -$Y- -$L- -$D- -v -M -JPHNE"/>
<RFLAGS value=""/>
- <AFLAGS value="/mx /w2 /zi"/>
- <LFLAGS value="-Iobj -D"" -aa -Tpe -GD -s -Gn -v"/>
+ <AFLAGS value="/mx /w2 /zn"/>
+ <LFLAGS value="-Iobj -D"" -aa -Tpe -GD -s -Gn"/>
</OPTIONS>
<LINKER>
<ALLOBJ value="c0w32.obj $(OBJFILES)"/>
@@ -75,7 +75,7 @@
MajorVer=1
MinorVer=5
Release=8
-Build=11
+Build=12
Debug=0
PreRelease=0
Special=0
@@ -87,7 +87,7 @@
[Version Info Keys]
CompanyName=CrossWire Software & Bible Society
FileDescription=Windows 32bit User Interface to The SWORD Project
-FileVersion=1.5.8.11
+FileVersion=1.5.8.12
InternalName=biblecs
LegalCopyright=(c) 1990-2005 CrossWire Bible Society under the terms of the GNU General Public License
LegalTrademarks=
@@ -141,8 +141,8 @@
[HistoryLists\hlConditionals]
Count=16
-Item0=_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_CL_DISABLE_MULTITHREADING;_DEBUG
-Item1=_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_CL_DISABLE_MULTITHREADING
+Item0=_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_CL_DISABLE_MULTITHREADING
+Item1=_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_CL_DISABLE_MULTITHREADING;_DEBUG
Item2=_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE
Item3=_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_DEBUG
Item4=_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;_DEBUG;USELUCENE
Modified: trunk/sword.res
===================================================================
(Binary files differ)
More information about the sword-cvs
mailing list