[sword-svn] r434 - in trunk: . TntUnicodeControls TntUnicodeControls/BCB5 TntUnicodeControls/BCB6 TntUnicodeControls/Design stage
scribe at crosswire.org
scribe at crosswire.org
Sun Jul 30 17:30:11 MST 2006
Author: scribe
Date: 2006-07-30 17:29:57 -0700 (Sun, 30 Jul 2006)
New Revision: 434
Modified:
trunk/AboutBoxfrm.dfm
trunk/PrintFrm.cpp
trunk/RxRichEditX.cpp
trunk/TntUnicodeControls/ActiveIMM_TLB.pas
trunk/TntUnicodeControls/BCB5/TntLibD.bpk
trunk/TntUnicodeControls/BCB5/TntLibD.cpp
trunk/TntUnicodeControls/BCB5/TntLibR.bpk
trunk/TntUnicodeControls/BCB5/TntLibR.cpp
trunk/TntUnicodeControls/BCB5/readme.txt
trunk/TntUnicodeControls/BCB6/TntLibD.bpk
trunk/TntUnicodeControls/BCB6/TntLibR.bpk
trunk/TntUnicodeControls/BCB6/TntLibR.cpp
trunk/TntUnicodeControls/BCB6/TntLibR.res
trunk/TntUnicodeControls/Design/TntComCtrls.dcr
trunk/TntUnicodeControls/Design/TntComCtrls_Design.pas
trunk/TntUnicodeControls/Design/TntDesignEditors_Design.pas
trunk/TntUnicodeControls/Design/TntExtCtrls.dcr
trunk/TntUnicodeControls/Design/TntForms_Design.pas
trunk/TntUnicodeControls/Design/TntMenus_Design.pas
trunk/TntUnicodeControls/Design/TntStrEdit_Design.dfm
trunk/TntUnicodeControls/Design/TntStrEdit_Design.pas
trunk/TntUnicodeControls/Design/TntUnicodeVcl_Register.pas
trunk/TntUnicodeControls/Readme.txt
trunk/TntUnicodeControls/TntActnList.pas
trunk/TntUnicodeControls/TntButtons.pas
trunk/TntUnicodeControls/TntCheckLst.pas
trunk/TntUnicodeControls/TntClasses.pas
trunk/TntUnicodeControls/TntComCtrls.pas
trunk/TntUnicodeControls/TntControls.pas
trunk/TntUnicodeControls/TntExtActns.pas
trunk/TntUnicodeControls/TntExtCtrls.pas
trunk/TntUnicodeControls/TntForms.pas
trunk/TntUnicodeControls/TntGraphics.pas
trunk/TntUnicodeControls/TntGrids.pas
trunk/TntUnicodeControls/TntListActns.pas
trunk/TntUnicodeControls/TntMenus.pas
trunk/TntUnicodeControls/TntStdActns.pas
trunk/TntUnicodeControls/TntStdCtrls.pas
trunk/TntUnicodeControls/TntThemeMgr.pas
trunk/TntUnicodeControls/Unicode.pas
trunk/mainfrm.cpp
trunk/mainfrm.h
trunk/searchfrm.cpp
trunk/stage/layout.conf
trunk/stage/options.conf
trunk/sword.bpr
trunk/sword.res
trunk/vrslstfrm.cpp
Log:
Updated to latest version of Tnt Unicode controls that work with BCB5
Modified: trunk/AboutBoxfrm.dfm
===================================================================
(Binary files differ)
Modified: trunk/PrintFrm.cpp
===================================================================
--- trunk/PrintFrm.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/PrintFrm.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -3,6 +3,7 @@
#include <vcl.h>
#pragma hdrstop
+#include "TntSystem.hpp"
#include "PrintFrm.h"
#include "mainfrm.h"
#include <Printers.hpp>
Modified: trunk/RxRichEditX.cpp
===================================================================
--- trunk/RxRichEditX.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/RxRichEditX.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -3,6 +3,7 @@
#include <vcl.h>
#pragma hdrstop
+#include "TntSystem.hpp"
#include "RxRichEditX.h"
#include "PrintFrm.h"
#include <clipbrd.hpp>
Modified: trunk/TntUnicodeControls/ActiveIMM_TLB.pas
===================================================================
--- trunk/TntUnicodeControls/ActiveIMM_TLB.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/ActiveIMM_TLB.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,5 +1,20 @@
+
+{*****************************************************************************}
+{ }
+{ 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 ActiveIMM_TLB;
+{$INCLUDE TntCompilers.inc}
+
+{TNT-IGNORE-UNIT}
+
// ************************************************************************ //
// WARNING
// -------
@@ -11,7 +26,7 @@
// manual modifications will be lost.
// ************************************************************************ //
-// PASTLWTR : $Revision: 1.2 $
+// PASTLWTR : $Revision: 1.88.1.0.1.0 $
// File generated on 04/03/2001 11:32:13 PM from Type Library described below.
// *************************************************************************//
@@ -38,7 +53,8 @@
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface
-uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
+uses
+ Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
@@ -613,7 +629,7 @@
function ReSizeIMCC(hIMCC: LongWord; dwSize: LongWord; out phIMCC: LongWord): HResult; stdcall;
function GetIMCCSize(hIMCC: LongWord; out pdwSize: LongWord): HResult; stdcall;
function GetIMCCLockCount(hIMCC: LongWord; out pdwLockCount: LongWord): HResult; stdcall;
- function GetHotKey{TNT-ALLOW GetHotKey}(dwHotKeyID: LongWord; out puModifiers: SYSUINT; out puVKey: SYSUINT;
+ function GetHotKey(dwHotKeyID: LongWord; out puModifiers: SYSUINT; out puVKey: SYSUINT;
out phKL: Pointer): HResult; stdcall;
function SetHotKey(dwHotKeyID: LongWord; uModifiers: SYSUINT; uVKey: SYSUINT; var hKL: Pointer): HResult; stdcall;
function CreateSoftKeyboard(uType: SYSUINT; var hOwner: _RemotableHandle; x: SYSINT;
@@ -868,7 +884,8 @@
implementation
-uses ComObj;
+uses
+ ComObj;
class function CoCActiveIMM.Create: IActiveIMMApp;
begin
@@ -1355,4 +1372,3 @@
{$ENDIF}
end.
-
Modified: trunk/TntUnicodeControls/BCB5/TntLibD.bpk
===================================================================
--- trunk/TntUnicodeControls/BCB5/TntLibD.bpk 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB5/TntLibD.bpk 2006-07-31 00:29:57 UTC (rev 434)
@@ -4,18 +4,24 @@
<MACROS>
<VERSION value="BCB.05.03"/>
<PROJECT value=".\TntLibD.bpl"/>
- <OBJFILES value="..\TntComCtrls_Design.obj ..\TntDesignEditors_Design.obj
- ..\TntForms_Design.obj ..\TntMenus_Design.obj ..\TntStrEdit_Design.obj
- ..\TntUnicodeVcl_Register.obj TntLibD.obj"/>
- <RESFILES value="TntLibD.res"/>
+ <OBJFILES value="..\Design\TntComCtrls_Design.obj ..\Design\TntDesignEditors_Design.obj
+ ..\Design\TntForms_Design.obj ..\Design\TntMenus_Design.obj
+ ..\Design\TntStrEdit_Design.obj ..\Design\TntDBGrids_Design.obj
+ ..\Design\TntUnicodeVcl_Register.obj TntLibD.obj"/>
+ <RESFILES value="TntLibD.res ..\Design\TntActnlist.dcr ..\Design\TntButtons.dcr
+ ..\Design\TntComCtrls.dcr ..\Design\TntDBCtrls.dcr
+ ..\Design\TntExtCtrls.dcr ..\Design\TntGrids.dcr ..\Design\TntMenus.dcr
+ ..\Design\TntForms.dcr ..\Design\TntStdCtrls.dcr ..\Design\TntDialogs.dcr
+ ..\Design\TntExtDlgs.dcr"/>
<DEFFILE value=""/>
- <RESDEPEN value="$(RESFILES) ..\TntStrEdit_Design.dfm"/>
+ <RESDEPEN value="$(RESFILES) ..\Design\TntStrEdit_Design.dfm"/>
<LIBFILES value=""/>
<LIBRARIES value=""/>
- <SPARELIBS value="Vcl50.lib"/>
- <PACKAGES value="vcl50.bpi TntLibR.bpi dsnide50.bpi"/>
+ <SPARELIBS value="Vcl50.lib dclstd50.lib"/>
+ <PACKAGES value="vcl50.bpi TntLibR.bpi dsnide50.bpi vcldb50.bpi dcldb50.bpi dclstd50.bpi
+ vclx50.bpi"/>
<PATHCPP value=".;"/>
- <PATHPAS value=".;.."/>
+ <PATHPAS value=".;..\Design"/>
<PATHRC value=".;"/>
<PATHASM value=".;"/>
<DEBUGLIBPATH value="$(BCB)\lib\debug"/>
@@ -24,18 +30,18 @@
<USERDEFINES value="_DEBUG"/>
<SYSDEFINES value="_RTLDLL;NO_STRICT;USEPACKAGES"/>
<MAINSOURCE value="TntLibD.cpp"/>
- <INCLUDEPATH value="..\;..;$(BCB)\include;$(BCB)\include\vcl"/>
- <LIBPATH value=";;;..\;..;$(BCB)\lib\obj;$(BCB)\lib"/>
+ <INCLUDEPATH value="..\Design;..;$(BCB)\include;$(BCB)\include\vcl"/>
+ <LIBPATH value="$(BCB)\Projects\Lib;..\Design;..;$(BCB)\lib\obj;$(BCB)\lib"/>
<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 -LUVCL50 -LUDSNIDE50"/>
+ <PFLAGS value="-$YD -$W -$O- -v -JPHNE -M -LUVCL50 -LUDSNIDE50 -LUVCLDB50"/>
<RFLAGS value=""/>
- <AFLAGS value="/mx /w2 /zd"/>
- <LFLAGS value="-l. -D"Tnt Unicode VCL Components for BCB5 (Designtime)" -aa -Tpp -Gpd -x
- -Gn -Gl -Gi -v"/>
+ <AFLAGS value="/mx /w2 /zi"/>
+ <LFLAGS value="-D"Tnt Unicode VCL Components for BCB5 (Designtime)" -aa -Tpp -Gpd -x -Gn
+ -Gl -Gi -v"/>
</OPTIONS>
<LINKER>
<ALLOBJ value="c0pkg32.obj $(PACKAGES) Memmgr.Lib sysinit.obj $(OBJFILES)"/>
@@ -71,15 +77,18 @@
Comments=
[HistoryLists\hlIncludePath]
-Count=1
-Item0=..\;..;$(BCB)\include;$(BCB)\include\vcl
+Count=3
+Item0=..\Design;..;$(BCB)\include;$(BCB)\include\vcl
+Item1=..\Design;..\;..;$(BCB)\include;$(BCB)\include\vcl
+Item2=..\;..;$(BCB)\include;$(BCB)\include\vcl
[HistoryLists\hlLibraryPath]
-Count=4
-Item0=;;;;;;..\;;$(BCB)\lib\obj;$(BCB)\lib;..
-Item1=;;$(BCB)\lib\obj;$(BCB)\lib;..\;..
-Item2=;..\;..;$(BCB)\lib\obj;$(BCB)\lib
-Item3=..\;..;$(BCB)\lib\obj;$(BCB)\lib
+Count=5
+Item0=$(BCB)\Projects\Lib;..\Design;..;$(BCB)\lib\obj;$(BCB)\lib
+Item1=;..\Design;..;$(BCB)\lib\obj;$(BCB)\lib
+Item2=..\Design;..\;..;$(BCB)\lib\obj;$(BCB)\lib
+Item3=;..\;..;$(BCB)\lib\obj;$(BCB)\lib
+Item4=..\;..;$(BCB)\lib\obj;$(BCB)\lib
[HistoryLists\hlDebugSourcePath]
Count=1
@@ -89,14 +98,21 @@
Count=1
Item0=_DEBUG
+[HistoryLists\hlIntOutputDir]
+Count=2
+Item0=.\
+Item1=.
+
[HistoryLists\hlFinalOutputDir]
Count=2
Item0=.\
Item1=.
[HistoryLists\hIBPIOutputDir]
-Count=1
-Item0=.
+Count=3
+Item0=C:\Program Files\Borland\CBuilder5\Components\Unicode\BCB5\
+Item1=.\
+Item2=.
[Debugging]
DebugSourceDirs=$(BCB)\source\vcl
@@ -118,4 +134,4 @@
ProjectLang=
RootDir=
</IDEOPTIONS>
-</PROJECT>
+</PROJECT>
\ No newline at end of file
Modified: trunk/TntUnicodeControls/BCB5/TntLibD.cpp
===================================================================
--- trunk/TntUnicodeControls/BCB5/TntLibD.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB5/TntLibD.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -4,14 +4,30 @@
#pragma hdrstop
USERES("TntLibD.res");
USEPACKAGE("vcl50.bpi");
-USEUNIT("..\TntComCtrls_Design.pas");
-USEUNIT("..\TntDesignEditors_Design.pas");
-USEUNIT("..\TntForms_Design.pas");
-USEUNIT("..\TntMenus_Design.pas");
-USEFORMNS("..\TntStrEdit_Design.pas", Tntstredit_design, TntStrEditDlg);
-USEUNIT("..\TntUnicodeVcl_Register.pas");
+USEUNIT("..\Design\TntComCtrls_Design.pas");
+USEUNIT("..\Design\TntDesignEditors_Design.pas");
+USEUNIT("..\Design\TntForms_Design.pas");
+USEUNIT("..\Design\TntMenus_Design.pas");
+USEFORMNS("..\Design\TntStrEdit_Design.pas", Tntstredit_design, TntStrEditDlg);
+USEUNIT("..\Design\TntDBGrids_Design.pas");
+USEUNIT("..\Design\TntUnicodeVcl_Register.pas");
+USERES("..\Design\TntActnlist.dcr");
+USERES("..\Design\TntButtons.dcr");
+USERES("..\Design\TntComCtrls.dcr");
+USERES("..\Design\TntDBCtrls.dcr");
+USERES("..\Design\TntExtCtrls.dcr");
+USERES("..\Design\TntGrids.dcr");
+USERES("..\Design\TntMenus.dcr");
+USERES("..\Design\TntForms.dcr");
+USERES("..\Design\TntStdCtrls.dcr");
+USERES("..\Design\TntDialogs.dcr");
+USERES("..\Design\TntExtDlgs.dcr");
USEPACKAGE("TntLibR.bpi");
USEPACKAGE("dsnide50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("dcldb50.bpi");
+USEPACKAGE("dclstd50.bpi");
+USEPACKAGE("vclx50.bpi");
//---------------------------------------------------------------------------
#pragma package(smart_init)
//---------------------------------------------------------------------------
Modified: trunk/TntUnicodeControls/BCB5/TntLibR.bpk
===================================================================
--- trunk/TntUnicodeControls/BCB5/TntLibR.bpk 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB5/TntLibR.bpk 2006-07-31 00:29:57 UTC (rev 434)
@@ -4,19 +4,21 @@
<MACROS>
<VERSION value="BCB.05.03"/>
<PROJECT value=".\TntLibR.bpl"/>
- <OBJFILES value="..\Unicode.obj ..\ConvertUTF7.obj ..\TntClasses.obj ..\TntComCtrls.obj
- ..\TntControls.obj ..\TntForms.obj ..\TntGraphics.obj ..\TntMenus.obj
- ..\TntStdCtrls.obj ..\TntWideStrPropHelper.obj ..\ActiveIMM_TLB.obj
- ..\TntButtons.obj ..\TntExtCtrls.obj TntLibR.obj"/>
- <RESFILES value="TntLibR.res ..\TntComCtrls.dcr ..\TntMenus.dcr ..\TntStdCtrls.dcr"/>
- <IDLFILES value=""/>
- <IDLGENFILES value=""/>
+ <OBJFILES value="..\TntClasses.obj ..\TntComCtrls.obj ..\TntControls.obj ..\TntForms.obj
+ ..\TntGraphics.obj ..\TntMenus.obj ..\TntStdCtrls.obj ..\ActiveIMM_TLB.obj
+ ..\TntDBGrids.obj ..\TntDBCtrls.obj ..\TntDB.obj ..\TntActnList.obj
+ ..\TntDBActns.obj ..\TntButtons.obj ..\TntAxCtrls.obj ..\TntClipBrd.obj
+ ..\TntSysUtils.obj ..\TntTypInfo.obj ..\TntWindows.obj ..\TntRegistry.obj
+ ..\TntDBLogDlg.obj ..\TntSystem.obj ..\TntCheckLst.obj ..\TntDialogs.obj
+ ..\TntExtCtrls.obj ..\TntExtDlgs.obj ..\TntGrids.obj ..\TntStdActns.obj
+ ..\Unicode.obj TntLibR.obj"/>
+ <RESFILES value="TntLibR.res"/>
<DEFFILE value=""/>
<RESDEPEN value="$(RESFILES)"/>
<LIBFILES value=""/>
- <LIBRARIES value="VCLDB50.lib"/>
+ <LIBRARIES value=""/>
<SPARELIBS value="Vcl50.lib VCLDB50.lib Vclx50.lib"/>
- <PACKAGES value="vcl50.bpi Vclx50.bpi"/>
+ <PACKAGES value="vcl50.bpi Vclx50.bpi VCLDB50.bpi"/>
<PATHCPP value=".;"/>
<PATHPAS value=".;.."/>
<PATHRC value=".;"/>
@@ -24,22 +26,21 @@
<DEBUGLIBPATH value="$(BCB)\lib\debug"/>
<RELEASELIBPATH value="$(BCB)\lib\release"/>
<LINKER value="tlink32"/>
- <USERDEFINES value=""/>
+ <USERDEFINES value="_DEBUG"/>
<SYSDEFINES value="_RTLDLL;NO_STRICT;USEPACKAGES"/>
<MAINSOURCE value="TntLibR.cpp"/>
- <INCLUDEPATH value="..;$(BCB)\include;$(BCB)\include\vcl"/>
- <LIBPATH value="..;$(BCB)\lib\obj;$(BCB)\lib;..\Design"/>
+ <INCLUDEPATH value="..\;..;$(BCB)\include;$(BCB)\include\vcl"/>
+ <LIBPATH value="..\;..;..\..\..\lib\release;$(BCB)\lib\obj;$(BCB)\lib"/>
<WARNINGS value="-w-par"/>
</MACROS>
<OPTIONS>
- <IDLCFLAGS value="-I..\. -I.. -I$(BCB)\include -I$(BCB)\include\vcl -src_suffix cpp -D_DEBUG
- -boa"/>
- <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"/>
+ <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"/>
<RFLAGS value=""/>
- <AFLAGS value="/mx /w2 /zn"/>
- <LFLAGS value="-l. -D"Tnt Unicode VCL Components for BCB5 (Runtime)" -aa -Tpp -Gpr -x -Gn
- -Gl -Gi"/>
+ <AFLAGS value="/mx /w2 /zd"/>
+ <LFLAGS value="-D"Tnt Unicode VCL Components for BCB5 (Runtime)" -aa -Tpp -Gpr -x -Gn -Gl
+ -Gi -v"/>
</OPTIONS>
<LINKER>
<ALLOBJ value="c0pkg32.obj $(PACKAGES) Memmgr.Lib sysinit.obj $(OBJFILES)"/>
@@ -75,12 +76,18 @@
Comments=
[HistoryLists\hlIncludePath]
-Count=1
+Count=3
Item0=..\;..;$(BCB)\include;$(BCB)\include\vcl
+Item1=..;$(BCB)\include;$(BCB)\include\vcl
+Item2=..\;$(BCB)\include;$(BCB)\include\vcl
[HistoryLists\hlLibraryPath]
-Count=1
-Item0=..\;..;$(BCB)\lib\obj;$(BCB)\lib;..\Design
+Count=5
+Item0=..\;..;..\..\..\lib\release;$(BCB)\lib\obj;$(BCB)\lib
+Item1=..\;..\..\..\lib\release;..;$(BCB)\lib\obj;$(BCB)\lib
+Item2=..;$(BCB)\lib\obj;$(BCB)\lib
+Item3=..\;..;$(BCB)\lib\obj;$(BCB)\lib
+Item4=..\;$(BCB)\lib\obj;$(BCB)\lib
[HistoryLists\hlDebugSourcePath]
Count=1
@@ -90,13 +97,21 @@
Count=1
Item0=_DEBUG
+[HistoryLists\hlIntOutputDir]
+Count=2
+Item0=.\
+Item1=.
+
[HistoryLists\hlFinalOutputDir]
-Count=1
+Count=2
Item0=.\
+Item1=.
[HistoryLists\hIBPIOutputDir]
-Count=1
-Item0=.
+Count=3
+Item0=C:\Program Files\Borland\CBuilder5\Components\Unicode\BCB5\
+Item1=.\
+Item2=.
[Debugging]
DebugSourceDirs=$(BCB)\source\vcl
Modified: trunk/TntUnicodeControls/BCB5/TntLibR.cpp
===================================================================
--- trunk/TntUnicodeControls/BCB5/TntLibR.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB5/TntLibR.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -4,23 +4,37 @@
#pragma hdrstop
USERES("TntLibR.res");
USEPACKAGE("vcl50.bpi");
-USEUNIT("..\Unicode.pas");
-USEUNIT("..\ConvertUTF7.pas");
USEUNIT("..\TntClasses.pas");
USEUNIT("..\TntComCtrls.pas");
-USERES("..\TntComCtrls.dcr");
USEUNIT("..\TntControls.pas");
USEUNIT("..\TntForms.pas");
USEUNIT("..\TntGraphics.pas");
USEUNIT("..\TntMenus.pas");
-USERES("..\TntMenus.dcr");
USEUNIT("..\TntStdCtrls.pas");
-USERES("..\TntStdCtrls.dcr");
-USEUNIT("..\TntWideStrPropHelper.pas");
USEUNIT("..\ActiveIMM_TLB.pas");
USEPACKAGE("Vclx50.bpi");
+USEPACKAGE("VCLDB50.bpi");
+USEUNIT("..\TntDBGrids.pas");
+USEUNIT("..\TntDBCtrls.pas");
+USEUNIT("..\TntDB.pas");
+USEUNIT("..\TntActnList.pas");
+USEUNIT("..\TntDBActns.pas");
USEUNIT("..\TntButtons.pas");
+USEUNIT("..\TntAxCtrls.pas");
+USEUNIT("..\TntClipBrd.pas");
+USEUNIT("..\TntSysUtils.pas");
+USEUNIT("..\TntTypInfo.pas");
+USEUNIT("..\TntWindows.pas");
+USEUNIT("..\TntRegistry.pas");
+USEUNIT("..\TntDBLogDlg.pas");
+USEUNIT("..\TntSystem.pas");
+USEUNIT("..\TntCheckLst.pas");
+USEUNIT("..\TntDialogs.pas");
USEUNIT("..\TntExtCtrls.pas");
+USEUNIT("..\TntExtDlgs.pas");
+USEUNIT("..\TntGrids.pas");
+USEUNIT("..\TntStdActns.pas");
+USEUNIT("..\Unicode.pas");
//---------------------------------------------------------------------------
#pragma package(smart_init)
//---------------------------------------------------------------------------
Modified: trunk/TntUnicodeControls/BCB5/readme.txt
===================================================================
--- trunk/TntUnicodeControls/BCB5/readme.txt 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB5/readme.txt 2006-07-31 00:29:57 UTC (rev 434)
@@ -10,23 +10,13 @@
configured to put all output in the same directory that contains the
project file.
-2. Build the design-time package TntUnicodeVcl_D50.dpk or
- TntUnicodeVcl_D60.dpk (depending upon which version of Delphi you have).
- You may want to edit the project options first to set the output
- directories to something specific, so you don't have to guess where the
- output BPL file will go.
-
-3. Launch C++ Builder and install the design-time package BPL that you built
- in step 2. (Menu->Component->Install Packages, then use the top-most Add
- button...)
-
-4. Open and build the C++ Builder design-time package TntLibD.bpk. Like the
+2. Open and build the C++ Builder design-time package TntLibD.bpk. Like the
run-time project file, it is configured to place all output in the same
directory that contains the project file.
-5. Remove the Delphi-built design-time Tnt package from the C++ Builder
- palette, and install the C++ Builder-built package that you created in
- step 4 (again using Menu->Component->Install Packages...)
+3. Install the C++ Builder-built package that you created in
+ step 2 (Menu->Component->Install Packages, then use the top-most Add
+ button...)
To build distributable applications using the Tnt package, either:
Modified: trunk/TntUnicodeControls/BCB6/TntLibD.bpk
===================================================================
--- trunk/TntUnicodeControls/BCB6/TntLibD.bpk 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB6/TntLibD.bpk 2006-07-31 00:29:57 UTC (rev 434)
@@ -4,22 +4,33 @@
<MACROS>
<VERSION value="BCB.06.00"/>
<PROJECT value="TntLibD.bpl"/>
- <OBJFILES value="obj\TntLibD.obj obj\TntComCtrls_Design.obj obj\TntDesignEditors_Design.obj
- obj\TntForms_Design.obj obj\TntMenus_Design.obj
- obj\TntUnicodeVcl_Register.obj obj\TntStrEdit_Design.obj"/>
- <RESFILES value="TntLibD.res ..\Design\TntComCtrls.dcr ..\Design\TntStdCtrls.dcr
- ..\Design\TntActnList.dcr ..\Design\TntMenus.dcr ..\Design\TntExtCtrls.dcr
- ..\Design\TntForms.dcr ..\Design\TntGrids.dcr"/>
+ <OBJFILES value="TntLibD.obj TntComCtrls_Design.obj TntDBGrids_Design.obj
+ TntDesignEditors_Design.obj TntForms_Design.obj TntMenus_Design.obj
+ TntUnicodeVcl_Register.obj TntStrEdit_Design.obj TntActions_Design.obj
+ TntBandActn.obj"/>
+ <RESFILES value="TntLibD.res ..\Design\TntComCtrls.dcr ..\Design\TntDBCtrls.dcr
+ ..\Design\TntStdCtrls.dcr ..\Design\TntActnList.dcr ..\Design\TntMenus.dcr
+ ..\Design\TntExtCtrls.dcr ..\Design\TntForms.dcr ..\Design\TntGrids.dcr
+ ..\Design\TntButtons.dcr ..\Design\TntDialogs.dcr ..\Design\TntExtDlgs.dcr"/>
<IDLFILES value=""/>
<IDLGENFILES value=""/>
<DEFFILE value=""/>
<RESDEPEN value="$(RESFILES) ..\Design\TntStrEdit_Design.dfm"/>
<LIBFILES value=""/>
- <LIBRARIES value="bcbie.lib dclocx.lib bcbsmp.lib"/>
- <SPARELIBS value="rtl.lib bcbsmp.lib dclocx.lib bcbie.lib"/>
- <PACKAGES value="rtl.bpi TntLibR.bpi designide.bpi vcl.bpi designdgm.bpi vclx.bpi dclstd.bpi"/>
+ <LIBRARIES value="bcb2kaxserver.lib indy.lib dbxcds.lib soaprtl.lib nmfast.lib
+ dbexpress.lib inetdbxpress.lib inetdb.lib inetdbbde.lib inet.lib
+ xmlrtl.lib visualdbclx.lib ibxpress.lib teeqr.lib tee.lib teedb.lib
+ teeui.lib bdecds.lib cds.lib dsnap.lib vcldbx.lib bdertl.lib qrpt.lib
+ adortl.lib"/>
+ <SPARELIBS value="rtl.lib vcldb.lib dbrtl.lib adortl.lib qrpt.lib bdertl.lib vcldbx.lib
+ dsnap.lib cds.lib bdecds.lib teeui.lib teedb.lib tee.lib teeqr.lib
+ ibxpress.lib visualdbclx.lib xmlrtl.lib inet.lib inetdbbde.lib inetdb.lib
+ inetdbxpress.lib dbexpress.lib nmfast.lib soaprtl.lib dbxcds.lib
+ indy.lib bcb2kaxserver.lib"/>
+ <PACKAGES value="TntLibR.bpi designide.bpi dcldb.bpi designdgm.bpi dclstd.bpi dclact.bpi
+ rtl.bpi vcl.bpi vclx.bpi vcldb.bpi dbrtl.bpi"/>
<PATHCPP value=".;"/>
- <PATHPAS value=".;..\Design;..\Design;..\Design;..\Design;..\Design;..\Design"/>
+ <PATHPAS value=".;..\Design;.."/>
<PATHRC value=".;"/>
<PATHASM value=".;"/>
<DEBUGLIBPATH value="$(BCB)\lib\debug"/>
@@ -28,18 +39,19 @@
<USERDEFINES value=""/>
<SYSDEFINES value="_RTLDLL;NO_STRICT;USEPACKAGES"/>
<MAINSOURCE value="TntLibD.cpp"/>
- <INCLUDEPATH value="$(BCB)\include;$(BCB)\include\vcl;..;..\Design"/>
- <LIBPATH value="$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;..;..\Design;obj"/>
+ <INCLUDEPATH value="..;$(BCB)\include;$(BCB)\include\vcl;..\Design"/>
+ <LIBPATH value="..;$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;..\Design"/>
<WARNINGS value="-w-par"/>
<OTHERFILES value=""/>
</MACROS>
<OPTIONS>
- <IDLCFLAGS value="-I$(BCB)\include -I$(BCB)\include\vcl -I.. -I..\Design -src_suffix cpp -boa"/>
+ <IDLCFLAGS value="-I..\. -I$(BCB)\include -I$(BCB)\include\vcl -I.. -I..\Design -src_suffix
+ cpp -boa"/>
<CFLAG1 value="-Od -H=$(BCB)\lib\vcl60.csm -Hc -Vx -Ve -X- -a8 -6 -b- -k- -vi -c -tWM"/>
- <PFLAGS value="-N2obj -N0obj -$Y- -$L- -$D- -$A8 -v -JPHNE -M -LUdclstd"/>
+ <PFLAGS value="-N2. -N0. -$Y- -$L- -$D- -$A8 -v -JPHNE -M -LUdclstd"/>
<RFLAGS value=""/>
<AFLAGS value="/mx /w2 /zn"/>
- <LFLAGS value="-Iobj -D"Tnt Unicode VCL - Design" -aa -Tpp -Gpd -x -Gn -Gl -Gi"/>
+ <LFLAGS value="-I. -D"Tnt Unicode VCL - Design" -aa -Tpp -Gpd -x -Gn -Gl -Gi"/>
<OTHERFILES value=""/>
</OPTIONS>
<LINKER>
@@ -52,11 +64,13 @@
<FILE FILENAME="TntLibD.res" FORMNAME="" UNITNAME="TntLibD.res" CONTAINERID="ResTool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="TntLibD.cpp" FORMNAME="" UNITNAME="TntLibD" CONTAINERID="CCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntComCtrls_Design.pas" FORMNAME="" UNITNAME="TntComCtrls_Design" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\Design\TntDBGrids_Design.pas" FORMNAME="" UNITNAME="TntDBGrids_Design" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntDesignEditors_Design.pas" FORMNAME="" UNITNAME="TntDesignEditors_Design" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntForms_Design.pas" FORMNAME="" UNITNAME="TntForms_Design" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntMenus_Design.pas" FORMNAME="" UNITNAME="TntMenus_Design" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntUnicodeVcl_Register.pas" FORMNAME="" UNITNAME="TntUnicodeVcl_Register" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntComCtrls.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\Design\TntDBCtrls.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntStdCtrls.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntActnList.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntMenus.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
@@ -64,13 +78,22 @@
<FILE FILENAME="..\Design\TntForms.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntGrids.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\Design\TntStrEdit_Design.pas" FORMNAME="TntStrEditDlg" UNITNAME="TntStrEdit_Design" CONTAINERID="PascalCompiler" DESIGNCLASS="TTntForm" LOCALCOMMAND=""/>
- <FILE FILENAME="rtl.bpi" FORMNAME="" UNITNAME="rtl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\Design\TntActions_Design.pas" FORMNAME="" UNITNAME="TntActions_Design" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\Design\TntButtons.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\Design\TntDialogs.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\Design\TntExtDlgs.dcr" FORMNAME="" UNITNAME="" CONTAINERID="DcrTool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntBandActn.pas" FORMNAME="" UNITNAME="TntBandActn" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="TntLibR.bpi" FORMNAME="" UNITNAME="TntLibR" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="designide.bpi" FORMNAME="" UNITNAME="designide" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="dcldb.bpi" FORMNAME="" UNITNAME="dcldb" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="designdgm.bpi" FORMNAME="" UNITNAME="designdgm" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="dclstd.bpi" FORMNAME="" UNITNAME="dclstd" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="dclact.bpi" FORMNAME="" UNITNAME="dclact" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="rtl.bpi" FORMNAME="" UNITNAME="rtl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="vcl.bpi" FORMNAME="" UNITNAME="vcl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="designdgm.bpi" FORMNAME="" UNITNAME="designdgm" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="vclx.bpi" FORMNAME="" UNITNAME="vclx" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="dclstd.bpi" FORMNAME="" UNITNAME="dclstd" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="vcldb.bpi" FORMNAME="" UNITNAME="vcldb" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="dbrtl.bpi" FORMNAME="" UNITNAME="dbrtl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
</FILELIST>
<BUILDTOOLS>
</BUILDTOOLS>
@@ -104,28 +127,36 @@
Comments=
[Excluded Packages]
-c:\program files\borland\cbuilder6\Projects\Bpl\TntLibD.bpl=Tnt Unicode VCL - Design
+c:\program files\borland\cbuilder6\Bin\bcbie60.bpl=Borland C++Builder Internet Explorer 5 Components Package
+C:\PROGRAM FILES\BORLAND\CBUILDER6\COMPONENTS\GRAPHICS32\GR32_CB6.BPL=Graphics32
+C:\Program Files\Borland\CBuilder6\Components\ThemeManager\thememgr_cb6.bpl=Windows XP Theme Manager
+C:\Program Files\Borland\CBuilder6\Components\Graphics32\GR32_DSGN_CB6.bpl=GR32_DSGN_CB6
+C:\Program Files\Borland\CBuilder6\Components\Misc\misc.bpl=misc
[HistoryLists\hlIncludePath]
-Count=3
-Item0=$(BCB)\include;$(BCB)\include\vcl;..;..\Design
-Item1=$(BCB)\include;$(BCB)\include\vcl;.\Design;..\VT
-Item2=$(BCB)\include;$(BCB)\include\vcl
+Count=5
+Item0=..;$(BCB)\include;$(BCB)\include\vcl;..\Design
+Item1=..\;$(BCB)\include;$(BCB)\include\vcl;..;..\Design
+Item2=$(BCB)\include;$(BCB)\include\vcl;..;..\Design
+Item3=$(BCB)\include;$(BCB)\include\vcl;.\Design;..\VT
+Item4=$(BCB)\include;$(BCB)\include\vcl
[HistoryLists\hlLibraryPath]
-Count=4
-Item0=$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;..;..\Design;obj
-Item1=$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;..;..\Design
-Item2=$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;.\Design;..\VT
-Item3=$(BCB)\lib\obj;$(BCB)\lib
+Count=5
+Item0=..;$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;..\Design
+Item1=..\;$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;..;..\Design
+Item2=$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;..;..\Design
+Item3=$(BCB)\lib\obj;$(BCB)\lib;$(BCB)\Projects\lib;.\Design;..\VT
+Item4=$(BCB)\lib\obj;$(BCB)\lib
[HistoryLists\hlDebugSourcePath]
Count=1
Item0=$(BCB)\source\vcl
[HistoryLists\hlIntOutputDir]
-Count=1
-Item0=obj
+Count=2
+Item0=.
+Item1=obj
[Debugging]
DebugSourceDirs=$(BCB)\source\vcl
@@ -145,7 +176,13 @@
[Compiler]
ShowInfoMsgs=0
LinkDebugVcl=0
+LinkCGLIB=0
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
[Linker]
LibPrefix=
LibSuffix=
Modified: trunk/TntUnicodeControls/BCB6/TntLibR.bpk
===================================================================
--- trunk/TntUnicodeControls/BCB6/TntLibR.bpk 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB6/TntLibR.bpk 2006-07-31 00:29:57 UTC (rev 434)
@@ -3,23 +3,32 @@
<PROJECT>
<MACROS>
<VERSION value="BCB.06.00"/>
- <PROJECT value=".\TntLibR.bpl"/>
- <OBJFILES value="obj\TntLibR.obj obj\ActiveIMM_TLB.obj obj\ConvertUTF7.obj
- obj\TntClasses.obj obj\TntComCtrls.obj obj\TntControls.obj
- obj\TntForms.obj obj\TntGraphics.obj obj\TntGrids.obj obj\TntMenus.obj
- obj\TntStdCtrls.obj obj\TntWideStrPropHelper.obj obj\TntCheckLst.obj
- obj\TntExtCtrls.obj obj\Unicode.obj obj\TntStdActns.obj
- obj\TntActnList.obj obj\TntExtActns.obj obj\TntListActns.obj
- obj\TntButtons.obj"/>
+ <PROJECT value="TntLibR.bpl"/>
+ <OBJFILES value="TntLibR.obj ActiveIMM_TLB.obj TntClasses.obj TntComCtrls.obj
+ TntControls.obj TntDB.obj TntDBCtrls.obj TntDBGrids.obj TntForms.obj
+ TntGraphics.obj TntGrids.obj TntMenus.obj TntStdCtrls.obj TntCheckLst.obj
+ TntExtCtrls.obj TntDBActns.obj TntActnList.obj TntStdActns.obj
+ TntExtActns.obj TntListActns.obj TntClipbrd.obj TntAxCtrls.obj
+ TntButtons.obj TntTypInfo.obj TntWindows.obj TntSysUtils.obj
+ TntDialogs.obj TntDBLogDlg.obj TntRegistry.obj TntSystem.obj TntExtDlgs.obj
+ TntFileCtrl.obj TntFormatStrUtils.obj"/>
<RESFILES value="TntLibR.res"/>
<IDLFILES value=""/>
<IDLGENFILES value=""/>
<DEFFILE value=""/>
- <RESDEPEN value="$(RESFILES)"/>
+ <RESDEPEN value="$(RESFILES) ..\TntDBLogDlg.dfm"/>
<LIBFILES value=""/>
- <LIBRARIES value="dclocx.lib"/>
- <SPARELIBS value="rtl.lib bcbsmp.lib dclocx.lib bcbie.lib"/>
- <PACKAGES value="rtl.bpi vcl.bpi vclx.bpi bcbsmp.bpi bcbie.bpi"/>
+ <LIBRARIES value="dclocx.lib dsnapcon.lib dsnapcrba.lib dss.lib bcb2kaxserver.lib indy.lib
+ dbxcds.lib soaprtl.lib nmfast.lib dbexpress.lib inetdbxpress.lib
+ inetdb.lib inetdbbde.lib inet.lib xmlrtl.lib visualdbclx.lib ibxpress.lib
+ teeqr.lib tee.lib teedb.lib teeui.lib bdecds.lib cds.lib dsnap.lib
+ vcldbx.lib bdertl.lib qrpt.lib adortl.lib"/>
+ <SPARELIBS value="rtl.lib vcldb.lib dbrtl.lib adortl.lib qrpt.lib bdertl.lib vcldbx.lib
+ dsnap.lib cds.lib bdecds.lib teeui.lib teedb.lib tee.lib teeqr.lib
+ ibxpress.lib visualdbclx.lib xmlrtl.lib inet.lib inetdbbde.lib inetdb.lib
+ inetdbxpress.lib dbexpress.lib nmfast.lib soaprtl.lib dbxcds.lib indy.lib
+ bcb2kaxserver.lib dss.lib dsnapcrba.lib dsnapcon.lib dclocx.lib"/>
+ <PACKAGES value="rtl.bpi vcl.bpi vclx.bpi vcldb.bpi dbrtl.bpi"/>
<PATHCPP value=".;"/>
<PATHPAS value=".;.."/>
<PATHRC value=".;"/>
@@ -30,18 +39,18 @@
<USERDEFINES value=""/>
<SYSDEFINES value="_RTLDLL;NO_STRICT;USEPACKAGES"/>
<MAINSOURCE value="TntLibR.cpp"/>
- <INCLUDEPATH value="..\;..;$(BCB)\include;$(BCB)\include\vcl"/>
- <LIBPATH value="..\;..;$(BCB)\lib\obj;$(BCB)\lib"/>
+ <INCLUDEPATH value="..;$(BCB)\include;$(BCB)\include\vcl"/>
+ <LIBPATH value="..;$(BCB)\lib\obj;$(BCB)\lib"/>
<WARNINGS value="-w-par"/>
<OTHERFILES value=""/>
</MACROS>
<OPTIONS>
- <IDLCFLAGS value="-I$(BCB)\include -I$(BCB)\include\vcl -I.. -src_suffix cpp -boa"/>
- <CFLAG1 value="-Od -Vx -Ve -X- -a8 -6 -b- -k- -vi -c -tWM"/>
- <PFLAGS value="-N2obj -N0obj -$Y- -$L- -$D- -$A8 -v -JPHNE -M"/>
+ <IDLCFLAGS value="-I..\. -I$(BCB)\include -I$(BCB)\include\vcl -I.. -src_suffix cpp -boa"/>
+ <CFLAG1 value="-Od -H=$(BCB)\lib\vcl60.csm -Hc -Vx -Ve -X- -a8 -6 -b- -k- -vi -c -tWM"/>
+ <PFLAGS value="-N2. -N0. -$Y- -$L- -$D- -$A8 -v -JPHNE -M"/>
<RFLAGS value=""/>
<AFLAGS value="/mx /w2 /zn"/>
- <LFLAGS value="-l. -Iobj -D"Tnt Unicode VCL - Runtime" -aa -Tpp -Gpr -x -Gn -Gl -Gi"/>
+ <LFLAGS value="-I. -D"Tnt Unicode VCL - Runtime" -aa -Tpp -Gpr -x -Gn -Gl -Gi"/>
<OTHERFILES value=""/>
</OPTIONS>
<LINKER>
@@ -53,30 +62,43 @@
<FILELIST>
<FILE FILENAME="TntLibR.res" FORMNAME="" UNITNAME="TntLibR.res" CONTAINERID="ResTool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="TntLibR.cpp" FORMNAME="" UNITNAME="TntLibR" CONTAINERID="CCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="c:\rtl.bpi" FORMNAME="" UNITNAME="rtl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\ActiveIMM_TLB.pas" FORMNAME="" UNITNAME="ActiveIMM_TLB" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\ConvertUTF7.pas" FORMNAME="" UNITNAME="ConvertUTF7" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntClasses.pas" FORMNAME="" UNITNAME="TntClasses" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntComCtrls.pas" FORMNAME="" UNITNAME="TntComCtrls" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntControls.pas" FORMNAME="" UNITNAME="TntControls" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntDB.pas" FORMNAME="" UNITNAME="TntDB" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntDBCtrls.pas" FORMNAME="" UNITNAME="TntDBCtrls" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntDBGrids.pas" FORMNAME="" UNITNAME="TntDBGrids" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntForms.pas" FORMNAME="" UNITNAME="TntForms" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntGraphics.pas" FORMNAME="" UNITNAME="TntGraphics" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntGrids.pas" FORMNAME="" UNITNAME="TntGrids" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntMenus.pas" FORMNAME="" UNITNAME="TntMenus" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntStdCtrls.pas" FORMNAME="" UNITNAME="TntStdCtrls" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\TntWideStrPropHelper.pas" FORMNAME="" UNITNAME="TntWideStrPropHelper" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntCheckLst.pas" FORMNAME="" UNITNAME="TntCheckLst" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntExtCtrls.pas" FORMNAME="" UNITNAME="TntExtCtrls" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\Unicode.pas" FORMNAME="" UNITNAME="Unicode" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="c:\vcl.bpi" FORMNAME="" UNITNAME="vcl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="c:\vclx.bpi" FORMNAME="" UNITNAME="vclx" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntDBActns.pas" FORMNAME="" UNITNAME="TntDBActns" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntActnList.pas" FORMNAME="" UNITNAME="TntActnList" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntStdActns.pas" FORMNAME="" UNITNAME="TntStdActns" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="..\TntActnList.pas" FORMNAME="" UNITNAME="TntActnList" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntExtActns.pas" FORMNAME="" UNITNAME="TntExtActns" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntListActns.pas" FORMNAME="" UNITNAME="TntListActns" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="c:\bcbsmp.bpi" FORMNAME="" UNITNAME="bcbsmp" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
- <FILE FILENAME="c:\bcbie.bpi" FORMNAME="" UNITNAME="bcbie" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntClipbrd.pas" FORMNAME="" UNITNAME="TntClipbrd" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntAxCtrls.pas" FORMNAME="" UNITNAME="TntAxCtrls" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\TntButtons.pas" FORMNAME="" UNITNAME="TntButtons" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntTypInfo.pas" FORMNAME="" UNITNAME="TntTypInfo" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntWindows.pas" FORMNAME="" UNITNAME="TntWindows" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntSysUtils.pas" FORMNAME="" UNITNAME="TntSysUtils" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntDialogs.pas" FORMNAME="" UNITNAME="TntDialogs" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntDBLogDlg.pas" FORMNAME="TntLoginDialog" UNITNAME="TntDBLogDlg" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntRegistry.pas" FORMNAME="" UNITNAME="TntRegistry" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntSystem.pas" FORMNAME="" UNITNAME="TntSystem" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntExtDlgs.pas" FORMNAME="" UNITNAME="TntExtDlgs" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntFileCtrl.pas" FORMNAME="" UNITNAME="TntFileCtrl" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\TntFormatStrUtils.pas" FORMNAME="" UNITNAME="TntFormatStrUtils" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\rtl.bpi" FORMNAME="" UNITNAME="rtl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\vcl.bpi" FORMNAME="" UNITNAME="vcl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\vclx.bpi" FORMNAME="" UNITNAME="vclx" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\vcldb.bpi" FORMNAME="" UNITNAME="vcldb" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\dbrtl.bpi" FORMNAME="" UNITNAME="dbrtl" CONTAINERID="BPITool" DESIGNCLASS="" LOCALCOMMAND=""/>
</FILELIST>
<BUILDTOOLS>
</BUILDTOOLS>
@@ -94,8 +116,8 @@
Special=0
Private=0
DLL=0
-Locale=1033
-CodePage=1252
+Locale=1049
+CodePage=1251
[Version Info Keys]
CompanyName=
@@ -107,41 +129,38 @@
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
+Comments=
+[Excluded Packages]
+c:\program files\borland\cbuilder6\Bin\bcbie60.bpl=Borland C++Builder Internet Explorer 5 Components Package
+C:\PROGRAM FILES\BORLAND\CBUILDER6\COMPONENTS\GRAPHICS32\GR32_CB6.BPL=Graphics32
+C:\Program Files\Borland\CBuilder6\Components\ThemeManager\thememgr_cb6.bpl=Windows XP Theme Manager
+C:\Program Files\Borland\CBuilder6\Components\Graphics32\GR32_DSGN_CB6.bpl=GR32_DSGN_CB6
+C:\Program Files\Borland\CBuilder6\Components\Misc\misc.bpl=misc
+
[HistoryLists\hlIncludePath]
-Count=5
-Item0=..\;..;$(BCB)\include;$(BCB)\include\vcl
-Item1=..\;$(BCB)\include;$(BCB)\include\vcl;..
-Item2=$(BCB)\include;$(BCB)\include\vcl;..
-Item3=$(BCB)\include;$(BCB)\include\vcl
-Item4=$(BCB)\include;$(BCB)\include\vcl;..\VT
+Count=4
+Item0=..\;$(BCB)\include;$(BCB)\include\vcl;..
+Item1=$(BCB)\include;$(BCB)\include\vcl;..
+Item2=$(BCB)\include;$(BCB)\include\vcl
+Item3=$(BCB)\include;$(BCB)\include\vcl;..\VT
[HistoryLists\hlLibraryPath]
-Count=6
-Item0=..\;..;$(BCB)\lib\obj;$(BCB)\lib
-Item1=..\;$(BCB)\lib\obj;$(BCB)\lib;..
-Item2=$(BCB)\lib\obj;$(BCB)\lib;..
-Item3=$(BCB)\lib\obj;$(BCB)\lib;..;..\VT
-Item4=$(BCB)\lib\obj;$(BCB)\lib;..\VT
-Item5=$(BCB)\lib\obj;$(BCB)\lib
+Count=5
+Item0=..\;$(BCB)\lib\obj;$(BCB)\lib;..
+Item1=$(BCB)\lib\obj;$(BCB)\lib;..
+Item2=$(BCB)\lib\obj;$(BCB)\lib;..;..\VT
+Item3=$(BCB)\lib\obj;$(BCB)\lib;..\VT
+Item4=$(BCB)\lib\obj;$(BCB)\lib
[HistoryLists\hlDebugSourcePath]
Count=1
Item0=$(BCB)\source\vcl
[HistoryLists\hlIntOutputDir]
-Count=1
-Item0=obj
-
-[HistoryLists\hlFinalOutputDir]
Count=2
-Item0=.\
-Item1=.
-
-[HistoryLists\hIBPIOutputDir]
-Count=2
Item0=.
-Item1=.\
+Item1=obj
[Debugging]
DebugSourceDirs=$(BCB)\source\vcl
@@ -161,7 +180,13 @@
[Compiler]
ShowInfoMsgs=0
LinkDebugVcl=0
+LinkCGLIB=0
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
[Linker]
LibPrefix=
LibSuffix=
Modified: trunk/TntUnicodeControls/BCB6/TntLibR.cpp
===================================================================
--- trunk/TntUnicodeControls/BCB6/TntLibR.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/BCB6/TntLibR.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -2,6 +2,8 @@
#include <basepch.h>
#pragma hdrstop
+USEFORMNS("..\TntDBLogDlg.pas", Tntdblogdlg, TntLoginDialog);
+//---------------------------------------------------------------------------
#pragma package(smart_init)
//---------------------------------------------------------------------------
@@ -14,4 +16,3 @@
return 1;
}
//---------------------------------------------------------------------------
-
\ No newline at end of file
Modified: trunk/TntUnicodeControls/BCB6/TntLibR.res
===================================================================
(Binary files differ)
Modified: trunk/TntUnicodeControls/Design/TntComCtrls.dcr
===================================================================
(Binary files differ)
Modified: trunk/TntUnicodeControls/Design/TntComCtrls_Design.pas
===================================================================
--- trunk/TntUnicodeControls/Design/TntComCtrls_Design.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Design/TntComCtrls_Design.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,16 +1,29 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntComCtrls_Design;
+{$INCLUDE ..\TntCompilers.inc}
+
interface
uses
- {$IFDEF VER130} DsgnIntf, Menus, {$ELSE} DesignIntf, DesignMenus, DesignEditors, {$ENDIF}
+ {$IFDEF COMPILER_6_UP} DesignIntf, DesignMenus, DesignEditors, {$ELSE} DsgnIntf, Menus, {$ENDIF}
Classes, ComCtrls;
type
-{$IFDEF VER130}
+{$IFDEF COMPILER_6_UP}
+ IPrepareMenuItem = IMenuItem;
+{$ELSE}
IPrepareMenuItem = TMenuItem{TNT-ALLOW TMenuItem};
-{$ELSE}
- IPrepareMenuItem = IMenuItem;
{$ENDIF}
TTntListViewEditor = class(TComponentEditor)
@@ -30,19 +43,40 @@
procedure PrepareItem(Index: Integer; const AItem: IPrepareMenuItem); override;
end;
+ TTntStatusBarEditor = class(TComponentEditor)
+ public
+ procedure ExecuteVerb(Index: Integer); override;
+ function GetVerb(Index: Integer): string{TNT-ALLOW string}; override;
+ function GetVerbCount: Integer; override;
+ end;
+
+
procedure Register;
implementation
-uses {$IFNDEF VER130} DsnConst, {$ENDIF} TntComCtrls, TntDesignEditors_Design;
+uses
+ {$IFDEF COMPILER_6_UP} DsnConst, {$ENDIF} TntComCtrls, TntDesignEditors_Design;
procedure Register;
begin
RegisterComponentEditor(TTntListView, TTntListViewEditor);
RegisterComponentEditor(TTntPageControl, TTntPageControlEditor);
RegisterComponentEditor(TTntTabSheet, TTntPageControlEditor);
+ RegisterComponentEditor(TTntStatusBar, TTntStatusBarEditor);
end;
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+resourcestring
+ SListColumnsEditor = 'Columns Editor...';
+ SListItemsEditor = 'Items Editor...';
+ SNewPage = 'New Page';
+ SNextPage = 'Next Page';
+ SPrevPage = 'Previous Page';
+ SDeletePage = 'Delete Page';
+ SStatusBarPanelEdit = 'Panels Editor...';
+{$ENDIF}
+
{ TTntListViewEditor }
function TTntListViewEditor.GetVerbCount: Integer;
@@ -50,12 +84,6 @@
Result := 2;
end;
-{$IFDEF VER130}
-resourcestring
- SListColumnsEditor = 'Columns Editor...';
- SListItemsEditor = 'Items Editor...';
-{$ENDIF}
-
function TTntListViewEditor.GetVerb(Index: Integer): string{TNT-ALLOW string};
begin
case Index of
@@ -87,14 +115,6 @@
Result := 4;
end;
-{$IFDEF VER130}
-resourcestring
- SNewPage = 'New Page';
- SNextPage = 'Next Page';
- SPrevPage = 'Previous Page';
- SDeletePage = 'Delete Page';
-{$ENDIF}
-
function TTntPageControlEditor.GetVerb(Index: Integer): string{TNT-ALLOW string};
begin
case Index of
@@ -128,8 +148,11 @@
PageControl.ActivePage := NewTabSheet;
end;
- {$IFDEF VER130}
procedure SelectNextPage(GoForward: Boolean);
+ {$IFDEF COMPILER_6_UP}
+ begin
+ PageControl.SelectNextPage(GoForward, False);
+ {$ELSE}
var
Page: TTabSheet{TNT-ALLOW TTabSheet};
begin
@@ -141,13 +164,8 @@
Change;
end;
end;
+ {$ENDIF}
end;
- {$ELSE}
- procedure SelectNextPage(GoForward: Boolean);
- begin
- PageControl.SelectNextPage(GoForward, False);
- end;
- {$ENDIF}
begin
case Index of
@@ -159,4 +177,25 @@
end;
end;
+{ TTntStatusBarEditor }
+
+function TTntStatusBarEditor.GetVerbCount: Integer;
+begin
+ Result := 1;
+end;
+
+function TTntStatusBarEditor.GetVerb(Index: Integer): string{TNT-ALLOW string};
+begin
+ case Index of
+ 0: Result := SStatusBarPanelEdit;
+ end;
+end;
+
+procedure TTntStatusBarEditor.ExecuteVerb(Index: Integer);
+begin
+ case Index of
+ 0: EditPropertyWithDialog(Component, 'Panels', Designer);
+ end;
+end;
+
end.
Modified: trunk/TntUnicodeControls/Design/TntDesignEditors_Design.pas
===================================================================
--- trunk/TntUnicodeControls/Design/TntDesignEditors_Design.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Design/TntDesignEditors_Design.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,80 +1,150 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntDesignEditors_Design;
+{$INCLUDE ..\TntCompilers.inc}
+
interface
-uses Classes, Messages, Windows, Graphics, Controls, Forms, TypInfo,
- {$IFDEF VER130} DsgnIntf; {$ELSE} DesignIntf, DesignEditors, VCLEditors; {$ENDIF}
+uses
+ Classes, Forms, TypInfo,
+ {$IFDEF COMPILER_6_UP} DesignIntf, DesignEditors; {$ELSE} DsgnIntf; {$ENDIF}
type
-{$IFDEF VER130}
- ICreateDesigner = IFormDesigner;
-{$ELSE}
- ICreateDesigner = IDesigner;
-{$ENDIF}
+ {$IFDEF COMPILER_6_UP}
+ ITntDesigner = IDesigner;
+ {$ELSE}
+ ITntDesigner = IFormDesigner;
+ {$ENDIF}
-{$IFDEF VER130}
- TWideStringProperty = class(TPropertyEditor)
-{$ELSE}
- TWideStringProperty = class(TPropertyEditor, ICustomPropertyDrawing)
-{$ENDIF}
+ TTntDesignerSelections = class(TInterfacedObject, IDesignerSelections)
private
- FActivateWithoutGetValue: Boolean;
- FPropList: PInstPropList;
+ FList: TList;
+ {$IFNDEF COMPILER_6_UP}
+ function IDesignerSelections.Add = Intf_Add;
+ function Intf_Add(const Item: IPersistent): Integer;
+ function IDesignerSelections.Get = Intf_Get;
+ function Intf_Get(Index: Integer): IPersistent;
+ {$ENDIF}
+ {$IFDEF COMPILER_9_UP}
+ function GetDesignObject(Index: Integer): IDesignObject;
+ {$ENDIF}
protected
-{$IFDEF VER130}
- procedure SetPropEntry(Index: Integer; AInstance: TPersistent; APropInfo: PPropInfo);
-{$ELSE}
- procedure SetPropEntry(Index: Integer; AInstance: TPersistent; APropInfo: PPropInfo); override;
-{$ENDIF}
- function GetWideStrValueAt(Index: Integer): WideString;
- function GetWideStrValue: WideString;
- procedure SetWideStrValue(const Value: WideString);
- function GetWideVisualValue: WideString;
+ function Add(const Item: TPersistent): Integer;
+ function Equals(const List: IDesignerSelections): Boolean;
+ {$IFDEF COMPILER_6_UP}
+ function Get(Index: Integer): TPersistent;
+ {$ENDIF}
+ function GetCount: Integer;
+ property Count: Integer read GetCount;
+ {$IFDEF COMPILER_6_UP}
+ property Items[Index: Integer]: TPersistent read Get; default;
+ {$ENDIF}
public
- constructor Create(const ADesigner: ICreateDesigner; APropCount: Integer); override;
+ constructor Create; virtual;
destructor Destroy; override;
-{$IFDEF VER130}
- procedure Initialize; override;
-{$ENDIF}
- procedure Activate; override;
- procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); {$IFDEF VER130} override; {$ENDIF}
- procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); {$IFDEF VER130} override; {$ENDIF}
- function AllEqual: Boolean; override;
- function GetEditLimit: Integer; override;
- function GetValue: AnsiString; override;
- procedure SetValue(const Value: AnsiString); override;
+ procedure ReplaceSelection(const OldInst, NewInst: TPersistent);
end;
- TWideCaptionProperty = class(TWideStringProperty)
- public
- function GetAttributes: TPropertyAttributes; override;
+function GetObjectInspectorForm: TCustomForm;
+procedure EditPropertyWithDialog(Component: TPersistent; const PropName: AnsiString; const Designer: ITntDesigner);
+
+implementation
+
+uses
+ SysUtils, TntSysUtils;
+
+{ TTntDesignerSelections }
+
+function TTntDesignerSelections.Add(const Item: TPersistent): Integer;
+begin
+ Result := FList.Add(Item);
+end;
+
+constructor TTntDesignerSelections.Create;
+begin
+ inherited;
+ FList := TList.Create;
+end;
+
+destructor TTntDesignerSelections.Destroy;
+begin
+ FList.Free;
+ inherited;
+end;
+
+function TTntDesignerSelections.Equals(const List: IDesignerSelections): Boolean;
+var
+ I: Integer;
+ {$IFNDEF COMPILER_6_UP}
+ P1, P2: IPersistent;
+ {$ENDIF}
+begin
+ Result := False;
+ if List.Count <> Count then Exit;
+ for I := 0 to Count - 1 do
+ begin
+ {$IFDEF COMPILER_6_UP}
+ if Items[I] <> List[I] then Exit;
+ {$ELSE}
+ P1 := Intf_Get(I);
+ P2 := List[I];
+ if ((P1 = nil) and (P2 <> nil)) or
+ (P2 = nil) or not P1.Equals(P2) then Exit;
+ {$ENDIF}
end;
+ Result := True;
+end;
-function GetObjectInspectorForm: TCustomForm;
-procedure EditPropertyWithDialog(Component: TPersistent; const PropName: AnsiString; const Designer: ICreateDesigner);
+{$IFDEF COMPILER_6_UP}
+function TTntDesignerSelections.Get(Index: Integer): TPersistent;
+begin
+ Result := TPersistent(FList[Index]);
+end;
+{$ENDIF}
-procedure Register;
+function TTntDesignerSelections.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
-implementation
+{$IFNDEF COMPILER_6_UP}
+function TTntDesignerSelections.Intf_Add(const Item: IPersistent): Integer;
+begin
+ Result := Add(ExtractPersistent(Item));
+end;
-uses SysUtils, StdCtrls, TntClasses, TntGraphics, TntControls, TntWideStrPropHelper;
+function TTntDesignerSelections.Intf_Get(Index: Integer): IPersistent;
+begin
+ Result := MakeIPersistent(TPersistent(FList[Index]));
+end;
+{$ENDIF}
-procedure Register;
+{$IFDEF COMPILER_9_UP}
+function TTntDesignerSelections.GetDesignObject(Index: Integer): IDesignObject;
begin
- RegisterPropertyEditor(TypeInfo(WideString), nil, '', TWideStringProperty);
- RegisterPropertyEditor(TypeInfo(TWideCaption), nil, '', TWideCaptionProperty);
+ Result := nil; {TODO: Figure out what IDesignerSelections.GetDesignObject is all about. Must wait for more documentation!}
end;
+{$ENDIF}
+procedure TTntDesignerSelections.ReplaceSelection(const OldInst, NewInst: TPersistent);
+var
+ Idx: Integer;
+begin
+ Idx := FList.IndexOf(OldInst);
+ if Idx <> -1 then
+ FList[Idx] := NewInst;
+end;
+
{//------------------------------
// Helpful discovery routines to explore the components and classes inside the IDE...
//
@@ -127,229 +197,43 @@
end;
end;
-function GetOIInspListBox: TWinControl;
-var
- ObjectInspectorForm: TCustomForm;
- Comp: TComponent;
-begin
- Result := nil;
- ObjectInspectorForm := GetObjectInspectorForm;
- if ObjectInspectorForm <> nil then begin
- Comp := ObjectInspectorForm.FindComponent('PropList');
- if Comp is TWinControl then
- Result := TWinControl(Comp);
- end;
-end;
-
-function GetOIPropInspEdit: TCustomEdit{TNT-ALLOW TCustomEdit};
-var
- OIInspListBox: TWinControl;
- Comp: TComponent;
-begin
- Result := nil;
- OIInspListBox := GetOIInspListBox;
- if OIInspListBox <> nil then begin
- Comp := OIInspListBox.FindComponent('EditControl');
- if Comp is TCustomEdit{TNT-ALLOW TCustomEdit} then
- Result := TCustomEdit{TNT-ALLOW TCustomEdit}(Comp);
- end;
-end;
-//------------------------------
-
-type TAccessWinControl = class(TWinControl);
-
-{ TWideStringProperty }
-
-var
- WideStringPropertyCount: Integer = 0;
-
-constructor TWideStringProperty.Create(const ADesigner: ICreateDesigner; APropCount: Integer);
-begin
- inherited;
- Inc(WideStringPropertyCount);
- GetMem(FPropList, APropCount * SizeOf(TInstProp));
-end;
-
-procedure ConvertObjectInspectorBackToANSI;
-var
- Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
-begin
- if (Win32PlatformIsUnicode) then begin
- Edit := GetOIPropInspEdit;
- if Assigned(Edit)
- and IsWindowUnicode(Edit.Handle) then
- TAccessWinControl(Edit).RecreateWnd;
- end;
-end;
-
-destructor TWideStringProperty.Destroy;
-begin
- Dec(WideStringPropertyCount);
- if (WideStringPropertyCount = 0) then
- ConvertObjectInspectorBackToANSI;
- if FPropList <> nil then
- FreeMem(FPropList, PropCount * SizeOf(TInstProp));
- inherited;
-end;
-
-{$IFDEF VER130}
+{ TPropertyEditorWithDialog }
type
- TDelphi_5_PropertyEditor = class
- FDesigner: IFormDesigner;
- FPropList: PInstPropList;
+ TPropertyEditorWithDialog = class
+ private
+ FPropName: AnsiString;
+ {$IFDEF COMPILER_6_UP}
+ procedure CheckEditProperty(const Prop: IProperty);
+ {$ELSE}
+ procedure CheckEditProperty(Prop: TPropertyEditor);
+ {$ENDIF}
+ procedure EditProperty(Component: TPersistent; const PropName: AnsiString; const Designer: ITntDesigner);
end;
-procedure TWideStringProperty.Initialize;
-var
- I: Integer;
+{$IFDEF COMPILER_6_UP}
+procedure TPropertyEditorWithDialog.CheckEditProperty(const Prop: IProperty);
begin
- for I := 0 to PropCount - 1 do
- with TDelphi_5_PropertyEditor(Self).FPropList[I] do
- SetPropEntry(I, Instance, PropInfo);
+ if Prop.GetName = FPropName then
+ Prop.Edit;
end;
-{$ENDIF}
-procedure TWideStringProperty.Activate;
+procedure TPropertyEditorWithDialog.EditProperty(Component: TPersistent; const PropName: AnsiString; const Designer: ITntDesigner);
var
- Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
+ Components: IDesignerSelections;
begin
- FActivateWithoutGetValue := True;
- if (Win32PlatformIsUnicode) then begin
- Edit := GetOIPropInspEdit;
- if Assigned(Edit)
- and (not IsWindowUnicode(Edit.Handle)) then
- ReCreateUnicodeWnd(Edit, 'EDIT', True);
- end;
+ FPropName := PropName;
+ Components := TDesignerSelections.Create;
+ Components.Add(Component);
+ GetComponentProperties(Components, [tkClass], Designer, CheckEditProperty);
end;
-
-procedure TWideStringProperty.SetPropEntry(Index: Integer;
- AInstance: TPersistent; APropInfo: PPropInfo);
-begin
- inherited;
- with FPropList^[Index] do
- begin
- Instance := AInstance;
- PropInfo := APropInfo;
- end;
-end;
-
-function TWideStringProperty.GetWideStrValueAt(Index: Integer): WideString;
-begin
- with FPropList^[Index] do Result := GetWideStrProp(Instance, PropInfo);
-end;
-
-function TWideStringProperty.GetWideStrValue: WideString;
-begin
- Result := GetWideStrValueAt(0);
-end;
-
-procedure TWideStringProperty.SetWideStrValue(const Value: WideString);
-var
- I: Integer;
-begin
- for I := 0 to PropCount - 1 do
- with FPropList^[I] do SetWideStrProp(Instance, PropInfo, Value);
- Modified;
-end;
-
-function TWideStringProperty.GetWideVisualValue: WideString;
-begin
- if AllEqual then
- Result := GetWideStrValue
- else
- Result := '';
-end;
-
-procedure TWideStringProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
-begin
-{$IFDEF VER130}
- inherited;
{$ELSE}
- DefaultPropertyDrawName(Self, ACanvas, ARect);
-{$ENDIF}
-end;
-
-procedure TWideStringProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
-begin
- WideCanvasTextRect(ACanvas, ARect, ARect.Left + 1, ARect.Top + 1, GetWideVisualValue);
-end;
-
-function TWideStringProperty.AllEqual: Boolean;
-var
- I: Integer;
- V: WideString;
-begin
- Result := False;
- if PropCount > 1 then
- begin
- V := GetWideStrValue;
- for I := 1 to PropCount - 1 do
- if GetWideStrValueAt(I) <> V then Exit;
- end;
- Result := True;
-end;
-
-function TWideStringProperty.GetEditLimit: Integer;
-var
- Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
-begin
- Result := MaxInt;
- // GetEditLimit is called right after the inplace editor text has been set
- if Win32PlatformIsUnicode then begin
- Edit := GetOIPropInspEdit;
- if Assigned(Edit) then begin
- TntControl_SetText(Edit, GetWideStrValue);
- TntControl_SetHint(Edit, GetWideStrValue);
- end;
- end;
-end;
-
-function TWideStringProperty.GetValue: AnsiString;
-begin
- FActivateWithoutGetValue := False;
- Result := GetWideStrValue;
-end;
-
-procedure TWideStringProperty.SetValue(const Value: AnsiString);
-var
- Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
-begin
- if (not FActivateWithoutGetValue) then begin
- Edit := GetOIPropInspEdit;
- if Assigned(Edit) and Win32PlatformIsUnicode then
- SetWideStrValue(TntControl_GetText(Edit))
- else
- SetWideStrValue(Value);
- end;
-end;
-
-{ TWideCaptionProperty }
-
-function TWideCaptionProperty.GetAttributes: TPropertyAttributes;
-begin
- Result := [paMultiSelect, paAutoUpdate, paRevertable];
-end;
-
-{ TPropertyEditorWithDialog }
-type
- TPropertyEditorWithDialog = class
- private
- FPropName: AnsiString;
-{$IFDEF VER130}
- procedure CheckEditProperty(Prop: TPropertyEditor);
-{$ELSE}
- procedure CheckEditProperty(const Prop: IProperty);
-{$ENDIF}
- procedure EditProperty(Component: TPersistent; const PropName: AnsiString; const Designer: ICreateDesigner);
- end;
-
-{$IFDEF VER130}
procedure TPropertyEditorWithDialog.CheckEditProperty(Prop: TPropertyEditor);
begin
if Prop.GetName = FPropName then
Prop.Edit;
end;
-procedure TPropertyEditorWithDialog.EditProperty(Component: TPersistent; const PropName: AnsiString; const Designer: ICreateDesigner);
+
+procedure TPropertyEditorWithDialog.EditProperty(Component: TPersistent; const PropName: AnsiString; const Designer: ITntDesigner);
var
Components: TDesignerSelectionList;
begin
@@ -362,24 +246,9 @@
Components.Free;
end;
end;
-{$ELSE}
-procedure TPropertyEditorWithDialog.CheckEditProperty(const Prop: IProperty);
-begin
- if Prop.GetName = FPropName then
- Prop.Edit;
-end;
-procedure TPropertyEditorWithDialog.EditProperty(Component: TPersistent; const PropName: AnsiString; const Designer: ICreateDesigner);
-var
- Components: IDesignerSelections;
-begin
- FPropName := PropName;
- Components := TDesignerSelections.Create;
- Components.Add(Component);
- GetComponentProperties(Components, [tkClass], Designer, CheckEditProperty);
-end;
{$ENDIF}
-procedure EditPropertyWithDialog(Component: TPersistent; const PropName: AnsiString; const Designer: ICreateDesigner);
+procedure EditPropertyWithDialog(Component: TPersistent; const PropName: AnsiString; const Designer: ITntDesigner);
begin
with TPropertyEditorWithDialog.Create do
try
@@ -389,9 +258,4 @@
end;
end;
-initialization
-
-finalization
- ConvertObjectInspectorBackToANSI;
-
end.
Modified: trunk/TntUnicodeControls/Design/TntExtCtrls.dcr
===================================================================
(Binary files differ)
Modified: trunk/TntUnicodeControls/Design/TntForms_Design.pas
===================================================================
--- trunk/TntUnicodeControls/Design/TntForms_Design.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Design/TntForms_Design.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,20 +1,24 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntForms_Design;
+{$INCLUDE ..\TntCompilers.inc}
+
interface
-uses Classes, Windows, {$IFDEF VER130} DsgnIntf, {$ELSE} DesignIntf, {$ENDIF} ToolsApi;
+uses
+ Classes, Windows, {$IFDEF COMPILER_6_UP} DesignIntf, {$ELSE} DsgnIntf, {$ENDIF} ToolsApi;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
type HICON = LongWord;
{$ENDIF}
@@ -40,7 +44,8 @@
implementation
-uses TntForms, {$IFNDEF VER130} DesignEditors, {$ENDIF} WCtlForm, TypInfo, SysUtils;
+uses
+ TntForms, {$IFDEF COMPILER_6_UP} DesignEditors, {$ENDIF} WCtlForm, TypInfo, SysUtils;
type
TTntNewTntFormWizard = class(TTntNewFormWizard)
@@ -61,17 +66,18 @@
TTntFrameCustomModule = class(TWinControlCustomModule)
public
-{$IFDEF VER130}
+ {$IFDEF COMPILER_6_UP}
+ function Nestable: Boolean; override;
+ {$ELSE}
class function Nestable: Boolean; override;
-{$ELSE}
- function Nestable: Boolean; override;
-{$ENDIF}
+ {$ENDIF}
end;
TTntFormCustomModule = class(TCustomModule)
-{$IFNDEF VER130}
+ public
+ {$IFDEF COMPILER_6_UP}
class function DesignClass: TComponentClass; override;
-{$ENDIF}
+ {$ENDIF}
end;
procedure Register;
@@ -79,6 +85,7 @@
RegisterCustomModule(TTntFrame{TNT-ALLOW TTntFrame}, TTntFrameCustomModule);
RegisterPackageWizard(TTntNewTntFrameWizard.Create);
//--
+ { TODO: Figure out how to get embedded designer working in Delphi 9 }
RegisterCustomModule(TTntForm{TNT-ALLOW TTntForm}, TTntFormCustomModule);
RegisterPackageWizard(TTntNewTntFormWizard.Create);
end;
@@ -100,19 +107,18 @@
end;
function MyGetActiveProject: IOTAProject;
-{$IFNDEF VER150}
+{$IFDEF COMPILER_7_UP}
+begin
+ Result := ToolsAPI.GetActiveProject;
+{$ELSE}
var
ProjectGroup: IOTAProjectGroup;
-{$ENDIF}
begin
-{$IFNDEF VER150}
ProjectGroup := GetFirstModuleSupporting(IOTAProjectGroup) as IOTAProjectGroup;
if ProjectGroup = nil then
Result := nil
else
Result := ProjectGroup.ActiveProject;
-{$ELSE}
- Result := ToolsAPI.GetActiveProject;
{$ENDIF}
if (Result = nil) then
Result := GetFirstModuleSupporting(IOTAProject) as IOTAProject;
@@ -280,7 +286,7 @@
StartPos: Integer;
begin
(* Warning: add the necessary routines for C++Builder *)
- Buffer := StrAlloc(UnitFileSize);
+ Buffer := StrAlloc{TNT-ALLOW StrAlloc}(UnitFileSize);
Editor := (Module.GetModuleFileEditor(0)) as IOTASourceEditor;
try
Reader := Editor.CreateReader;
@@ -307,7 +313,7 @@
end;
finally
Editor := nil;
- StrDispose(Buffer);
+ StrDispose{TNT-ALLOW StrDispose}(Buffer);
end;
end;
@@ -316,7 +322,10 @@
Module: IOTAModule;
begin
Module := (BorlandIDEServices as IOTAModuleServices).CreateModule(TTntNewFormCreator.Create('', ThisFormName));
+ {$IFNDEF COMPILER_9_UP}
+ {TODO: Get AddUnitToUses() working with D9.}
AddUnitToUses(Module, GetTypeData(PTypeInfo(ThisFormClass.ClassInfo)).UnitName);
+ {$ENDIF}
end;
{ TTntNewTntFormWizard }
@@ -355,10 +364,10 @@
{ TTntFrameCustomModule }
-{$IFDEF VER130}
+{$IFDEF COMPILER_6_UP}
+function TTntFrameCustomModule.Nestable: Boolean;
+{$ELSE}
class function TTntFrameCustomModule.Nestable: Boolean;
-{$ELSE}
-function TTntFrameCustomModule.Nestable: Boolean;
{$ENDIF}
begin
Result := True;
@@ -366,7 +375,7 @@
{ TTntFormCustomModule }
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
class function TTntFormCustomModule.DesignClass: TComponentClass;
begin
Result := TTntForm{TNT-ALLOW TTntForm};
Modified: trunk/TntUnicodeControls/Design/TntMenus_Design.pas
===================================================================
--- trunk/TntUnicodeControls/Design/TntMenus_Design.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Design/TntMenus_Design.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,23 +1,38 @@
+{*****************************************************************************}
+{ }
+{ 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 TntMenus_Design;
+
+{$INCLUDE ..\TntCompilers.inc}
+
{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
{ Special Thanks to Francisco Leong for getting these }
{ menu designer enhancements to work on Delphi 5. }
{*******************************************************}
-unit TntMenus_Design;
-
interface
-uses Windows, Classes, Menus, TntMenus, Forms, Messages, Controls,
- {$IFDEF VER130} DsgnIntf; {$ELSE} MnuBuild, DesignEditors, DesignIntf; {$ENDIF}
+{$IFDEF COMPILER_6}
+ {$DEFINE MNUBUILD_AVAILABLE}
+{$ENDIF}
+{$IFDEF COMPILER_7}
+ {$DEFINE MNUBUILD_AVAILABLE}
+{$ENDIF}
+
+uses
+ Windows, Classes, Menus, TntMenus, Forms, Messages, Controls,
+ {$IFDEF MNUBUILD_AVAILABLE} MnuBuild, {$ENDIF}
+ {$IFDEF COMPILER_6_UP} DesignEditors, DesignIntf; {$ELSE} DsgnIntf; {$ENDIF}
+
type
TTntMenuEditor = class(TComponentEditor)
public
@@ -30,7 +45,8 @@
implementation
-uses {$IFDEF VER130} DsgnWnds, {$ELSE} MnuConst, {$ENDIF} SysUtils, Graphics, ActnList,
+uses
+ {$IFDEF MNUBUILD_AVAILABLE} MnuConst, {$ELSE} {$IFNDEF COMPILER_6_UP} DsgnWnds, {$ELSE} DesignWindows, {$ENDIF} {$ENDIF} SysUtils, Graphics, ActnList,
Dialogs, TntDesignEditors_Design, TntActnList;
procedure Register;
@@ -40,7 +56,10 @@
end;
function GetMenuBuilder: TForm{TNT-ALLOW TForm};
-{$IFDEF VER130}
+{$IFDEF MNUBUILD_AVAILABLE}
+begin
+ Result := MenuEditor;
+{$ELSE}
var
Comp: TComponent;
begin
@@ -51,13 +70,10 @@
if Comp is TForm{TNT-ALLOW TForm} then
Result := TForm{TNT-ALLOW TForm}(Comp);
end;
-{$ELSE}
-begin
- Result := MenuEditor;
{$ENDIF}
end;
-{$IFDEF VER130}
+{$IFDEF COMPILER_5} // verified against Delphi 5 and BCB 5
type
THackMenuBuilder = class(TDesignWindow)
protected
@@ -66,22 +82,31 @@
end;
{$ENDIF}
+{$IFDEF DELPHI_9} // verified against Delphi 9
+type
+ THackMenuBuilder = class(TDesignWindow)
+ protected
+ Fields: array[1..26] of TObject;
+ FWorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
+ end;
+{$ENDIF}
+
function GetMenuBuilder_WorkMenu(MenuBuilder: TForm{TNT-ALLOW TForm}): TMenuItem{TNT-ALLOW TMenuItem};
begin
if MenuBuilder = nil then
Result := nil
else begin
- {$IFDEF VER130}
+ {$IFDEF MNUBUILD_AVAILABLE}
+ Result := MenuEditor.WorkMenu;
+ {$ELSE}
Result := THackMenuBuilder(MenuBuilder).FWorkMenu;
Assert((Result = nil) or (Result is TMenuItem{TNT-ALLOW TMenuItem}),
'TNT Internal Error: THackMenuBuilder has incorrect internal layout.');
- {$ELSE}
- Result := MenuEditor.WorkMenu;
{$ENDIF}
end;
end;
-{$IFDEF VER130}
+{$IFDEF COMPILER_5} // verified against Delphi 5 and BCB 5
type
THackMenuItemWin = class(TCustomControl)
protected
@@ -90,17 +115,26 @@
end;
{$ENDIF}
+{$IFDEF DELPHI_9} // verified against Delphi 9
+type
+ THackMenuItemWin = class(TCustomControl)
+ protected
+ FxxxxCaptionExtent: Integer;
+ FMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
+ end;
+{$ENDIF}
+
function GetMenuItem(Control: TWinControl; DoVerify: Boolean = True): TMenuItem{TNT-ALLOW TMenuItem};
begin
-{$IFDEF VER130}
+ {$IFDEF MNUBUILD_AVAILABLE}
+ if Control is TMenuItemWin then
+ Result := TMenuItemWin(Control).MenuItem
+ {$ELSE}
if Control.ClassName = 'TMenuItemWin' then begin
Result := THackMenuItemWin(Control).FMenuItem;
Assert((Result = nil) or (Result is TMenuItem{TNT-ALLOW TMenuItem}), 'TNT Internal Error: Unexpected TMenuItem field layout.');
end
-{$ELSE}
- if Control is TMenuItemWin then
- Result := TMenuItemWin(Control).MenuItem
-{$ENDIF}
+ {$ENDIF}
else if DoVerify then
raise Exception.Create('TNT Internal Error: Control is not a TMenuItemWin.')
else
@@ -109,10 +143,15 @@
procedure SetMenuItem(Control: TWinControl; Item: TMenuItem{TNT-ALLOW TMenuItem});
begin
-{$IFDEF VER130}
+ {$IFDEF MNUBUILD_AVAILABLE}
+ if Control is TMenuItemWin then
+ TMenuItemWin(Control).MenuItem := Item
+ {$ELSE}
if Control.ClassName = 'TMenuItemWin' then begin
THackMenuItemWin(Control).FMenuItem := Item;
+ Item.FreeNotification(Control);
// quick and dirty way to update object inspector (this doesn't seem to make a difference)
+ {$IFNDEF COMPILER_6_UP}
with GetMenuBuilder do
begin
LockWindowUpdate(GetDesktopWindow);
@@ -123,11 +162,9 @@
LockWindowUpdate(0);
end;
end;
+ {$ENDIF}
end
-{$ELSE}
- if Control is TMenuItemWin then
- TMenuItemWin(Control).MenuItem := Item
-{$ENDIF}
+ {$ENDIF}
else
raise Exception.Create('TNT Internal Error: Control is not a TMenuItemWin.');
end;
@@ -138,15 +175,16 @@
OldName: string{TNT-ALLOW string};
begin
OldItem := GetMenuItem(Control, True);
+ Assert(OldItem <> nil);
OldName := OldItem.Name;
- {$IFDEF VER130}
- SetMenuItem(Control, ANewItem);
+ {$IFDEF COMPILER_6_UP}
FreeAndNil(OldItem);
ANewItem.Name := OldName; { assume old name }
+ SetMenuItem(Control, ANewItem);
{$ELSE}
+ SetMenuItem(Control, ANewItem);
FreeAndNil(OldItem);
ANewItem.Name := OldName; { assume old name }
- SetMenuItem(Control, ANewItem);
{$ENDIF}
end;
@@ -203,9 +241,9 @@
Result := TTntMenuItem.Create(OldItem.Owner);
TAccessTntMenuItem(Result).FComponentStyle := OldItem.ComponentStyle; {csTransient hides item from object inspector}
Result.Action := OldItem.Action;
- {$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
Result.AutoCheck := OldItem.AutoCheck;
- {$ENDIF}
+ {$ENDIF}
Result.AutoHotkeys := OldItem.AutoHotkeys;
Result.AutoLineReduction := OldItem.AutoLineReduction;
Result.Bitmap := OldItem.Bitmap;
@@ -260,7 +298,7 @@
if (OldItem.ClassType = TMenuItem{TNT-ALLOW TMenuItem})
and (PartOfATntMenu or (OldItem.Parent is TTntMenuItem)) then
begin
- {$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
if MenuItemWin.Focused then
MenuItemWin.Parent.SetFocus; {Lose focus and regain later to ensure object inspector gets updated.}
{$ENDIF}
@@ -268,7 +306,7 @@
end else if (OldItem.ClassType = TTntMenuItem)
and (OldItem.Parent = nil) and (OldItem.Caption = '') and (OldItem.Name = '')
and not (PartOfATntMenu or (OldItem.Parent is TTntMenuItem)) then begin
- {$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
if MenuItemWin.Focused then
MenuItemWin.Parent.SetFocus; {Lose focus and regain later to ensure object inspector gets updated.}
{$ENDIF}
@@ -299,18 +337,18 @@
and ((WorkMenu.Owner is TTntMainMenu) or (WorkMenu.Owner is TTntPopupMenu));
SaveFocus := Windows.GetFocus;
for a := ComponentCount - 1 downto 0 do begin
- {$IFDEF VER130}
+ {$IFDEF MNUBUILD_AVAILABLE}
+ if Components[a] is TMenuWin then begin
+ {$ELSE}
if Components[a].ClassName = 'TMenuWin' then begin
- {$ELSE}
- if Components[a] is TMenuWin then begin
{$ENDIF}
MenuWin := Components[a] as TWinControl;
with MenuWin do begin
for i := ComponentCount - 1 downto 0 do begin
- {$IFDEF VER130}
+ {$IFDEF MNUBUILD_AVAILABLE}
+ if Components[i] is TMenuItemWin then begin
+ {$ELSE}
if Components[i].ClassName = 'TMenuItemWin' then begin
- {$ELSE}
- if Components[i] is TMenuItemWin then begin
{$ENDIF}
MenuItemWin := Components[i] as TWinControl;
CheckMenuItemWin(MenuItemWin, PartOfATntMenu);
@@ -343,7 +381,7 @@
Result := 1;
end;
-{$IFDEF VER130}
+{$IFNDEF MNUBUILD_AVAILABLE}
resourcestring
SMenuDesigner = 'Menu Designer...';
{$ENDIF}
@@ -371,6 +409,6 @@
initialization
finalization
- MenuBuilderChecker.Free; // design package might be recompiled
+ MenuBuilderChecker.Free; // design package might be recompiled
end.
Modified: trunk/TntUnicodeControls/Design/TntStrEdit_Design.dfm
===================================================================
(Binary files differ)
Modified: trunk/TntUnicodeControls/Design/TntStrEdit_Design.pas
===================================================================
--- trunk/TntUnicodeControls/Design/TntStrEdit_Design.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Design/TntStrEdit_Design.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,29 +1,32 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntStrEdit_Design;
+
+{$INCLUDE ..\TntCompilers.inc}
+
// The following unit is adapted from StrEdit.pas.
-unit TntStrEdit_Design;
-
interface
-uses Windows, Classes, Graphics, Forms, Controls, Buttons, Dialogs, Menus, StdCtrls,
- TntStdCtrls, ExtCtrls, {$IFDEF VER130} DsgnIntf, {$ELSE} DesignEditors, DesignIntf, {$ENDIF}
- {$IFDEF JCL} JclUnicode, {$ELSE} Unicode, {$ENDIF} TntForms, TntMenus,
- TntExtCtrls;
+uses
+ Windows, Classes, Graphics, Forms, Controls, Buttons, Dialogs, Menus, StdCtrls,
+ TntStdCtrls, ExtCtrls, {$IFDEF COMPILER_6_UP} DesignEditors, DesignIntf, {$ELSE} DsgnIntf, {$ENDIF}
+ TntForms, TntMenus, TntExtCtrls, TntClasses, TntDialogs;
type
TTntStrEditDlg = class(TTntForm{TNT-ALLOW TTntForm})
CodeWndBtn: TTntButton;
- OpenDialog: TOpenDialog{TNT-ALLOW TOpenDialog};
- SaveDialog: TSaveDialog{TNT-ALLOW TSaveDialog};
+ OpenDialog: TTntOpenDialog;
+ SaveDialog: TTntSaveDialog;
HelpButton: TTntButton;
OKButton: TTntButton;
CancelButton: TTntButton;
@@ -31,10 +34,10 @@
LoadItem: TTntMenuItem;
SaveItem: TTntMenuItem;
CodeEditorItem: TTntMenuItem;
- Bevel1: TTntBevel;
+ TntGroupBox1: TTntGroupBox;
+ UnicodeEnabledLbl: TTntLabel;
Memo: TTntMemo;
LineCount: TTntLabel;
- UnicodeEnabledLbl: TTntLabel;
procedure FileOpenClick(Sender: TObject);
procedure FileSaveClick(Sender: TObject);
procedure HelpButtonClick(Sender: TObject);
@@ -47,19 +50,20 @@
MultipleLines: WideString;
protected
FModified: Boolean;
- function GetLines: TWideStrings;
- procedure SetLines(const Value: TWideStrings);
+ function GetLines: TTntStrings;
+ procedure SetLines(const Value: TTntStrings);
function GetLinesControl: TWinControl;
public
- property Lines: TWideStrings read GetLines write SetLines;
+ property Lines: TTntStrings read GetLines write SetLines;
+ procedure PrepareForWideStringEdit;
end;
type
TWideStringListProperty = class(TClassProperty)
protected
function EditDialog: TTntStrEditDlg; virtual;
- function GetStrings: TWideStrings; virtual;
- procedure SetStrings(const Value: TWideStrings); virtual;
+ function GetStrings: TTntStrings; virtual;
+ procedure SetStrings(const Value: TTntStrings); virtual;
public
function GetAttributes: TPropertyAttributes; override;
procedure Edit; override;
@@ -71,12 +75,13 @@
{$R *.dfm}
-uses ActiveX, SysUtils, DesignConst, ToolsAPI, IStreams, LibHelp,
- StFilSys, TypInfo, TntDesignEditors_Design, TntClasses;
+uses
+ ActiveX, SysUtils, DesignConst, ToolsAPI, IStreams, LibHelp,
+ StFilSys, TypInfo, TntDesignEditors_Design, TntSysUtils;
procedure Register;
begin
- RegisterPropertyEditor(TypeInfo(TWideStrings), nil, '', TWideStringListProperty);
+ RegisterPropertyEditor(TypeInfo(TTntStrings), nil, '', TWideStringListProperty);
end;
type
@@ -172,11 +177,11 @@
function TStringsModuleCreator.GetExisting: Boolean;
begin
-{$IFDEF VER130}
+ {$IFDEF COMPILER_6_UP}
+ Result := True;
+ {$ELSE}
Result := False;
-{$ELSE}
- Result := True;
-{$ENDIF}
+ {$ENDIF}
end;
function TStringsModuleCreator.GetFileSystem: AnsiString;
@@ -254,6 +259,13 @@
UnicodeEnabledLbl.Visible := IsWindowUnicode(Memo.Handle);
end;
+procedure TTntStrEditDlg.PrepareForWideStringEdit;
+begin
+ Caption := 'WideString Editor';
+ CodeWndBtn.Visible := False;
+ CodeEditorItem.Visible := False;
+end;
+
procedure TTntStrEditDlg.FileOpenClick(Sender: TObject);
begin
with OpenDialog do
@@ -275,7 +287,7 @@
procedure TTntStrEditDlg.CodeWndBtnClick(Sender: TObject);
begin
if (Memo.Text = WideString(AnsiString(Memo.Text)))
- or (mrYes = MessageDlg(
+ or (mrYes = WideMessageDlg(
'These strings contain extended characters which can not be converted to ANSI.'#13#10
+ 'Using the code editor could cause the loss of these extended characters.'#13#10
+ #13#10
@@ -306,12 +318,12 @@
LineCount.Caption := WideFormat('%d %s', [Count, LineText]);
end;
-function TTntStrEditDlg.GetLines: TWideStrings;
+function TTntStrEditDlg.GetLines: TTntStrings;
begin
Result := Memo.Lines;
end;
-procedure TTntStrEditDlg.SetLines(const Value: TWideStrings);
+procedure TTntStrEditDlg.SetLines(const Value: TTntStrings);
begin
Memo.Lines.Assign(Value);
end;
@@ -328,12 +340,12 @@
Result := inherited GetAttributes + [paDialog] - [paSubProperties];
end;
-function TWideStringListProperty.GetStrings: TWideStrings;
+function TWideStringListProperty.GetStrings: TTntStrings;
begin
- Result := TWideStrings(GetOrdValue);
+ Result := TTntStrings(GetOrdValue);
end;
-procedure TWideStringListProperty.SetStrings(const Value: TWideStrings);
+procedure TWideStringListProperty.SetStrings(const Value: TTntStrings);
begin
SetOrdValue(Longint(Value));
end;
@@ -352,9 +364,9 @@
ModuleServices := BorlandIDEServices as IOTAModuleServices;
if (TObject(Component) is TComponent)
and (Component.Owner = Self.Designer.GetRoot)
-{$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
and (Self.Designer.GetRoot.Name <> '')
-{$ENDIF}
+ {$ENDIF}
then begin
Ident := Self.Designer.GetRoot.Name + DotSep +
Component.Name + DotSep + GetName;
@@ -376,13 +388,13 @@
mrOk: SetStrings(Lines);
mrYes:
begin
-{$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
// this used to be done in LibMain's TLibrary.Create but now its done here
// the unregister is done over in ComponentDesigner's finalization
StFilSys.Register;
-{$ENDIF}
+ {$ENDIF}
Stream := TStringStream{TNT-ALLOW TStringStream}.Create('');
- Lines.SaveToStream(Stream);
+ Lines.AnsiStrings.SaveToStream(Stream);
Stream.Position := 0;
Age := Now;
Module := ModuleServices.CreateModule(
Modified: trunk/TntUnicodeControls/Design/TntUnicodeVcl_Register.pas
===================================================================
--- trunk/TntUnicodeControls/Design/TntUnicodeVcl_Register.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Design/TntUnicodeVcl_Register.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,19 +1,34 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntUnicodeVcl_Register;
+{$INCLUDE ..\TntCompilers.inc}
+
interface
procedure Register;
implementation
-uses Classes, TntForms, TntMenus, TntStdCtrls, TntCheckLst, TntGrids, TntExtCtrls, TntComCtrls,
- TntButtons, TntActnList;
+uses
+ Classes, DB, TntForms, TntMenus, TntStdCtrls, TntCheckLst, TntGrids, TntExtCtrls, TntComCtrls,
+ TntButtons, TntDB, TntDBCtrls, TntDBGrids, TntActnList, TntDialogs, TntExtDlgs;
const
TNT_STANDARD = 'Tnt Standard';
TNT_ADDITIONAL = 'Tnt Additional';
TNT_WIN32 = 'Tnt Win32';
- //TNT_DATA_CONTROLS = 'Tnt Data Controls';
+ TNT_DATA_CONTROLS = 'Tnt Data Controls';
+ TNT_DIALOGS = 'Tnt Dialogs';
procedure Register;
begin
@@ -30,7 +45,7 @@
RegisterComponents(TNT_STANDARD, [TTntComboBox]);
RegisterComponents(TNT_STANDARD, [TTntScrollBar]);
RegisterComponents(TNT_STANDARD, [TTntGroupBox]);
- { -- TTntRadioGroup goes here -- }
+ RegisterComponents(TNT_STANDARD, [TTntRadioGroup]);
RegisterComponents(TNT_STANDARD, [TTntPanel]);
RegisterComponents(TNT_STANDARD, [TTntActionList]);
@@ -45,7 +60,7 @@
RegisterComponents(TNT_ADDITIONAL, [TTntBevel]);
RegisterComponents(TNT_ADDITIONAL, [TTntScrollBox]);
RegisterComponents(TNT_ADDITIONAL, [TTntCheckListBox]);
- { -- TTntSplitter goes here -- }
+ RegisterComponents(TNT_ADDITIONAL, [TTntSplitter]);
RegisterComponents(TNT_ADDITIONAL, [TTntStaticText]);
RegisterComponents(TNT_ADDITIONAL, [TTntControlBar]);
@@ -60,10 +75,10 @@
{ -- TTntAnimate goes here -- }
RegisterComponents(TNT_WIN32, [TTntDateTimePicker]);
RegisterComponents(TNT_WIN32, [TTntMonthCalendar]);
- { -- TTntTreeView goes here -- }
+ RegisterComponents(TNT_WIN32, [TTntTreeView]);
RegisterComponents(TNT_WIN32, [TTntListView]);
{ -- TTntHeader goes here -- }
- { -- TTntStatusBar goes here -- }
+ RegisterComponents(TNT_WIN32, [TTntStatusBar]);
{ -- TTntToolBar goes here -- }
{ -- TTntCoolBar goes here -- }
RegisterComponents(TNT_WIN32, [TTntPageScroller]);
@@ -75,24 +90,35 @@
{ -- TTntOleContainer goes here -- }
// ------- Data Controls -------
- //RegisterComponents(TNT_DATA_CONTROLS, [TTntDBGrid]);
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBGrid]);
{ -- TTntDBNavigator goes here -- }
- { -- TTntDBText goes here -- }
- //RegisterComponents(TNT_DATA_CONTROLS, [TTntDBEdit]);
- { -- TTntDBMemo goes here -- }
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBText]);
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBEdit]);
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBMemo]);
{ -- TTntDBImage goes here -- }
{ -- TTntDBListBox goes here -- }
- //RegisterComponents(TNT_DATA_CONTROLS, [TTntDBComboBox]);
- //RegisterComponents(TNT_DATA_CONTROLS, [TTntDBCheckBox]);
- { -- TTntDBRadioGroup goes here -- }
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBComboBox]);
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBCheckBox]);
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBRadioGroup]);
{ -- TTntDBLookupListBox goes here -- }
{ -- TTntDBLookupComboBox goes here -- }
- { -- TTntDBRichEdit goes here -- }
+ RegisterComponents(TNT_DATA_CONTROLS, [TTntDBRichEdit]);
{ -- TTntDBCtrlGrid here -- }
{ -- TTntDBLookupListBox goes here -- }
{ -- TTntDBChart goes here -- }
+ // ------- Dialogs -------
+ RegisterComponents(TNT_DIALOGS, [TTntOpenDialog]);
+ RegisterComponents(TNT_DIALOGS, [TTntSaveDialog]);
+ RegisterComponents(TNT_DIALOGS, [TTntOpenPictureDialog]);
+ RegisterComponents(TNT_DIALOGS, [TTntSavePictureDialog]);
+
+ // --------- Fields --------------
+ RegisterTntFields;
+
+ // --------- Classes --------------
+ RegisterClass(TTntMenuItem);
+ RegisterClass(TTntTabSheet);
end;
-
end.
Modified: trunk/TntUnicodeControls/Readme.txt
===================================================================
--- trunk/TntUnicodeControls/Readme.txt 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Readme.txt 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,10 +1,24 @@
** Tnt Delphi UNICODE Controls Project **
-Website: http://home.ccci.org/wolbrink/tntmpd/delphi_unicode_controls_project.htm
-Email: wolbrink at ccci.org
+Website: http://tnt.ccci.org/delphi_unicode_controls/
+Email: troy.wolbrink at ccci.org
These controls are provided as-is, with no implied warranty. They are freely available for you to use in your own projects. Please let me know if you have found them helpful. Also, please let me know if you find any bugs or other areas of needed improvement.
+
+---Delphi Installation--------------------------
+
+The most simple way to install these components is by opening the appropriate design package in Delphi and clicking on the big "Install" button. For instance, Delphi 5's design package is TntUnicodeVcl_D50.dpk.
+
+---A note on fonts----------------------
+
+The default TFont uses "MS Sans Serif" which doesn't work well with most non-ANSI characters. I'd recommend using a TrueType font such as "Tahoma" if it is installed on the machine. To make TFont use a different font like "Tahoma" add this to the first line in the project:
+
+ Graphics.DefFontData.Name := 'Tahoma';
+
+You might have to include "Graphics" in the file's uses clauses. Furthermore, adding this line of code to the project will cause the changed setting to only be applied at runtime, not at design time. To make a designtime change, you'd have to add this line to the initialization section of a unit in a design package.
+
+
---Background----------------------------
Designing software for an international audience, I've always wanted to write a full UNICODE application. My approach so far, has been to write Unicode on the inside, and MBCS on the outside. This has always been frustrating, because (even on Windows NT/2000/XP which provide native Unicode window controls) the WideStrings inside my application and databases were always confined to an ANSI VCL. And, since the VCL was designed to wrap the low-level Windows details, why shouldn't the VCL hide the fact that sometimes native Unicode controls are not possible on the given version of Windows. I believe the VCL should be written with a Unicode interface, even if it must (at times) deal with an ANSI operating system. For example, TEdit should expose Text as a WideString, even if it has to convert the WideString to an AnsiString on the Windows 9X platform.
@@ -13,21 +27,20 @@
My coding signature is Tnt. I will use this to denote my classes from others.
-For more information about me: <http://home.ccci.org/wolbrink/index.htm>
-Some of my software projects (all written in Delphi).
- TntMPD (contact manager for missionaries) <http://home.ccci.org/wolbrink/tntmpd/index.htm>
- Jesus Film Screen Saver <http://home.ccci.org/wolbrink/screensaver.htm>
- ActiveX SCR control <http://home.ccci.org/wolbrink/TntBin/ActiveXSCR.exe>
+For more information about me: <http://home.ccci.org/wolbrink/>
+Some of my software projects (all written in Delphi).
+ TntMPD (contact manager for missionaries)
+ <http://www.tntmpd.com/>
+ Jesus Film Screen Saver
+ <http://home.ccci.org/wolbrink/screensaver.htm>
+ ActiveX SCR control
+ <http://tnt.ccci.org/download/activex_scr/ActiveXSCR.exe>
---Design Goals----------------------------
I want the controls to work on Windows 95, 98, ME, NT, 2000, XP, etc. I want a single EXE for all platforms. Of course, full UNICODE support is only truly available on NT/2000/XP. In other words, the controls should automatically scale to take advantage of native Unicode support when possible.
-I want the controls to inherit from the Delphi VCL. I want to reuse as much code as possible. For the most part this makes sense. The only sticky part is where text messages get passed around. But I believe I've gotten past this through strategic subclassing at various points in the message flow chain. To give a rough comparison of why this is so important, check out the following chart which compares the lines of code in the VCL for a given control (4,397 in all), and the lines of code required in my descendent controls (655 in all). Besides saving lines of code, I get the advantage of automatically inheriting new features as new versions of Delphi come out. One such example is the AlphaBlending feature in the Delphi 6 TForm. Even though I use Delphi 5 now, I won't have to add any code to get this new feature.
+I want the controls to inherit from the Delphi VCL. I want to reuse as much code as possible. For the most part this makes sense. The only sticky part is where text messages get passed around. But I believe I've gotten past this through strategic subclassing at various points in the message flow chain. To give a rough comparison of why this is so important, check out the following chart which compares the lines of code in the VCL for a given control (4,397 in all), and the lines of code required in my descendent controls (655 in all). Besides saving lines of code, I get the advantage of automatically inheriting new features as new versions of Delphi come out. One such example is the AlphaBlending feature in the Delphi 6 TForm. Even though I use Delphi 5 now, I won't have to add any code to get this new feature.
----Credits----------------------------
-
-I found the TWideStrings and TWideStringList classes from Mike Lischke's Delphi Unicode Center very helpful. In fact, Mike's Unicode.pas file is required to compile my code. I have included a copy in my distribution with my own fixes and enhancements.
-
---More Interesting Information----------------------------
Case Study: Porting an MFC Application to Unicode: It looks like the FrontPage 2002 team did the roughly the same thing to MFC as what I'm doing to the VCL. They did this with the same goal in mind: to support Unicode as much as possible depending on the support offered by Windows. Another goal was "Don’t abandon MFC; don’t rewrite app". Because they still want to support Windows 9X using the same worldwide EXE used everywhere. They couldn't just compile with the _UNICODE directive. They had to start with the ANSI MFC, strategically subclassing window procedures at just the right places. Hmmm... sounds familiar.
\ No newline at end of file
Modified: trunk/TntUnicodeControls/TntActnList.pas
===================================================================
--- trunk/TntUnicodeControls/TntActnList.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntActnList.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,8 +1,22 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntActnList;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, Controls, ActnList, Buttons, TntControls, ExtCtrls, ComCtrls, StdCtrls, Menus;
+uses
+ Classes, Controls, ActnList, Buttons, TntControls, ExtCtrls, ComCtrls, StdCtrls, Menus;
type
{TNT-WARN TActionList}
@@ -72,7 +86,7 @@
// CONTROL ACTION LINKS
//---------------------------------------------------------------------------------------------
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
{TNT-WARN TListViewActionLink}
TTntListViewActionLink = class(TListViewActionLink{TNT-ALLOW TListViewActionLink})
@@ -161,17 +175,9 @@
implementation
-uses TntWideStrPropHelper, SysUtils, TntMenus;
+uses
+ SysUtils, TntMenus, TntClasses, TntSysUtils;
-{$IFDEF VER130}
-function Supports(const Instance: TObject; const IID: TGUID): Boolean;
-var
- Temp: IUnknown;
-begin
- Result := Instance.GetInterface(IID, Temp);
-end;
-{$ENDIF}
-
{ TActionListList }
type
@@ -196,24 +202,30 @@
{ THackActionList }
type
-{$IFDEF VER130} // Delphi 5
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
THackCustomActionList = class(TComponent)
private
FActions: TList;
end;
{$ENDIF}
-{$IFDEF VER140} // Delphi 6
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
THackCustomActionList = class(TComponent)
private
FActions: TList;
end;
{$ENDIF}
-{$IFDEF VER150} // Delphi 7
+{$IFDEF DELPHI_7}
THackCustomActionList = class(TComponent)
private
FActions: TList;
end;
{$ENDIF}
+{$IFDEF DELPHI_9}
+ THackCustomActionList = class(TComponent)
+ private
+ FActions: TList;
+ end;
+{$ENDIF}
{ TTntActionList }
@@ -271,6 +283,8 @@
procedure TCustomActionHelper.SetAnsiCaption(const Value: AnsiString);
begin
FAction.Caption := Value;
+ if (Value = '') and (FNewAnsiCaption <> '') then
+ FOldWideCaption := '';
end;
function TCustomActionHelper.SettingNewCaption: Boolean;
@@ -301,6 +315,8 @@
procedure TCustomActionHelper.SetAnsiHint(const Value: AnsiString);
begin
FAction.Hint := Value;
+ if (Value = '') and (FNewAnsiHint <> '') then
+ FOldWideHint := '';
end;
function TCustomActionHelper.SettingNewHint: Boolean;
@@ -374,9 +390,7 @@
if Supports(Action, ITntAction) then
with FindActionHelper(Action) do
if SettingNewCaption then
- Result := FCaption
- else
- raise Exception.Create('TNT Internal Error: SettingNewCaption was expected.');
+ Result := FCaption;
end;
procedure TntAction_SetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
@@ -403,9 +417,7 @@
if Supports(Action, ITntAction) then
with FindActionHelper(Action) do
if SettingNewHint then
- Result := FHint
- else
- raise Exception.Create('TNT Internal Error: SettingNewHint was expected.');
+ Result := FHint;
end;
procedure TntAction_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
@@ -425,7 +437,7 @@
function TntControl_GetActionLinkClass(Control: TControl; InheritedLinkClass: TControlActionLinkClass): TControlActionLinkClass;
begin
- {$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
if Control is TCustomListView{TNT-ALLOW TCustomListView} then
Result := TTntListViewActionLink
else if Control is TComboBoxEx then
@@ -499,7 +511,7 @@
procedure TTntCustomAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomAction.GetCaption: WideString;
@@ -533,7 +545,7 @@
procedure TTntAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntAction.GetCaption: WideString;
@@ -590,7 +602,7 @@
// CONTROL ACTION LINKS
//---------------------------------------------------------------------------------------------
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
{ TTntListViewActionLink }
Modified: trunk/TntUnicodeControls/TntButtons.pas
===================================================================
--- trunk/TntUnicodeControls/TntButtons.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntButtons.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,14 +1,34 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntButtons;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
+uses
+ Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
ExtCtrls, CommCtrl, Buttons,
- TntWideStrPropHelper, TntForms, TntControls, TntStdCtrls;
+ TntForms, TntControls, TntStdCtrls;
type
+ ITntGlyphButton = interface
+ ['{15D7E501-1E33-4293-8B45-716FB3B14504}']
+ function GetButtonGlyph: Pointer;
+ procedure UpdateInternalGlyphList;
+ end;
+
{TNT-WARN TSpeedButton}
- TTntSpeedButton = class(TSpeedButton{TNT-ALLOW TSpeedButton})
+ TTntSpeedButton = class(TSpeedButton {TNT-ALLOW TSpeedButton}, ITntGlyphButton)
private
FPaintInherited: Boolean;
function GetCaption: TWideCaption;
@@ -19,8 +39,10 @@
function IsHintStored: Boolean;
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- procedure UpdateInternalGlyphList;
protected
+ function GetButtonGlyph: Pointer;
+ procedure UpdateInternalGlyphList; dynamic;
+ procedure PaintButton; dynamic;
procedure Paint; override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
@@ -31,7 +53,7 @@
end;
{TNT-WARN TBitBtn}
- TTntBitBtn = class(TBitBtn{TNT-ALLOW TBitBtn})
+ TTntBitBtn = class(TBitBtn {TNT-ALLOW TBitBtn}, ITntGlyphButton)
private
FPaintInherited: Boolean;
FMouseInControl: Boolean;
@@ -43,11 +65,12 @@
procedure SetHint(const Value: WideString);
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
- procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
- procedure UpdateInternalGlyphList;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
+ function GetButtonGlyph: Pointer;
+ procedure UpdateInternalGlyphList; dynamic;
+ procedure DrawItem(const DrawItemStruct: TDrawItemStruct); dynamic;
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
@@ -59,18 +82,28 @@
procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
- Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect; BiDiFlags: Integer);
+ Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
+ BiDiFlags: Integer {$IFDEF DELPHI_7_UP}; WordWrap: Boolean {$ENDIF});
+function TButtonGlyph_Draw(Control: TControl; Canvas: TCanvas; const Client: TRect;
+ const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout; Margin: Integer;
+ Spacing: Integer; State: TButtonState; Transparent: Boolean;
+ BiDiFlags: Longint {$IFDEF DELPHI_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
+
implementation
-uses SysUtils, TypInfo, {$IFDEF VER130} Consts, {$ELSE} RTLConsts, {$ENDIF}
- {$IFDEF VER150} Themes, {$ENDIF} TntClasses, TntGraphics, TntActnList, ActnList;
+uses
+ SysUtils, TypInfo, {$IFDEF COMPILER_6_UP} RTLConsts, {$ELSE} Consts, {$ENDIF} TntWindows,
+ {$IFDEF THEME_7_UP} Themes, {$ENDIF} TntClasses, TntActnList, ActnList, TntSysUtils;
+type
+ EAbortPaint = class(EAbort);
+
// Many routines in this unit are nearly the same as those found in Buttons.pas. They are
// included here because the VCL implementation of TButtonGlyph is completetly inaccessible.
type
- THackButtonGlyph_D5_D6_D7 = class
+ THackButtonGlyph_D5_D6_D7_D9 = class
protected
FOriginal: TBitmap;
FGlyphList: TImageList;
@@ -79,7 +112,7 @@
FNumGlyphs: TNumGlyphs;
end;
- THackBitBtn_D5_D6_D7 = class(TButton{TNT-ALLOW TButton})
+ THackBitBtn_D5_D6_D7_D9 = class(TButton{TNT-ALLOW TButton})
protected
FCanvas: TCanvas;
FGlyph: Pointer;
@@ -91,7 +124,7 @@
IsFocused: Boolean;
end;
- THackSpeedButton_D5_D6_D7 = class(TGraphicControl)
+ THackSpeedButton_D5_D6_D7_D9 = class(TGraphicControl)
protected
FxxxxGroupIndex: Integer;
FGlyph: Pointer;
@@ -99,49 +132,59 @@
FDragging: Boolean;
end;
- {$IFDEF VER130} // Delphi 5
- THackButtonGlyph = THackButtonGlyph_D5_D6_D7;
- THackBitBtn = THackBitBtn_D5_D6_D7;
- THackSpeedButton = THackSpeedButton_D5_D6_D7;
+ {$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
+ THackButtonGlyph = THackButtonGlyph_D5_D6_D7_D9;
+ THackBitBtn = THackBitBtn_D5_D6_D7_D9;
+ THackSpeedButton = THackSpeedButton_D5_D6_D7_D9;
{$ENDIF}
- {$IFDEF VER140} // Delphi 6
- THackButtonGlyph = THackButtonGlyph_D5_D6_D7;
- THackBitBtn = THackBitBtn_D5_D6_D7;
- THackSpeedButton = THackSpeedButton_D5_D6_D7;
+ {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+ THackButtonGlyph = THackButtonGlyph_D5_D6_D7_D9;
+ THackBitBtn = THackBitBtn_D5_D6_D7_D9;
+ THackSpeedButton = THackSpeedButton_D5_D6_D7_D9;
{$ENDIF}
- {$IFDEF VER150} // Delphi 7
- THackButtonGlyph = THackButtonGlyph_D5_D6_D7;
- THackBitBtn = THackBitBtn_D5_D6_D7;
- THackSpeedButton = THackSpeedButton_D5_D6_D7;
+ {$IFDEF DELPHI_7}
+ THackButtonGlyph = THackButtonGlyph_D5_D6_D7_D9;
+ THackBitBtn = THackBitBtn_D5_D6_D7_D9;
+ THackSpeedButton = THackSpeedButton_D5_D6_D7_D9;
{$ENDIF}
+ {$IFDEF DELPHI_9}
+ THackButtonGlyph = THackButtonGlyph_D5_D6_D7_D9;
+ THackBitBtn = THackBitBtn_D5_D6_D7_D9;
+ THackSpeedButton = THackSpeedButton_D5_D6_D7_D9;
+ {$ENDIF}
-function GetButtonGlyphObject(Control: TControl): THackButtonGlyph;
+function GetButtonGlyph(Control: TControl): THackButtonGlyph;
+var
+ GlyphButton: ITntGlyphButton;
begin
- if Control is TTntBitBtn then
- Result := THackBitBtn(Control).FGlyph
- else if Control is TTntSpeedButton then
- Result := THackSpeedButton(Control).FGlyph
+ if Control.GetInterface(ITntGlyphButton, GlyphButton) then
+ Result := GlyphButton.GetButtonGlyph
else
- raise Exception.Create('TNT Internal Error: wrong button class for GetButtonGlyphObject.');
+ raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
end;
+procedure UpdateInternalGlyphList(Control: TControl);
+var
+ GlyphButton: ITntGlyphButton;
+begin
+ if Control.GetInterface(ITntGlyphButton, GlyphButton) then
+ GlyphButton.UpdateInternalGlyphList
+ else
+ raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
+end;
+
function TButtonGlyph_CreateButtonGlyph(Control: TControl; State: TButtonState): Integer;
var
ButtonGlyph: THackButtonGlyph;
NumGlyphs: Integer;
begin
- ButtonGlyph := GetButtonGlyphObject(Control);
+ ButtonGlyph := GetButtonGlyph(Control);
NumGlyphs := ButtonGlyph.FNumGlyphs;
if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
Result := ButtonGlyph.FIndexs[State];
if (Result = -1) then begin
- if Control is TTntBitBtn then begin
- TTntBitBtn(Control).UpdateInternalGlyphList;
- end else if Control is TTntSpeedButton then begin
- TTntSpeedButton(Control).UpdateInternalGlyphList;
- end else
- raise Exception.Create('TNT Internal Error: wrong button class for CreateButtonGlyph.');
+ UpdateInternalGlyphList(Control);
Result := ButtonGlyph.FIndexs[State];
end;
end;
@@ -153,20 +196,20 @@
Glyph: TBitmap;
GlyphList: TImageList;
Index: Integer;
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
Details: TThemedElementDetails;
R: TRect;
Button: TThemedButton;
{$ENDIF}
begin
- ButtonGlyph := GetButtonGlyphObject(Control);
+ ButtonGlyph := GetButtonGlyph(Control);
Glyph := ButtonGlyph.FOriginal;
GlyphList := ButtonGlyph.FGlyphList;
if Glyph = nil then Exit;
if (Glyph.Width = 0) or (Glyph.Height = 0) then Exit;
Index := TButtonGlyph_CreateButtonGlyph(Control, State);
with GlyphPos do
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
if ThemeServices.ThemesEnabled then begin
R.TopLeft := GlyphPos;
R.Right := R.Left + Glyph.Width div ButtonGlyph.FNumGlyphs;
@@ -194,7 +237,8 @@
end;
procedure TButtonGlyph_DrawButtonText(Canvas: TCanvas; const Caption: WideString;
- TextBounds: TRect; State: TButtonState; BiDiFlags: LongInt);
+ TextBounds: TRect; State: TButtonState;
+ BiDiFlags: LongInt {$IFDEF DELPHI_7_UP}; WordWrap: Boolean {$ENDIF});
begin
with Canvas do
begin
@@ -203,21 +247,46 @@
begin
OffsetRect(TextBounds, 1, 1);
Font.Color := clBtnHighlight;
- Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
- DT_CENTER or DT_VCENTER or BiDiFlags);
+
+ {$IFDEF DELPHI_7_UP}
+ if WordWrap then
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
+ DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
+ else
+ {$ENDIF}
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
+ DT_CENTER or DT_VCENTER or BiDiFlags);
+
OffsetRect(TextBounds, -1, -1);
Font.Color := clBtnShadow;
- Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
- DT_CENTER or DT_VCENTER or BiDiFlags);
+
+ {$IFDEF DELPHI_7_UP}
+ if WordWrap then
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
+ DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
+ else
+ {$ENDIF}
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
+ DT_CENTER or DT_VCENTER or BiDiFlags);
+
end else
- Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
- DT_CENTER or DT_VCENTER or BiDiFlags);
+ begin
+ {$IFDEF DELPHI_7_UP}
+ if WordWrap then
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
+ DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
+ else
+ {$ENDIF}
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
+ DT_CENTER or DT_VCENTER or BiDiFlags);
+ end;
end;
end;
procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
- Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect; BiDiFlags: Integer);
+ Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
+ BiDiFlags: Integer {$IFDEF DELPHI_7_UP}; WordWrap: Boolean {$ENDIF});
var
TextPos: TPoint;
ClientSize,
@@ -228,7 +297,7 @@
NumGlyphs: Integer;
ButtonGlyph: THackButtonGlyph;
begin
- ButtonGlyph := GetButtonGlyphObject(Control);
+ ButtonGlyph := GetButtonGlyph(Control);
Glyph := ButtonGlyph.FOriginal;
NumGlyphs := ButtonGlyph.FNumGlyphs;
@@ -249,14 +318,26 @@
if Length(Caption) > 0 then
begin
+ {$IFDEF DELPHI_7_UP}
+ TextBounds := Rect(0, 0, Client.Right - Client.Left - GlyphSize.X - 3, 0); { TODO: Figure out why GlyphSize.X is in here. }
+ {$ELSE}
TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
- Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags);
+ {$ENDIF}
+
+ {$IFDEF DELPHI_7_UP}
+ if WordWrap then
+ Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_WORDBREAK
+ or DT_CALCRECT or BiDiFlags)
+ else
+ {$ENDIF}
+ Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags);
+
TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - TextBounds.Top);
end
else
begin
TextBounds := Rect(0, 0, 0, 0);
- TextSize := Point(0,0);
+ TextSize := Point(0, 0);
end;
// If the layout has the glyph on the right or the left, then both the text and the glyph are centered vertically.
@@ -308,7 +389,7 @@
Spacing := (TotalSize.Y - TextSize.Y) div 2;
end;
end;
-
+
case Layout of
blGlyphLeft:
begin
@@ -339,7 +420,7 @@
Inc(Y, Client.Top + Offset.Y);
end;
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
{ Themed text is not shifted, but gets a different color. }
if ThemeServices.ThemesEnabled then
OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top)
@@ -350,14 +431,16 @@
function TButtonGlyph_Draw(Control: TControl; Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout; Margin: Integer;
- Spacing: Integer; State: TButtonState; Transparent: Boolean; BiDiFlags: Longint): TRect;
+ Spacing: Integer; State: TButtonState; Transparent: Boolean;
+ BiDiFlags: Longint {$IFDEF DELPHI_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
var
GlyphPos: TPoint;
begin
TButtonGlyph_CalcButtonLayout(Control, Canvas.Handle, Client, Offset, Caption, Layout, Margin,
- Spacing, GlyphPos, Result, BiDiFlags);
+ Spacing, GlyphPos, Result, BiDiFlags {$IFDEF DELPHI_7_UP}, WordWrap {$ENDIF});
TButtonGlyph_DrawButtonGlyph(Control, Canvas, GlyphPos, State, Transparent);
- TButtonGlyph_DrawButtonText(Canvas, Caption, Result, State, BiDiFlags);
+ TButtonGlyph_DrawButtonText(Canvas, Caption, Result, State,
+ BiDiFlags {$IFDEF DELPHI_7_UP}, WordWrap {$ENDIF});
end;
{ TTntSpeedButton }
@@ -365,7 +448,7 @@
procedure TTntSpeedButton.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSpeedButton.IsCaptionStored: Boolean;
@@ -416,6 +499,11 @@
inherited;
end;
+function TTntSpeedButton.GetButtonGlyph: Pointer;
+begin
+ Result := THackSpeedButton(Self).FGlyph;
+end;
+
procedure TTntSpeedButton.UpdateInternalGlyphList;
begin
FPaintInherited := True;
@@ -425,10 +513,18 @@
FPaintInherited := False;
end;
Invalidate;
- Abort;
+ raise EAbortPaint.Create('');
end;
procedure TTntSpeedButton.Paint;
+begin
+ if FPaintInherited then
+ inherited
+ else
+ PaintButton;
+end;
+
+procedure TTntSpeedButton.PaintButton;
const
DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
@@ -436,15 +532,13 @@
PaintRect: TRect;
DrawFlags: Integer;
Offset: TPoint;
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
Button: TThemedButton;
ToolButton: TThemedToolBar;
Details: TThemedElementDetails;
{$ENDIF}
begin
- if FPaintInherited then
- inherited
- else begin
+ try
if not Enabled then
begin
FState := bsDisabled;
@@ -457,10 +551,12 @@
FState := bsUp;
Canvas.Font := Self.Font;
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
if ThemeServices.ThemesEnabled then
begin
+ {$IFDEF COMPILER_7_UP}
PerformEraseBackground(Self, Canvas.Handle);
+ {$ENDIF}
SelectObject(Canvas.Handle, Canvas.Font.Handle); { For some reason, PerformEraseBackground sometimes messes the font up. }
if not Enabled then
@@ -513,7 +609,7 @@
else
Offset := Point(0, 0);
TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption, Layout, Margin, Spacing, FState,
- Transparent, DrawTextBiDiModeFlags(0));
+ Transparent, DrawTextBiDiModeFlags(0) {$IFDEF DELPHI_7_UP}, False {$ENDIF});
end
else
{$ENDIF}
@@ -556,8 +652,14 @@
Offset.Y := 0;
end;
TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption,
- Layout, Margin, Spacing, FState, Transparent, DrawTextBiDiModeFlags(0));
+ Layout, Margin, Spacing, FState, Transparent,
+ DrawTextBiDiModeFlags(0) {$IFDEF DELPHI_7_UP}, False {$ENDIF});
end;
+ except
+ on E: EAbortPaint do
+ ;
+ else
+ raise;
end;
end;
@@ -582,7 +684,7 @@
procedure TTntBitBtn.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntBitBtn.IsCaptionStored: Boolean;
@@ -626,6 +728,11 @@
TntButton_CMDialogChar(Self, Message);
end;
+function TTntBitBtn.GetButtonGlyph: Pointer;
+begin
+ Result := THackBitBtn(Self).FGlyph;
+end;
+
procedure TTntBitBtn.UpdateInternalGlyphList;
begin
FPaintInherited := True;
@@ -635,7 +742,7 @@
FPaintInherited := False;
end;
Invalidate;
- Abort;
+ raise EAbortPaint.Create('');
end;
procedure TTntBitBtn.CNDrawItem(var Message: TWMDrawItem);
@@ -654,125 +761,132 @@
Flags: Longint;
FCanvas: TCanvas;
IsFocused: Boolean;
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
Details: TThemedElementDetails;
Button: TThemedButton;
Offset: TPoint;
{$ENDIF}
begin
- FCanvas := THackBitBtn(Self).FCanvas;
- IsFocused := THackBitBtn(Self).IsFocused;
- FCanvas.Handle := DrawItemStruct.hDC;
- R := ClientRect;
-
- with DrawItemStruct do
- begin
- FCanvas.Handle := hDC;
- FCanvas.Font := Self.Font;
- IsDown := itemState and ODS_SELECTED <> 0;
- IsDefault := itemState and ODS_FOCUS <> 0;
+ try
+ FCanvas := THackBitBtn(Self).FCanvas;
+ IsFocused := THackBitBtn(Self).IsFocused;
+ FCanvas.Handle := DrawItemStruct.hDC;
+ R := ClientRect;
- if not Enabled then State := bsDisabled
- else if IsDown then State := bsDown
- else State := bsUp;
- end;
+ with DrawItemStruct do
+ begin
+ FCanvas.Handle := hDC;
+ FCanvas.Font := Self.Font;
+ IsDown := itemState and ODS_SELECTED <> 0;
+ IsDefault := itemState and ODS_FOCUS <> 0;
- {$IFDEF VER150}
- if ThemeServices.ThemesEnabled then
- begin
- if not Enabled then
- Button := tbPushButtonDisabled
- else
- if IsDown then
- Button := tbPushButtonPressed
+ if not Enabled then State := bsDisabled
+ else if IsDown then State := bsDown
+ else State := bsUp;
+ end;
+
+ {$IFDEF THEME_7_UP}
+ if ThemeServices.ThemesEnabled then
+ begin
+ if not Enabled then
+ Button := tbPushButtonDisabled
else
- if FMouseInControl then
- Button := tbPushButtonHot
+ if IsDown then
+ Button := tbPushButtonPressed
else
- if IsFocused or IsDefault then
- Button := tbPushButtonDefaulted
+ if FMouseInControl then
+ Button := tbPushButtonHot
else
- Button := tbPushButtonNormal;
+ if IsFocused or IsDefault then
+ Button := tbPushButtonDefaulted
+ else
+ Button := tbPushButtonNormal;
- Details := ThemeServices.GetElementDetails(Button);
- // Parent background.
- ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hDC, @Details, True);
- // Button shape.
- ThemeServices.DrawElement(DrawItemStruct.hDC, Details, DrawItemStruct.rcItem);
- R := ThemeServices.ContentRect(FCanvas.Handle, Details, DrawItemStruct.rcItem);
+ Details := ThemeServices.GetElementDetails(Button);
+ // Parent background.
+ ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hDC, @Details, True);
+ // Button shape.
+ ThemeServices.DrawElement(DrawItemStruct.hDC, Details, DrawItemStruct.rcItem);
+ R := ThemeServices.ContentRect(FCanvas.Handle, Details, DrawItemStruct.rcItem);
- if Button = tbPushButtonPressed then
- Offset := Point(1, 0)
+ if Button = tbPushButtonPressed then
+ Offset := Point(1, 0)
+ else
+ Offset := Point(0, 0);
+ TButtonGlyph_Draw(Self, FCanvas, R, Offset, Caption, Layout, Margin, Spacing, State, False,
+ DrawTextBiDiModeFlags(0) {$IFDEF DELPHI_7_UP}, Self.WordWrap {$ENDIF});
+
+ if IsFocused and IsDefault then
+ begin
+ FCanvas.Pen.Color := clWindowFrame;
+ FCanvas.Brush.Color := clBtnFace;
+ DrawFocusRect(FCanvas.Handle, R);
+ end;
+ end
else
- Offset := Point(0, 0);
- TButtonGlyph_Draw(Self, FCanvas, R, Offset, Caption, Layout, Margin, Spacing, State, False,
- DrawTextBiDiModeFlags(0));
-
- if IsFocused and IsDefault then
+ {$ENDIF}
begin
- FCanvas.Pen.Color := clWindowFrame;
- FCanvas.Brush.Color := clBtnFace;
- DrawFocusRect(FCanvas.Handle, R);
- end;
- end
- else
- {$ENDIF}
- begin
- R := ClientRect;
+ R := ClientRect;
- Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
- if IsDown then Flags := Flags or DFCS_PUSHED;
- if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
- Flags := Flags or DFCS_INACTIVE;
+ Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
+ if IsDown then Flags := Flags or DFCS_PUSHED;
+ if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
+ Flags := Flags or DFCS_INACTIVE;
- { DrawFrameControl doesn't allow for drawing a button as the
- default button, so it must be done here. }
- if IsFocused or IsDefault then
- begin
- FCanvas.Pen.Color := clWindowFrame;
- FCanvas.Pen.Width := 1;
- FCanvas.Brush.Style := bsClear;
- FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
+ { DrawFrameControl doesn't allow for drawing a button as the
+ default button, so it must be done here. }
+ if IsFocused or IsDefault then
+ begin
+ FCanvas.Pen.Color := clWindowFrame;
+ FCanvas.Pen.Width := 1;
+ FCanvas.Brush.Style := bsClear;
+ FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
- { DrawFrameControl must draw within this border }
- InflateRect(R, -1, -1);
- end;
+ { DrawFrameControl must draw within this border }
+ InflateRect(R, -1, -1);
+ end;
- { DrawFrameControl does not draw a pressed button correctly }
- if IsDown then
- begin
- FCanvas.Pen.Color := clBtnShadow;
- FCanvas.Pen.Width := 1;
- FCanvas.Brush.Color := clBtnFace;
- FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
- InflateRect(R, -1, -1);
- end
- else
- DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
+ { DrawFrameControl does not draw a pressed button correctly }
+ if IsDown then
+ begin
+ FCanvas.Pen.Color := clBtnShadow;
+ FCanvas.Pen.Width := 1;
+ FCanvas.Brush.Color := clBtnFace;
+ FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
+ InflateRect(R, -1, -1);
+ end
+ else
+ DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
- if IsFocused then
- begin
- R := ClientRect;
- InflateRect(R, -1, -1);
- end;
+ if IsFocused then
+ begin
+ R := ClientRect;
+ InflateRect(R, -1, -1);
+ end;
- FCanvas.Font := Self.Font;
- if IsDown then
- OffsetRect(R, 1, 1);
+ FCanvas.Font := Self.Font;
+ if IsDown then
+ OffsetRect(R, 1, 1);
- TButtonGlyph_Draw(Self, FCanvas, R, Point(0,0), Caption, Layout, Margin, Spacing, State,
- False, DrawTextBiDiModeFlags(0));
+ TButtonGlyph_Draw(Self, FCanvas, R, Point(0, 0), Caption, Layout, Margin, Spacing, State,
+ False, DrawTextBiDiModeFlags(0) {$IFDEF DELPHI_7_UP}, Self.WordWrap {$ENDIF});
- if IsFocused and IsDefault then
- begin
- R := ClientRect;
- InflateRect(R, -4, -4);
- FCanvas.Pen.Color := clWindowFrame;
- FCanvas.Brush.Color := clBtnFace;
- DrawFocusRect(FCanvas.Handle, R);
+ if IsFocused and IsDefault then
+ begin
+ R := ClientRect;
+ InflateRect(R, -4, -4);
+ FCanvas.Pen.Color := clWindowFrame;
+ FCanvas.Brush.Color := clBtnFace;
+ DrawFocusRect(FCanvas.Handle, R);
+ end;
end;
+ FCanvas.Handle := 0;
+ except
+ on E: EAbortPaint do
+ ;
+ else
+ raise;
end;
- FCanvas.Handle := 0;
end;
procedure TTntBitBtn.CMMouseEnter(var Message: TMessage);
Modified: trunk/TntUnicodeControls/TntCheckLst.pas
===================================================================
--- trunk/TntUnicodeControls/TntCheckLst.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntCheckLst.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,21 +1,46 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntCheckLst;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, Windows, CheckLst, Controls, TntClasses, TntControls;
+uses
+ Classes, Messages, Windows, Controls, StdCtrls, CheckLst,
+ TntClasses, TntControls, TntStdCtrls;
type
{TNT-WARN TCheckListBox}
TTntCheckListBox = class(TCheckListBox{TNT-ALLOW TCheckListBox}, IWideCustomListControl)
private
- FItems: TTntWideStrings;
- FSaveItems: TTntWideStrings;
+ FItems: TTntStrings;
+ FSaveItems: TTntStrings;
FSaveTopIndex: Integer;
FSaveItemIndex: Integer;
- procedure SetItems(const Value: TTntWideStrings);
+ FSaved_ItemEnabled: array of Boolean;
+ FSaved_State: array of TCheckBoxState;
+ FSaved_Header: array of Boolean;
+ {$IFDEF COMPILER_6_UP}
+ FOnData: TLBGetWideDataEvent;
+ {$ENDIF}
+ procedure SetItems(const Value: TTntStrings);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
+ {$IFDEF COMPILER_6_UP}
+ procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
+ procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
+ {$ENDIF}
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
@@ -27,18 +52,22 @@
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure CopySelection(Destination: TCustomListControl); override;
{$ENDIF}
procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
- property Items: TTntWideStrings read FItems write SetItems;
+ property Items: TTntStrings read FItems write SetItems;
+ {$IFDEF COMPILER_6_UP}
+ property OnData: TLBGetWideDataEvent read FOnData write FOnData;
+ {$ENDIF}
end;
implementation
-uses SysUtils, TntWideStrPropHelper, TntStdCtrls, TntActnList;
+uses
+ SysUtils, Math, TntActnList;
{ TTntCheckListBox }
@@ -63,34 +92,57 @@
procedure TTntCheckListBox.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCheckListBox.CreateWnd;
+var
+ i: integer;
begin
inherited;
TntListBox_AfterInherited_CreateWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
+ if Length(FSaved_ItemEnabled) > 0 then begin
+ for i := 0 to Min(Items.Count - 1, High(FSaved_ItemEnabled)) do begin
+ ItemEnabled[i] := FSaved_ItemEnabled[i];
+ State[i] := FSaved_State[i];
+ {$IFDEF COMPILER_6_UP}
+ Header[i] := FSaved_Header[i];
+ {$ENDIF}
+ end;
+ SetLength(FSaved_ItemEnabled, 0);
+ SetLength(FSaved_State, 0);
+ SetLength(FSaved_Header, 0);
+ end;
end;
procedure TTntCheckListBox.DestroyWnd;
+var
+ i: integer;
begin
+ SetLength(FSaved_ItemEnabled, Items.Count);
+ SetLength(FSaved_State, Items.Count);
+ SetLength(FSaved_Header, Items.Count);
+ for i := 0 to Items.Count - 1 do begin
+ FSaved_ItemEnabled[i] := ItemEnabled[i];
+ FSaved_State[i] := State[i];
+ {$IFDEF COMPILER_6_UP}
+ FSaved_Header[i] := Header[i];
+ {$ENDIF}
+ end;
TntListBox_BeforeInherited_DestroyWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
inherited;
end;
-procedure TTntCheckListBox.SetItems(const Value: TTntWideStrings);
+procedure TTntCheckListBox.SetItems(const Value: TTntStrings);
begin
FItems.Assign(Value);
end;
procedure TTntCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
- if Assigned(OnDrawItem) then
- OnDrawItem(Self, Index, Rect, State)
- else begin
- inherited; { first, draw item check box }
- TntListBox_DrawItem_Text(Self, Items, Index, Rect); {second, draw item text}
- end;
+ inherited;
+ if not Assigned(OnDrawItem) then
+ TntListBox_DrawItem_Text(Self, Items, Index, Rect);
end;
function TTntCheckListBox.IsHintStored: Boolean;
@@ -113,7 +165,7 @@
TntListBox_AddItem(Items, Item, AObject);
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure TTntCheckListBox.CopySelection(Destination: TCustomListControl);
begin
TntListBox_CopySelection(Self, Items, Destination);
@@ -131,4 +183,18 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
+{$IFDEF COMPILER_6_UP}
+procedure TTntCheckListBox.LBGetText(var Message: TMessage);
+begin
+ if not TntCustomListBox_LBGetText(Self, OnData, Message) then
+ inherited;
+end;
+
+procedure TTntCheckListBox.LBGetTextLen(var Message: TMessage);
+begin
+ if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
+ inherited;
+end;
+{$ENDIF}
+
end.
Modified: trunk/TntUnicodeControls/TntClasses.pas
===================================================================
--- trunk/TntUnicodeControls/TntClasses.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntClasses.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,306 +1,43 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntClasses;
-{ If you want to use JCLUnicode that comes with Jedi Component Library,
- define JCL as a "Conditional Define" in the project options. }
+{$INCLUDE TntCompilers.inc}
interface
-{$IFNDEF VER130}
-{$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! }
-{$ENDIF}
+{***********************************************}
+{ WideChar-streaming implemented by Maël Hörz }
+{***********************************************}
-uses Classes, SysUtils, Windows, ActiveX, {$IFDEF JCL} JclUnicode, {$ELSE} Unicode, {$ENDIF}
- Controls, Graphics;
+uses
+ Classes, SysUtils, Windows, ActiveX;
-{TNT-WARN Char}
-{TNT-WARN PChar}
-{TNT-WARN String}
-
-{TNT-WARN LPSTR}
-{TNT-WARN PLPSTR}
-{TNT-WARN LPCSTR}
-{TNT-WARN LPCTSTR}
-{TNT-WARN LPTSTR}
-
-// SBCS and MBCS functions with WideString replacements in Unicode.pas
-{TNT-WARN QuotedStr} {TNT-WARN AnsiQuotedStr}
-{TNT-WARN StrComp} {TNT-WARN AnsiStrComp}
-{TNT-WARN StrIComp} {TNT-WARN AnsiStrIComp}
-{TNT-WARN StrLComp} {TNT-WARN AnsiStrLComp}
-{TNT-WARN StrLIComp} {TNT-WARN AnsiStrLIComp}
-{TNT-WARN StrLower} {TNT-WARN AnsiStrLower}
-{TNT-WARN StrPos} {TNT-WARN AnsiStrPos}
-{TNT-WARN StrRScan} {TNT-WARN AnsiStrRScan}
-{TNT-WARN StrScan} {TNT-WARN AnsiStrScan}
-{TNT-WARN StrUpper} {TNT-WARN AnsiStrUpper}
- {TNT-WARN AnsiExtractQuotedStr}
-
-{TNT-WARN AnsiPos} // Pos works with WideString fine
-{TNT-WARN StrPCopyW} // accepts ansi string parameter
-{TNT-WARN StrPLCopyW} // accepts ansi string parameter
-
-(* MBCS Byte Type Procs *)
-{TNT-WARN ByteType}
-{TNT-WARN StrByteType}
-{TNT-WARN ByteToCharIndex}
-{TNT-WARN ByteToCharLen}
-{TNT-WARN CharToByteIndex}
-{TNT-WARN CharToByteLen}
-
-{TNT-WARN VarToStr}
-{TNT-WARN VarToStrDef}
-{TNT-WARN FmtStr}
-{TNT-WARN Format}
-{TNT-WARN FormatBuf}
-
-{TNT-WARN TStringStream} // TO DO: Implement a TWideStringStream
-
-function MakeObjectInstance(Method: TWndMethod): Pointer;
-procedure FreeObjectInstance(ObjectInstance: Pointer);
-
-const
- CR = WideChar($D);
- LF = WideChar($A);
- CRLF = WideString(#$D#$A);
- LineSeparator = WideChar($2028);
-
-// Tnt Original Procs
-
-function WinCheckH(RetVal: Cardinal): Cardinal;
-function WinCheckFileH(RetVal: Cardinal): Cardinal;
-function WinCheckP(RetVal: Pointer): Pointer;
-
-function FontCharSetToCodePage(FontCharSet: TFontCharSet): Cardinal;
-{$IFDEF JCL}
-function CodePageToWideString(const A: AnsiString; CodePage: Cardinal; dwFlags: Cardinal = 0): WideString;
-{$ENDIF}
-function WideStringToCodePage(const W: WideString; CodePage: Cardinal; dwFlags: Cardinal = 0): AnsiString;
-function UCS2ToWideString(const Value: AnsiString): WideString;
-function WideStringToUCS2(const Value: WideString): AnsiString;
-
-function WideTextPos(const SubStr, S: WideString): Integer;
-function IsWideCharDigit(WC: WideChar): Boolean;
-function IsWideCharAlpha(WC: WideChar): Boolean;
-function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
-
-function WideGetModuleFileName(Instance: HModule): WideString;
-function ClassIsRegistered(const clsid: TCLSID): Boolean;
-
-// Tnt-System
-
-{TNT-WARN ParamCount}
-function WideParamCount: Integer;
-{TNT-WARN ParamStr}
-function WideParamStr(Index: Integer): WideString;
-
-// Tnt-Windows
-
-// -- the Unicode form of these functions are supported on Windows 95/98/ME --
-// (Even though EnumResourceTypes, EnumResourceNames and EnumResourceLanguages are supposed
-// to support the Unicode form, they have caused access violations in testing on Win95.)
-{TNT-WARN ExtTextOut}
-{TNT-WARN ExtTextOutA}
-{TNT-WARN FindResource}
-{TNT-WARN FindResourceA}
-{TNT-WARN FindResourceEx}
-{TNT-WARN FindResourceExA}
-{TNT-WARN GetCharWidth}
-{TNT-WARN GetCharWidthA}
-{TNT-WARN GetCommandLine}
-{TNT-WARN GetCommandLineA}
-{TNT-WARN GetTextExtentPoint}
-{TNT-WARN GetTextExtentPointA}
-{TNT-WARN GetTextExtentPoint32}
-{TNT-WARN GetTextExtentPoint32A}
-{TNT-WARN lstrcat}
-{TNT-WARN lstrcatA}
-{TNT-WARN lstrcpy}
-{TNT-WARN lstrcpyA}
-{TNT-WARN lstrlen}
-{TNT-WARN lstrlenA}
-{TNT-WARN MessageBox}
-{TNT-WARN MessageBoxA}
-{TNT-WARN MessageBoxEx}
-{TNT-WARN MessageBoxExA}
-{TNT-WARN TextOut}
-{TNT-WARN TextOutA}
-
-{TNT-WARN CreateFile}
-{TNT-WARN CreateFileA}
-function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
- lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
- hTemplateFile: THandle): THandle;
-function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
-{TNT-WARN FindFirstFile}
-{TNT-WARN FindFirstFileA}
-function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
-{TNT-WARN FindNextFile}
-{TNT-WARN FindNextFileA}
-function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
-{TNT-WARN DrawText}
-{TNT-WARN DrawTextA}
-function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
- var lpRect: TRect; uFormat: UINT): Integer;
-{TNT-WARN GetDiskFreeSpace}
-{TNT-WARN GetDiskFreeSpaceA}
-function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
- lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
-{TNT-WARN ShellExecute}
-{TNT-WARN ShellExecuteA}
-function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
- Directory: PWideChar; ShowCmd: Integer): HINST;
-{TNT-WARN LoadLibraryEx}
-{TNT-WARN LoadLibraryExA}
-function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
-{TNT-WARN CreateProcess}
-{TNT-WARN CreateProcessA}
-function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
- var lpProcessInformation: TProcessInformation): BOOL;
-
-// Tnt-SysUtils
-var Win32PlatformIsUnicode: Boolean;
-var Win32PlatformIsXP: Boolean;
-
-{$IFDEF VER130}
-const sLineBreak = #13#10;
-const PathDelim = '\';
-const DriveDelim = ':';
-const PathSep = ';';
-
-procedure RaiseLastOSError;
-function WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
-{TNT-WARN CompareStr}
-{TNT-WARN AnsiCompareStr}
-function WideCompareStr(const W1, W2: WideString): Integer;
-{TNT-WARN AnsiSameStr}
-function WideSameStr(const W1, W2: WideString): Boolean;
-{TNT-WARN SameText}
-{TNT-WARN AnsiSameText}
-function WideSameText(const W1, W2: WideString): Boolean;
-{$ENDIF}
-{TNT-WARN CompareText}
-{TNT-WARN AnsiCompareText}
-function WideCompareText(const W1, W2: WideString): Integer;
-
-{TNT-WARN UpperCase}
-{TNT-WARN AnsiUpperCase}
-{TNT-WARN WideUpperCase}
-function Unicode_WideUpperCase(const S: WideString): WideString;
-{TNT-WARN LowerCase}
-{TNT-WARN AnsiLowerCase}
-{TNT-WARN WideLowerCase}
-function Unicode_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 WrapText}
-function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
- MaxCol: Integer): WideString; overload;
-function WideWrapText(const Line: WideString; MaxCol: Integer): WideString; overload;
-
-{TNT-WARN FileCreate}
-function WideFileCreate(const FileName: WideString): Integer;
-{TNT-WARN FileOpen}
-function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
-
-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): TTime;
-
-// FindFile - warning on TSearchRec is all that is necessary.
-{TNT-WARN TSearchRec}
+// ......... introduced .........
type
- TSearchRecW = record
- Time: Integer;
- Size: Integer;
- 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);
+ TTntStreamCharSet = (csAnsi, csUnicode, csUnicodeSwapped, csUtf8);
-{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;
+function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
-{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 - Classes
+//---------------------------------------------------------------------------------------------
-{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 ForceDirectories}
-function WideForceDirectories(Dir: WideString): Boolean;
-{TNT-WARN FileSearch}
-function WideFileSearch(const Name, DirList: WideString): WideString;
-{TNT-WARN ExtractRelativePath}
-function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
+{TNT-WARN ExtractStrings}
+{TNT-WARN LineStart}
+{TNT-WARN TStringStream} // TODO: Implement a TWideStringStream
-{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;
+procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
-
type
{TNT-WARN TFileStream}
TTntFileStream = class(THandleStream)
@@ -309,6 +46,13 @@
destructor Destroy; override;
end;
+{TNT-WARN TMemoryStream}
+ TTntMemoryStream = class(TMemoryStream{TNT-ALLOW TMemoryStream})
+ public
+ procedure LoadFromFile(const FileName: WideString);
+ procedure SaveToFile(const FileName: WideString);
+ end;
+
{TNT-WARN TResourceStream}
TTntResourceStream = class(TCustomMemoryStream)
private
@@ -320,52 +64,182 @@
constructor CreateFromID(Instance: THandle; ResID: Word; ResType: PWideChar);
destructor Destroy; override;
function Write(const Buffer; Count: Longint): Longint; override;
+ procedure SaveToFile(const FileName: WideString);
end;
+ TTntStrings = class;
+
+{ IWideStringsAdapter interface }
+{ Maintains link between TTntStrings and IStrings implementations }
+
+ IWideStringsAdapter = interface
+ ['{D79A8683-A07D-42DE-BEB4-9BAEA1CAEDD0}']
+ procedure ReferenceStrings(S: TTntStrings);
+ procedure ReleaseStrings;
+ end;
+
+{TNT-WARN TAnsiStrings}
+ TAnsiStrings{TNT-ALLOW TAnsiStrings} = class(TStrings{TNT-ALLOW TStrings})
+ public
+ procedure LoadFromFile(const FileName: WideString); reintroduce;
+ procedure SaveToFile(const FileName: WideString); reintroduce;
+ procedure LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
+ procedure SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
+ procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;
+ procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;
+ end;
+
+ TAnsiStringsForWideStringsAdapter = class(TAnsiStrings{TNT-ALLOW TAnsiStrings})
+ private
+ FWideStrings: TTntStrings;
+ FAdapterCodePage: Cardinal;
+ protected
+ function Get(Index: Integer): AnsiString; override;
+ procedure Put(Index: Integer; const S: AnsiString); override;
+ function GetCount: Integer; override;
+ function GetObject(Index: Integer): TObject; override;
+ procedure PutObject(Index: Integer; AObject: TObject); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ function AdapterCodePage: Cardinal; dynamic;
+ public
+ constructor Create(WideStrings: TTntStrings; _AdapterCodePage: Cardinal = 0);
+ procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ procedure Insert(Index: Integer; const S: AnsiString); override;
+ procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); override;
+ procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); override;
+ end;
+
+ TWideStringsDefined = set of (sdDelimiter, sdQuoteChar, sdNameValueSeparator);
+
{TNT-WARN TStrings}
- TTntWideStrings = class(TWideStrings)
+ TTntStrings = class(TPersistent)
private
- FAnsiStrings: TStrings{TNT-ALLOW TStrings};
- procedure SetAnsiStrings(const Value: TStrings{TNT-ALLOW TStrings});
+ FAnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings};
+ procedure SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
+ private
+ FLastFileCharSet: TTntStreamCharSet;
+ FDefined: TWideStringsDefined;
+ FDelimiter: WideChar;
+ FQuoteChar: WideChar;
+ FNameValueSeparator: WideChar;
+ FUpdateCount: Integer;
+ FAdapter: IWideStringsAdapter;
+ function GetCommaText: WideString;
+ function GetDelimitedText: WideString;
+ function GetName(Index: Integer): WideString;
+ function GetValue(const Name: WideString): WideString;
procedure ReadData(Reader: TReader);
+ procedure ReadDataUTF7(Reader: TReader);
+ procedure ReadDataUTF8(Reader: TReader);
+ procedure SetCommaText(const Value: WideString);
+ procedure SetDelimitedText(const Value: WideString);
+ procedure SetStringsAdapter(const Value: IWideStringsAdapter);
+ procedure SetValue(const Name, Value: WideString);
procedure WriteData(Writer: TWriter);
- procedure ReadDataUTF8(Reader: TReader);
- procedure ReadDataUTF7(Reader: TReader);
procedure WriteDataUTF7(Writer: TWriter);
+ function GetDelimiter: WideChar;
+ procedure SetDelimiter(const Value: WideChar);
+ function GetQuoteChar: WideChar;
+ procedure SetQuoteChar(const Value: WideChar);
+ function GetNameValueSeparator: WideChar;
+ procedure SetNameValueSeparator(const Value: WideChar);
+ function GetValueFromIndex(Index: Integer): WideString;
+ procedure SetValueFromIndex(Index: Integer; const Value: WideString);
protected
+ procedure AssignTo(Dest: TPersistent); override;
procedure DefineProperties(Filer: TFiler); override;
-{$IFDEF JCL}
- protected
+ procedure Error(const Msg: WideString; Data: Integer); overload;
+ procedure Error(Msg: PResStringRec; Data: Integer); overload;
+ function ExtractName(const S: WideString): WideString;
+ function Get(Index: Integer): WideString; virtual; abstract;
+ function GetCapacity: Integer; virtual;
+ function GetCount: Integer; virtual; abstract;
+ function GetObject(Index: Integer): TObject; virtual;
function GetTextStr: WideString; virtual;
+ procedure Put(Index: Integer; const S: WideString); virtual;
+ procedure PutObject(Index: Integer; AObject: TObject); virtual;
+ procedure SetCapacity(NewCapacity: Integer); virtual;
procedure SetTextStr(const Value: WideString); virtual;
- procedure Put(Index: Integer; const S: WideString); override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
+ procedure SetUpdateState(Updating: Boolean); virtual;
+ property UpdateCount: Integer read FUpdateCount;
+ function CompareStrings(const S1, S2: WideString): Integer; virtual;
public
- function GetText: WideString; override;
- procedure SetText(const Value: WideString); override;
-{$ENDIF}
- public
constructor Create;
destructor Destroy; override;
- procedure LoadFromFile(const FileName: WideString); reintroduce; virtual;
- procedure SaveToFile(const FileName: WideString); reintroduce; virtual;
+ function Add(const S: WideString): Integer; virtual;
+ function AddObject(const S: WideString; AObject: TObject): Integer; virtual;
+ procedure Append(const S: WideString);
+ procedure AddStrings(Strings: TTntStrings); virtual;
+ procedure Assign(Source: TPersistent); override;
+ procedure BeginUpdate;
+ procedure Clear; virtual; abstract;
+ procedure Delete(Index: Integer); virtual; abstract;
+ procedure EndUpdate;
+ function Equals(Strings: TTntStrings): Boolean;
+ procedure Exchange(Index1, Index2: Integer); virtual;
+ function GetTextW: PWideChar; virtual;
+ function IndexOf(const S: WideString): Integer; virtual;
+ function IndexOfName(const Name: WideString): Integer; virtual;
+ function IndexOfObject(AObject: TObject): Integer; virtual;
+ procedure Insert(Index: Integer; const S: WideString); virtual; abstract;
+ procedure InsertObject(Index: Integer; const S: WideString;
+ AObject: TObject); virtual;
+ procedure LoadFromFile(const FileName: WideString); virtual;
+ procedure LoadFromStream(Stream: TStream; WithBOM: Boolean = True); virtual;
+ procedure Move(CurIndex, NewIndex: Integer); virtual;
+ procedure SaveToFile(const FileName: WideString); virtual;
+ procedure SaveToStream(Stream: TStream; WithBOM: Boolean = True); virtual;
+ procedure SetTextW(const Text: PWideChar); virtual;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property CommaText: WideString read GetCommaText write SetCommaText;
+ property Count: Integer read GetCount;
+ property Delimiter: WideChar read GetDelimiter write SetDelimiter;
+ property DelimitedText: WideString read GetDelimitedText write SetDelimitedText;
+ property LastFileCharSet: TTntStreamCharSet read FLastFileCharSet;
+ property Names[Index: Integer]: WideString read GetName;
+ property Objects[Index: Integer]: TObject read GetObject write PutObject;
+ property QuoteChar: WideChar read GetQuoteChar write SetQuoteChar;
+ property Values[const Name: WideString]: WideString read GetValue write SetValue;
+ property ValueFromIndex[Index: Integer]: WideString read GetValueFromIndex write SetValueFromIndex;
+ property NameValueSeparator: WideChar read GetNameValueSeparator write SetNameValueSeparator;
+ property Strings[Index: Integer]: WideString read Get write Put; default;
+ property Text: WideString read GetTextStr write SetTextStr;
+ property StringsAdapter: IWideStringsAdapter read FAdapter write SetStringsAdapter;
published
- property AnsiStrings: TStrings{TNT-ALLOW TStrings} read FAnsiStrings write SetAnsiStrings stored False;
+ property AnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings} read FAnsiStrings write SetAnsiStrings stored False;
end;
+{ TTntStringList class }
+
+ TTntStringList = class;
+
+ PWideStringItem = ^TWideStringItem;
+ TWideStringItem = record
+ FString: WideString;
+ FObject: TObject;
+ end;
+
+ PWideStringItemList = ^TWideStringItemList;
+ TWideStringItemList = array[0..MaxListSize] of TWideStringItem;
+ TWideStringListSortCompare = function(List: TTntStringList; Index1, Index2: Integer): Integer;
+
{TNT-WARN TStringList}
-{TNT-WARN TWideStringList}
- TTntWideStringList = class(TTntWideStrings)
+ TTntStringList = class(TTntStrings)
private
- FList: TWideStringList{TNT-ALLOW TWideStringList};
- function GetDuplicates: TDuplicates;
- procedure SetDuplicates(const Value: TDuplicates);
- function GetSorted: Boolean;
- procedure SetSorted(const Value: Boolean);
- function GetOnChange: TNotifyEvent;
- procedure SetOnChange(const Value: TNotifyEvent);
- function GetOnChanging: TNotifyEvent;
- procedure SetOnChanging(const Value: TNotifyEvent);
+ FList: PWideStringItemList;
+ FCount: Integer;
+ FCapacity: Integer;
+ FSorted: Boolean;
+ FDuplicates: TDuplicates;
+ FCaseSensitive: Boolean;
+ FOnChange: TNotifyEvent;
+ FOnChanging: TNotifyEvent;
+ procedure ExchangeItems(Index1, Index2: Integer);
+ procedure Grow;
+ procedure QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);
+ procedure SetSorted(Value: Boolean);
+ procedure SetCaseSensitive(const Value: Boolean);
protected
procedure Changed; virtual;
procedure Changing; virtual;
@@ -377,1652 +251,1971 @@
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetCapacity(NewCapacity: Integer); override;
procedure SetUpdateState(Updating: Boolean); override;
- procedure SetLanguage(Value: LCID); override;
+ function CompareStrings(const S1, S2: WideString): Integer; override;
+ procedure InsertItem(Index: Integer; const S: WideString; AObject: TObject); virtual;
public
- constructor Create;
destructor Destroy; override;
function Add(const S: WideString): Integer; override;
+ function AddObject(const S: WideString; AObject: TObject): Integer; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Exchange(Index1, Index2: Integer); override;
function Find(const S: WideString; var Index: Integer): Boolean; virtual;
function IndexOf(const S: WideString): Integer; override;
+ function IndexOfName(const Name: WideString): Integer; override;
procedure Insert(Index: Integer; const S: WideString); override;
+ procedure InsertObject(Index: Integer; const S: WideString;
+ AObject: TObject); override;
procedure Sort; virtual;
- property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
- property Sorted: Boolean read GetSorted write SetSorted;
- property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
- property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging;
+ procedure CustomSort(Compare: TWideStringListSortCompare); virtual;
+ property Duplicates: TDuplicates read FDuplicates write FDuplicates;
+ property Sorted: Boolean read FSorted write SetSorted;
+ property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
end;
+// ......... introduced .........
+type
+ TListTargetCompare = function (Item, Target: Pointer): Integer;
+
+function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;
+ Target: Pointer; var Index: Integer): Boolean;
+
+function ClassIsRegistered(const clsid: TCLSID): Boolean;
+
+var
+ RuntimeUTFStreaming: Boolean;
+
+type
+ TBufferedAnsiString = class(TObject)
+ private
+ FStringBuffer: AnsiString;
+ LastWriteIndex: Integer;
+ public
+ procedure Clear;
+ procedure AddChar(const wc: AnsiChar);
+ procedure AddString(const s: AnsiString);
+ procedure AddBuffer(Buff: PAnsiChar; Chars: Integer);
+ function Value: AnsiString;
+ function BuffPtr: PAnsiChar;
+ end;
+
+ TBufferedWideString = class(TObject)
+ private
+ FStringBuffer: WideString;
+ LastWriteIndex: Integer;
+ public
+ procedure Clear;
+ procedure AddChar(const wc: WideChar);
+ procedure AddString(const s: WideString);
+ procedure AddBuffer(Buff: PWideChar; Chars: Integer);
+ function Value: WideString;
+ function BuffPtr: PWideChar;
+ end;
+
+ TBufferedStreamReader = class(TStream)
+ private
+ FStream: TStream;
+ FStreamSize: Integer;
+ FBuffer: array of Byte;
+ FBufferSize: Integer;
+ FBufferStartPosition: Integer;
+ FVirtualPosition: Integer;
+ procedure UpdateBufferFromPosition(StartPos: Integer);
+ public
+ constructor Create(Stream: TStream; BufferSize: Integer = 1024);
+ function Read(var Buffer; Count: Longint): Longint; override;
+ function Write(const Buffer; Count: Longint): Longint; override;
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+ end;
+
implementation
-uses Consts, {$IFNDEF VER130} RTLConsts, {$ENDIF} SysConst, ComObj, Forms, Registry,
- ConvertUTF7, ShellApi;
+uses
+ {$IFDEF COMPILER_6_UP} RTLConsts, {$ELSE} Consts, {$ENDIF} ComObj, Math,
+ Registry, TypInfo, TntTypInfo, TntSystem, TntSysUtils;
-function MakeObjectInstance(Method: TWndMethod): Pointer;
-begin
-{$IFDEF VER130}
- Result := Forms.MakeObjectInstance(Method);
-{$ELSE}
- Result := Classes.MakeObjectInstance(Method);
-{$ENDIF}
-end;
+{ TntPersistent }
-procedure FreeObjectInstance(ObjectInstance: Pointer);
-begin
-{$IFDEF VER130}
- Forms.FreeObjectInstance(ObjectInstance);
-{$ELSE}
- Classes.FreeObjectInstance(ObjectInstance);
-{$ENDIF}
-end;
+//===========================================================================
+// The Delphi 5 Classes.pas has no support for streaming WideStrings.
+// The Delphi 6 Classes.pas works great. Too bad the Delphi 6 IDE doesn't use
+// the updated Classes.pas. Switching between Form/Text mode corrupts extended
+// characters in WideStrings even under Delphi 6.
+// Delphi 7 seems to finally get right. But let's keep the UTF7 support at design time
+// to enable sharing source code with previous versions of Delphi.
+//
+// The purpose of this solution is to store WideString properties which contain
+// non-ASCII chars in the form of UTF7 under the old property name + '_UTF7'.
+//
+// Special thanks go to Francisco Leong for helping to develop this solution.
+//
-//------------------------- Tnt Original Procs ----------------------------------
+{ TTntWideStringPropertyFiler }
+type
+ TTntWideStringPropertyFiler = class
+ private
+ FInstance: TPersistent;
+ FPropInfo: PPropInfo;
+ procedure ReadDataUTF8(Reader: TReader);
+ procedure ReadDataUTF7(Reader: TReader);
+ procedure WriteDataUTF7(Writer: TWriter);
+ public
+ procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
+ end;
-function WinCheckH(RetVal: Cardinal): Cardinal;
+function ReaderNeedsUtfHelp(Reader: TReader): Boolean;
begin
- if RetVal = 0 then RaiseLastOSError;
- Result := RetVal;
+ if Reader.Owner = nil then
+ Result := False { designtime - visual form inheritance ancestor }
+ else if csDesigning in Reader.Owner.ComponentState then
+ Result := True { designtime - always needs UTF help. }
+ else
+ Result := RuntimeUTFStreaming; { runtime }
end;
-
-function WinCheckFileH(RetVal: Cardinal): Cardinal;
+
+procedure TTntWideStringPropertyFiler.ReadDataUTF8(Reader: TReader);
begin
- if RetVal = INVALID_HANDLE_VALUE then RaiseLastOSError;
- Result := RetVal;
+ if ReaderNeedsUtfHelp(Reader) then
+ SetWideStrProp(FInstance, FPropInfo, UTF8ToWideString(Reader.ReadString))
+ else
+ Reader.ReadString; { do nothing with Result }
end;
-function WinCheckP(RetVal: Pointer): Pointer;
+procedure TTntWideStringPropertyFiler.ReadDataUTF7(Reader: TReader);
begin
- if RetVal = nil then RaiseLastOSError;
- Result := RetVal;
+ if ReaderNeedsUtfHelp(Reader) then
+ SetWideStrProp(FInstance, FPropInfo, UTF7ToWideString(Reader.ReadString))
+ else
+ Reader.ReadString; { do nothing with Result }
end;
-{ Windows.pas doesn't declare TranslateCharsetInfo() correctly. }
-function TranslateCharsetInfo(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo';
-
-function FontCharSetToCodePage(FontCharSet: TFontCharSet): Cardinal;
-var
- C: TCharsetInfo;
+procedure TTntWideStringPropertyFiler.WriteDataUTF7(Writer: TWriter);
begin
- if TranslateCharsetInfo(PDWORD(FontCharSet), C, TCI_SRCCHARSET) then
- Result:=C.ciACP
- else
- raise Exception.Create('TNT Internal Error: Unexpected FontCharSet in FontCharSetToCodePage().');
+ Writer.WriteString(WideStringToUTF7(GetWideStrProp(FInstance, FPropInfo)));
end;
-{$IFDEF JCL}
-function CodePageToWideString(const A: AnsiString; CodePage: Cardinal; dwFlags: Cardinal = 0): WideString;
-var
- Len: Integer;
-begin
- // figure length
- Len := MultiByteToWideChar(CodePage, dwFlags, PAnsiChar(A), Length(A), nil, 0);
- SetLength(Result, Len);
- if Len > 0 then begin
- // convert string
- Len := MultiByteToWideChar(CodePage, dwFlags, PAnsiChar(A), Length(A),
- PWideChar(Result), Length(Result));
- // check result
- if Len = 0 then
- RaiseLastOSError
- else
- SetLength(Result, Len);
+procedure TTntWideStringPropertyFiler.DefineProperties(Filer: TFiler; Instance: TPersistent;
+ PropName: AnsiString);
+
+ function HasData: Boolean;
+ var
+ CurrPropValue: WideString;
+ begin
+ // must be stored
+ Result := IsStoredProp(Instance, FPropInfo);
+ if Result
+ and (Filer.Ancestor <> nil)
+ and (GetPropInfo(Filer.Ancestor, PropName, [tkWString]) <> nil) then
+ begin
+ // must be different than ancestor
+ CurrPropValue := GetWideStrProp(Instance, FPropInfo);
+ Result := CurrPropValue <> GetWideStrProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
+ end;
+ if Result then begin
+ // must be non-blank and different than UTF8 (implies all ASCII <= 127)
+ CurrPropValue := GetWideStrProp(Instance, FPropInfo);
+ Result := (CurrPropValue <> '') and (WideStringToUTF8(CurrPropValue) <> CurrPropValue);
+ end;
end;
-end;
-{$ENDIF}
-function WideStringToCodePage(const W: WideString; CodePage: Cardinal; dwFlags: Cardinal = 0): AnsiString;
-var
- Len: Integer;
begin
- // figure length
- Len := WideCharToMultiByte(CodePage, dwFlags, PWideChar(W), Length(W), nil, 0, nil, nil);
- // convert string
- SetLength(Result, Len);
- if Len > 0 then begin
- Len := WideCharToMultiByte(CodePage, dwFlags, PWideChar(W), Length(W),
- PAnsiChar(Result), Length(Result), nil, nil);
- // check result
- if Len = 0 then
- RaiseLastOSError
- else
- SetLength(Result, Len);
+ FInstance := Instance;
+ FPropInfo := GetPropInfo(Instance, PropName, [tkWString]);
+ if FPropInfo <> nil then begin
+ // must be published (and of type WideString)
+ Filer.DefineProperty(PropName + 'W', ReadDataUTF8, nil, False);
+ Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, HasData);
end;
+ FInstance := nil;
+ FPropInfo := nil;
end;
-function UCS2ToWideString(const Value: AnsiString): WideString;
+{ TTntWideCharPropertyFiler }
+type
+ TTntWideCharPropertyFiler = class
+ private
+ FInstance: TPersistent;
+ FPropInfo: PPropInfo;
+ FWriter: TWriter;
+ procedure GetLookupInfo(var Ancestor: TPersistent;
+ var Root, LookupRoot, RootAncestor: TComponent);
+ procedure ReadData(Reader: TReader);
+ procedure ReadDataUTF7(Reader: TReader);
+ procedure WriteData(Writer: TWriter);
+ function ReadChar(Reader: TReader): WideChar;
+ public
+ procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
+ end;
+
+type
+ TGetLookupInfoEvent = procedure(var Ancestor: TPersistent;
+ var Root, LookupRoot, RootAncestor: TComponent) of object;
+
+function AncestorIsValid(Ancestor: TPersistent; Root, RootAncestor: TComponent): Boolean;
begin
- if Length(Value) = 0 then
- Result := ''
- else
- SetString(Result, PWideChar(@Value[1]), Length(Value) div SizeOf(WideChar))
+ Result := (Ancestor <> nil) and (RootAncestor <> nil) and
+ Root.InheritsFrom(RootAncestor.ClassType);
end;
-function WideStringToUCS2(const Value: WideString): AnsiString;
+function IsDefaultOrdPropertyValue(Instance: TObject; PropInfo: PPropInfo;
+ OnGetLookupInfo: TGetLookupInfoEvent): Boolean;
+var
+ Ancestor: TPersistent;
+ LookupRoot: TComponent;
+ RootAncestor: TComponent;
+ Root: TComponent;
+ AncestorValid: Boolean;
+ Value: Longint;
+ Default: LongInt;
begin
- if Length(Value) = 0 then
- Result := ''
- else
- SetString(Result, PAnsiChar(@Value[1]), Length(Value) * SizeOf(WideChar))
+ Ancestor := nil;
+ Root := nil;
+ LookupRoot := nil;
+ RootAncestor := nil;
+
+ if Assigned(OnGetLookupInfo) then
+ OnGetLookupInfo(Ancestor, Root, LookupRoot, RootAncestor);
+
+ AncestorValid := AncestorIsValid(Ancestor, Root, RootAncestor);
+
+ Result := True;
+ if (PropInfo^.GetProc <> nil) and (PropInfo^.SetProc <> nil) then
+ begin
+ Value := GetOrdProp(Instance, PropInfo);
+ if AncestorValid then
+ Result := Value = GetOrdProp(Ancestor, PropInfo)
+ else
+ begin
+ Default := PPropInfo(PropInfo)^.Default;
+ Result := (Default <> LongInt($80000000)) and (Value = Default);
+ end;
+ end;
end;
-function WideTextPos(const SubStr, S: WideString): Integer;
+procedure TTntWideCharPropertyFiler.GetLookupInfo(var Ancestor: TPersistent;
+ var Root, LookupRoot, RootAncestor: TComponent);
begin
- Result := Pos(Unicode_WideUpperCase(SubStr), Unicode_WideUpperCase(S));
+ Ancestor := FWriter.Ancestor;
+ Root := FWriter.Root;
+ LookupRoot := FWriter.LookupRoot;
+ RootAncestor := FWriter.RootAncestor;
end;
-function IsWideCharDigit(WC: WideChar): Boolean;
+function TTntWideCharPropertyFiler.ReadChar(Reader: TReader): WideChar;
+var
+ Temp: WideString;
begin
- Result := UnicodeIsDigit(UCS4(WC));
-end;
+ case Reader.NextValue of
+ vaWString:
+ Temp := Reader.ReadWideString;
+ vaString:
+ Temp := Reader.ReadString;
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+ end;
-function IsWideCharAlpha(WC: WideChar): Boolean;
-begin
- Result := UnicodeIsAlpha(UCS4(WC));
+ if Length(Temp) > 1 then
+ raise EReadError.Create(SInvalidPropertyValue);
+ Result := Temp[1];
end;
-function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
+procedure TTntWideCharPropertyFiler.ReadData(Reader: TReader);
begin
- Result := UnicodeIsAlphaNum(UCS4(WC));
+ SetOrdProp(FInstance, FPropInfo, Ord(ReadChar(Reader)));
end;
-function WideGetModuleFileName(Instance: HModule): WideString;
+procedure TTntWideCharPropertyFiler.ReadDataUTF7(Reader: TReader);
var
- AnsiResult: AnsiString;
+ S: WideString;
begin
- if Win32PlatformIsUnicode then begin
- SetLength(Result, MAX_PATH);
- WinCheckH(GetModuleFileNameW(Instance, PWideChar(Result), MAX_PATH));
- Result := PWideChar(Result)
- end else begin
- SetLength(AnsiResult, MAX_PATH);
- WinCheckH(GetModuleFileNameA(Instance, PAnsiChar(AnsiResult), MAX_PATH));
- Result := PAnsiChar(AnsiResult)
- end;
+ if ReaderNeedsUtfHelp(Reader) then begin
+ S := UTF7ToWideString(Reader.ReadString);
+ if S = '' then
+ SetOrdProp(FInstance, FPropInfo, 0)
+ else
+ SetOrdProp(FInstance, FPropInfo, Ord(S[1]))
+ end else
+ Reader.ReadString; { do nothing with Result }
end;
-function ClassIsRegistered(const clsid: TCLSID): Boolean;
+type TAccessWriter = class(TWriter);
+
+procedure TTntWideCharPropertyFiler.WriteData(Writer: TWriter);
var
- OleStr: POleStr;
- Reg: TRegIniFile;
- Key, Filename: WideString;
+ L: Integer;
+ Temp: WideString;
begin
- // First, check to see if there is a ProgID. This will tell if the
- // control is registered on the machine. No ProgID, control won't run
- Result := ProgIDFromCLSID(clsid, OleStr) = S_OK;
- if not Result then Exit; //Bail as soon as anything goes wrong.
+ Temp := WideChar(GetOrdProp(FInstance, FPropInfo));
- // Next, make sure that the file is actually there by rooting it out
- // of the registry
- Key := WideFormat('\SOFTWARE\Classes\CLSID\%s', [GUIDToString(clsid)]);
- Reg := TRegIniFile.Create;
- try
- Reg.RootKey := HKEY_LOCAL_MACHINE;
- Result := Reg.OpenKeyReadOnly(Key);
- if not Result then Exit; // Bail as soon as anything goes wrong.
-
- FileName := Reg.ReadString('InProcServer32', '', EmptyStr);
- if (Filename = EmptyStr) then // try another key for the file name
- begin
- FileName := Reg.ReadString('InProcServer', '', EmptyStr);
- end;
- Result := Filename <> EmptyStr;
- if not Result then Exit;
- Result := WideFileExists(Filename);
- finally
- Reg.Free;
- end;
+ TAccessWriter(Writer).WriteValue(vaWString);
+ L := Length(Temp);
+ Writer.Write(L, SizeOf(Integer));
+ Writer.Write(Pointer(@Temp[1])^, L * 2);
end;
-//---------------- Tnt - System.pas --------------------------------------------
+procedure TTntWideCharPropertyFiler.DefineProperties(Filer: TFiler;
+ Instance: TPersistent; PropName: AnsiString);
-function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar;
-var
- Len: Integer;
- Buffer: array[0..4095] of WideChar;
-begin
- while True do
+ function HasData: Boolean;
+ var
+ CurrPropValue: Integer;
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
+ // must be stored
+ Result := IsStoredProp(Instance, FPropInfo);
+ if Result and (Filer.Ancestor <> nil) and
+ (GetPropInfo(Filer.Ancestor, PropName, [tkWChar]) <> nil) 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
+ // must be different than ancestor
+ CurrPropValue := GetOrdProp(Instance, FPropInfo);
+ Result := CurrPropValue <> GetOrdProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
+ end;
+
+ if Result and (Filer is TWriter) then
begin
- Buffer[Len] := P[0];
- Inc(Len);
- Inc(P);
+ FWriter := TWriter(Filer);
+ Result := not IsDefaultOrdPropertyValue(Instance, FPropInfo, GetLookupInfo);
end;
- SetString(Param, Buffer, Len);
- Result := P;
-end;
+ end;
-function WideParamCount: Integer;
-var
- P: PWideChar;
- S: WideString;
begin
- P := WideGetParamStr(GetCommandLineW, S);
- Result := 0;
- while True do
+ FInstance := Instance;
+ FPropInfo := GetPropInfo(Instance, PropName, [tkWChar]);
+ if FPropInfo <> nil then // must be published (and of type WideChar)
begin
- P := WideGetParamStr(P, S);
- if S = '' then Break;
- Inc(Result);
+ // W suffix causes Delphi's native streaming system to ignore the property
+ // and let us do the reading.
+ Filer.DefineProperty(PropName + 'W', ReadData, WriteData, HasData);
+ Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, nil, False);
end;
+ FInstance := nil;
+ FPropInfo := nil;
end;
-function WideParamStr(Index: Integer): WideString;
+procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
var
- P: PWideChar;
+ I, Count: Integer;
+ PropInfo: PPropInfo;
+ PropList: PPropList;
+ WideStringFiler: TTntWideStringPropertyFiler;
+ WideCharFiler: TTntWideCharPropertyFiler;
begin
- if Index = 0 then
- Result := WideGetModuleFileName(0)
- else
+ Count := GetTypeData(Instance.ClassInfo)^.PropCount;
+ if Count > 0 then
begin
- P := GetCommandLineW;
- while True do
- begin
- P := WideGetParamStr(P, Result);
- if (Index = 0) or (Result = '') then Break;
- Dec(Index);
+ WideStringFiler := TTntWideStringPropertyFiler.Create;
+ try
+ WideCharFiler := TTntWideCharPropertyFiler.Create;
+ try
+ GetMem(PropList, Count * SizeOf(Pointer));
+ try
+ GetPropInfos(Instance.ClassInfo, PropList);
+ for I := 0 to Count - 1 do
+ begin
+ PropInfo := PropList^[I];
+ if (PropInfo = nil) then
+ break;
+ if (PropInfo.PropType^.Kind = tkWString) then
+ WideStringFiler.DefineProperties(Filer, Instance, PropInfo.Name)
+ else if (PropInfo.PropType^.Kind = tkWChar) then
+ WideCharFiler.DefineProperties(Filer, Instance, PropInfo.Name)
+ end;
+ finally
+ FreeMem(PropList, Count * SizeOf(Pointer));
+ end;
+ finally
+ WideCharFiler.Free;
+ end;
+ finally
+ WideStringFiler.Free;
end;
end;
end;
-//---------------- Tnt - Windows.pas --------------------------------------------
+{ TTntFileStream }
-function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
- lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
- hTemplateFile: THandle): THandle;
+constructor TTntFileStream.Create(const FileName: WideString; Mode: Word);
+var
+ CreateHandle: Integer;
begin
- if Win32PlatformIsUnicode then
- Result := CreateFileW(lpFileName, dwDesiredAccess, dwShareMode,
- lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
- else
- Result := CreateFileA{TNT-ALLOW CreateFileA}(PAnsiChar(AnsiString(lpFileName)), dwDesiredAccess, dwShareMode,
- lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
+ if Mode = fmCreate then
+ begin
+ CreateHandle := WideFileCreate(FileName);
+ if CreateHandle < 0 then
+ raise EFCreateError.CreateResFmt(PResStringRec(@SFCreateError), [FileName]);
+ end else
+ begin
+ CreateHandle := WideFileOpen(FileName, Mode);
+ if CreateHandle < 0 then
+ raise EFOpenError.CreateResFmt(PResStringRec(@SFOpenError), [FileName]);
+ end;
+ inherited Create(CreateHandle);
end;
-function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
+destructor TTntFileStream.Destroy;
begin
- Result := HiWord(Cardinal(ResStr)) = 0;
+ if Handle >= 0 then FileClose(Handle);
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;
+{ TTntMemoryStream }
-function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
+procedure TTntMemoryStream.LoadFromFile(const FileName: WideString);
var
- Ansi_lpFindFileData: TWIN32FindDataA;
+ Stream: TStream;
begin
- if Win32PlatformIsUnicode then
- Result := 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);
+ Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
end;
end;
-function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
+procedure TTntMemoryStream.SaveToFile(const FileName: WideString);
var
- Ansi_lpFindFileData: TWIN32FindDataA;
+ Stream: TStream;
begin
- if Win32PlatformIsUnicode then
- Result := FindNextFileW(hFindFile, lpFindFileData)
- else begin
- Result := FindNextFileA{TNT-ALLOW FindNextFileA}(hFindFile, Ansi_lpFindFileData);
- if Result then
- MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
+ Stream := TTntFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
end;
end;
-function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
- var lpRect: TRect; uFormat: UINT): Integer;
-begin
- if Win32PlatformIsUnicode then
- Result := DrawTextW(hDC, lpString, nCount, lpRect, uFormat)
- else
- Result := DrawTextA{TNT-ALLOW DrawTextA}(hDC, PAnsiChar(AnsiString(lpString)),
- Length(AnsiString(Copy(WideString(lpString), 1, nCount))),
- lpRect, uFormat);
-end;
+{ TTntResourceStream }
-function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
- lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
+constructor TTntResourceStream.Create(Instance: THandle; const ResName: WideString;
+ ResType: PWideChar);
begin
- if Win32PlatformIsUnicode then
- Result := GetDiskFreeSpaceW(lpRootPathName,
- lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
- else
- Result := GetDiskFreeSpaceA{TNT-ALLOW GetDiskFreeSpaceA}(PAnsiChar(AnsiString(lpRootPathName)),
- lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
+ inherited Create;
+ Initialize(Instance, PWideChar(ResName), ResType);
end;
-function MyPAnsiCharWithNil(const S: AnsiString): PAnsiChar;
+constructor TTntResourceStream.CreateFromID(Instance: THandle; ResID: Word;
+ ResType: PWideChar);
begin
- if S = '' then
- Result := nil {Win9x needs nil for some parameters instead of empty strings}
- else
- Result := PAnsiChar(S);
+ inherited Create;
+ Initialize(Instance, PWideChar(ResID), ResType);
end;
-function MyPWideCharWithNil(const S: WideString): PWideChar;
+procedure TTntResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);
+
+ procedure Error;
+ begin
+ raise EResNotFound.CreateFmt(SResNotFound, [Name]);
+ end;
+
begin
- if S = '' then
- Result := nil {Win9x needs nil for some parameters instead of empty strings}
- else
- Result := PWideChar(S);
+ HResInfo := FindResourceW(Instance, Name, ResType);
+ if HResInfo = 0 then Error;
+ HGlobal := LoadResource(Instance, HResInfo);
+ if HGlobal = 0 then Error;
+ SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
end;
-function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
- Directory: PWideChar; ShowCmd: Integer): HINST;
+destructor TTntResourceStream.Destroy;
begin
- if Win32PlatformIsUnicode then
- Result := ShellExecuteW(hWnd, MyPWideCharWithNil(WideString(Operation)),
- FileName, Parameters,
- Directory, ShowCmd)
- else begin
- Result := ShellExecuteA{TNT-ALLOW ShellExecuteA}(hWnd, MyPAnsiCharWithNil(AnsiString(Operation)),
- MyPAnsiCharWithNil(AnsiString(FileName)), MyPAnsiCharWithNil(AnsiString(Parameters)),
- MyPAnsiCharWithNil(AnsiString(Directory)), ShowCmd)
- end;
+ UnlockResource(HGlobal);
+ FreeResource(HGlobal);
+ inherited Destroy;
end;
-function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
+function TTntResourceStream.Write(const Buffer; Count: Longint): Longint;
begin
- if Win32PlatformIsUnicode then
- Result := LoadLibraryExW(lpLibFileName, hFile, dwFlags)
- else
- Result := LoadLibraryExA{TNT-ALLOW LoadLibraryExA}(PAnsiChar(AnsiString(lpLibFileName)), hFile, dwFlags);
+ raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));
end;
-function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
- var lpProcessInformation: TProcessInformation): BOOL;
+procedure TTntResourceStream.SaveToFile(const FileName: WideString);
+var
+ Stream: TStream;
begin
- if Win32PlatformIsUnicode then begin
- Result := CreateProcessW(lpApplicationName, lpCommandLine,
- lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
- lpCurrentDirectory, lpStartupInfo, lpProcessInformation)
- end else begin
- Result := CreateProcessA{TNT-ALLOW CreateProcessA}(MyPAnsiCharWithNil(AnsiString(lpApplicationName)),
- MyPAnsiCharWithNil(AnsiString(lpCommandLine)),
- lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
- MyPAnsiCharWithNil(AnsiString(lpCurrentDirectory)), lpStartupInfo, lpProcessInformation);
+ Stream := TTntFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
end;
end;
-{$IFDEF VER130}
-procedure RaiseLastOSError;
+{ TAnsiStrings }
+
+procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFile(const FileName: WideString);
+var
+ Stream: TStream;
begin
- RaiseLastWin32Error;
+ Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
end;
-function WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
+procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFile(const FileName: WideString);
+var
+ Stream: TStream;
begin
- Result := Format{TNT-ALLOW Format}(FormatStr, Args);
+ Stream := TTntFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
end;
-function WideCompareStr(const W1, W2: WideString): Integer;
+procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
+var
+ Stream: TStream;
begin
- if Win32PlatformIsUnicode then
- Result := CompareStringW(LOCALE_USER_DEFAULT, 0,
- PWideChar(W1), Length(W1), PWideChar(W2), Length(W2)) - 2
- else
- Result := AnsiCompareStr{TNT-ALLOW AnsiCompareStr}(W1, W2);
+ Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStreamEx(Stream, CodePage);
+ finally
+ Stream.Free;
+ end;
end;
-function WideSameStr(const W1, W2: WideString): Boolean;
+procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
+var
+ Stream: TStream;
begin
- Result := WideCompareStr(W1, W2) = 0;
+ Stream := TTntFileStream.Create(FileName, fmCreate);
+ try
+ if (CodePage = CP_UTF8) then
+ Stream.WriteBuffer(PAnsiChar(UTF8_BOM)^, Length(UTF8_BOM));
+ SaveToStreamEx(Stream, CodePage);
+ finally
+ Stream.Free;
+ end;
end;
-function WideSameText(const W1, W2: WideString): Boolean;
+{ TAnsiStringsForWideStringsAdapter }
+
+constructor TAnsiStringsForWideStringsAdapter.Create(WideStrings: TTntStrings; _AdapterCodePage: Cardinal);
begin
- Result := WideCompareText(W1, W2) = 0;
+ inherited Create;
+ FWideStrings := WideStrings;
+ FAdapterCodePage := _AdapterCodePage;
end;
-{$ENDIF}
-function WideCompareText(const W1, W2: WideString): Integer;
+function TAnsiStringsForWideStringsAdapter.AdapterCodePage: Cardinal;
begin
-{$IFDEF VER130}
- if Win32PlatformIsUnicode then
- Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
- PWideChar(W1), Length(W1), PWideChar(W2), Length(W2)) - 2
+ if FAdapterCodePage = 0 then
+ Result := TntSystem.DefaultSystemCodePage
else
- Result := AnsiCompareText{TNT-ALLOW AnsiCompareText}(W1, W2);
-{$ELSE}
- Result := SysUtils.WideCompareText(W1, W2);
-{$ENDIF}
+ Result := FAdapterCodePage;
end;
-function Unicode_WideLowerCase(const S: WideString): WideString;
+procedure TAnsiStringsForWideStringsAdapter.Clear;
begin
-{The version in SysUtils is broken for Win 9X.}
-{$IFDEF JCL}
- Result := JclUnicode.WideLowerCase{TNT-ALLOW WideLowerCase}(S);
-{$ELSE}
- Result := Unicode.WideLowerCase{TNT-ALLOW WideLowerCase}(S);
-{$ENDIF}
+ FWideStrings.Clear;
end;
-function Unicode_WideUpperCase(const S: WideString): WideString;
+procedure TAnsiStringsForWideStringsAdapter.Delete(Index: Integer);
begin
-{The version in SysUtils is broken for Win 9X.}
-{$IFDEF JCL}
- Result := JclUnicode.WideUpperCase{TNT-ALLOW WideUpperCase}(S);
-{$ELSE}
- Result := Unicode.WideUpperCase{TNT-ALLOW WideUpperCase}(S);
-{$ENDIF}
+ FWideStrings.Delete(Index);
end;
-function WideLastChar(W: WideString): WideChar;
+function TAnsiStringsForWideStringsAdapter.Get(Index: Integer): AnsiString;
begin
- if Length(W) = 0 then
- Result := #0
- else
- Result := W[Length(W)];
+ Result := WideStringToStringEx(FWideStrings.Get(Index), AdapterCodePage);
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 UnicodeIsWhiteSpace(Cardinal(WC))
- or UnicodeIsPunctuation(Cardinal(WC));
- end;
-
-var
- SearchStr, Patt, NewStr: WideString;
- Offset: Integer;
- PrevChar, NextChar: WideChar;
+procedure TAnsiStringsForWideStringsAdapter.Put(Index: Integer; const S: AnsiString);
begin
- if rfIgnoreCase in Flags then
- begin
- SearchStr := Unicode_WideUpperCase(S);
- Patt := Unicode_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;
+ FWideStrings.Put(Index, StringToWideStringEx(S, AdapterCodePage));
end;
-function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
-var
- Source, SourceEnd: PWideChar;
+function TAnsiStringsForWideStringsAdapter.GetCount: Integer;
begin
- Source := Pointer(S);
- SourceEnd := Source + Length(S);
- Result := Length(S);
- while Source < SourceEnd do
- begin
- case Source^ of
- #10, LineSeparator:
- 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;
+ Result := FWideStrings.GetCount;
end;
-function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
-var
- Source, SourceEnd, Dest: PWideChar;
- DestLen: Integer;
+procedure TAnsiStringsForWideStringsAdapter.Insert(Index: Integer; const S: AnsiString);
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, LineSeparator:
- 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;
+ FWideStrings.Insert(Index, StringToWideStringEx(S, AdapterCodePage));
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;
+function TAnsiStringsForWideStringsAdapter.GetObject(Index: Integer): TObject;
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 := WideCompareText(BreakStr, Copy(Line, Pos, BreakLen)) = 0;
- 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);
+ Result := FWideStrings.GetObject(Index);
end;
-function WideWrapText(const Line: WideString; MaxCol: Integer): WideString;
+procedure TAnsiStringsForWideStringsAdapter.PutObject(Index: Integer; AObject: TObject);
begin
- Result := WideWrapText(Line, sLineBreak, [' ', '-', #9], MaxCol); { do not localize }
+ FWideStrings.PutObject(Index, AObject);
end;
-function WideFileCreate(const FileName: WideString): Integer;
+procedure TAnsiStringsForWideStringsAdapter.SetUpdateState(Updating: Boolean);
begin
- Result := Integer(Tnt_CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
- 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0))
+ FWideStrings.SetUpdateState(Updating);
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);
+procedure TAnsiStringsForWideStringsAdapter.LoadFromStreamEx(Stream: TStream; CodePage: Cardinal);
+var
+ Size: Integer;
+ S: AnsiString;
begin
- Result := Integer(Tnt_CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
- ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL, 0));
+ BeginUpdate;
+ try
+ Size := Stream.Size - Stream.Position;
+ SetString(S, nil, Size);
+ Stream.Read(Pointer(S)^, Size);
+ FWideStrings.SetTextStr(StringToWideStringEx(S, CodePage));
+ finally
+ EndUpdate;
+ end;
end;
-function IntValidDateTimeStr(Str: WideString; Flags: Integer): Boolean;
+procedure TAnsiStringsForWideStringsAdapter.SaveToStreamEx(Stream: TStream; CodePage: Cardinal);
var
- TheDateTime: Double;
+ S: AnsiString;
begin
- Result := Succeeded(VarDateFromStr(Str, GetThreadLocale, Flags, TheDateTime));
+ S := WideStringToStringEx(FWideStrings.GetTextStr, CodePage);
+ Stream.WriteBuffer(Pointer(S)^, Length(S));
end;
-function ValidDateTimeStr(Str: WideString): Boolean;
+{ TTntStrings }
+
+constructor TTntStrings.Create;
begin
- Result := IntValidDateTimeStr(Str, 0);
+ inherited;
+ FAnsiStrings := TAnsiStringsForWideStringsAdapter.Create(Self);
+ FLastFileCharSet := csUnicode;
end;
-function ValidDateStr(Str: WideString): Boolean;
+destructor TTntStrings.Destroy;
begin
- Result := IntValidDateTimeStr(Str, VAR_DATEVALUEONLY);
+ StringsAdapter := nil;
+ FreeAndNil(FAnsiStrings);
+ inherited;
end;
-function ValidTimeStr(Str: WideString): Boolean;
+procedure TTntStrings.SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
begin
- Result := IntValidDateTimeStr(Str, VAR_TIMEVALUEONLY);
+ FAnsiStrings.Assign(Value);
end;
-function IntStrToDateTime(Str: WideString; Flags: Integer; ErrorFormatStr: WideString): TDateTime;
-var
- TheDateTime: Double;
+function TTntStrings.Add(const S: WideString): Integer;
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;
+ Result := GetCount;
+ Insert(Result, S);
end;
-function TntStrToDateTime(Str: WideString): TDateTime;
+function TTntStrings.AddObject(const S: WideString; AObject: TObject): Integer;
begin
- Result := IntStrToDateTime(Str, 0, SInvalidDateTime);
+ Result := Add(S);
+ PutObject(Result, AObject);
end;
-function TntStrToDate(Str: WideString): TDateTime;
+procedure TTntStrings.Append(const S: WideString);
begin
- Result := IntStrToDateTime(Str, VAR_DATEVALUEONLY, SInvalidDate);
+ Add(S);
end;
-function TntStrToTime(Str: WideString): TTime;
+procedure TTntStrings.AddStrings(Strings: TTntStrings);
+var
+ I: Integer;
begin
- Result := IntStrToDateTime(Str, VAR_TIMEVALUEONLY, SInvalidTime);
+ BeginUpdate;
+ try
+ for I := 0 to Strings.Count - 1 do
+ AddObject(Strings[I], Strings.Objects[I]);
+ finally
+ EndUpdate;
+ end;
end;
-function WideFindMatchingFile(var F: TSearchRecW): Integer;
-var
- LocalFileTime: TFileTime;
+procedure TTntStrings.Assign(Source: TPersistent);
begin
- with F do
+ if Source is TTntStrings then
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 := FindData.nFileSizeLow;
- Attr := FindData.dwFileAttributes;
- Name := FindData.cFileName;
+ BeginUpdate;
+ try
+ Clear;
+ FDefined := TTntStrings(Source).FDefined;
+ FNameValueSeparator := TTntStrings(Source).FNameValueSeparator;
+ FQuoteChar := TTntStrings(Source).FQuoteChar;
+ FDelimiter := TTntStrings(Source).FDelimiter;
+ AddStrings(TTntStrings(Source));
+ finally
+ EndUpdate;
+ end;
+ Exit;
end;
- Result := 0;
+ if Source is TStrings{TNT-ALLOW TStrings} then
+ begin
+ AnsiStrings.Assign(TStrings{TNT-ALLOW TStrings}(Source));
+ Exit;
+ end;
+ inherited Assign(Source);
end;
-function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
-const
- faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
+procedure TTntStrings.AssignTo(Dest: TPersistent);
begin
- F.ExcludeAttr := not Attr and faSpecial;
- F.FindHandle := Tnt_FindFirstFileW(PWideChar(Path), F.FindData);
- if F.FindHandle <> INVALID_HANDLE_VALUE then
+ // This allows TStrings.Assign(TTntStrings)
+ if Dest is TStrings{TNT-ALLOW TStrings} then
begin
- Result := WideFindMatchingFile(F);
- if Result <> 0 then WideFindClose(F);
- end else
- Result := GetLastError;
+ Dest.Assign(AnsiStrings);
+ Exit;
+ end;
+ inherited;
end;
-function WideFindNext(var F: TSearchRecW): Integer;
+procedure TTntStrings.BeginUpdate;
begin
- if Tnt_FindNextFileW(F.FindHandle, F.FindData) then
- Result := WideFindMatchingFile(F) else
- Result := GetLastError;
+ if FUpdateCount = 0 then SetUpdateState(True);
+ Inc(FUpdateCount);
end;
-procedure WideFindClose(var F: TSearchRecW);
-begin
- if F.FindHandle <> INVALID_HANDLE_VALUE then
+procedure TTntStrings.DefineProperties(Filer: TFiler);
+
+ function DoWrite: Boolean;
begin
- Windows.FindClose(F.FindHandle);
- F.FindHandle := INVALID_HANDLE_VALUE;
+ if Filer.Ancestor <> nil then
+ begin
+ Result := True;
+ if Filer.Ancestor is TTntStrings then Result := not Equals(TTntStrings(Filer.Ancestor))
+ end
+ else Result := Count > 0;
end;
-end;
-function WideDirectoryExists(const Name: WideString): Boolean;
+ function DoWriteAsUTF7: Boolean;
+ var
+ i: integer;
+ begin
+ Result := False;
+ for i := 0 to Count - 1 do begin
+ if (Strings[i] <> '') and (WideStringToUTF8(Strings[i]) <> Strings[i]) then begin
+ Result := True;
+ break; { found a string with non-ASCII chars (> 127) }
+ end;
+ end;
+ end;
+
var
- Code: Cardinal;
+ _DoWrite: Boolean;
begin
- Code := WideFileGetAttr(Name);
- Result := (Integer(Code) <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
+ _DoWrite := DoWrite;
+ Filer.DefineProperty('Strings', ReadData, nil, False); { to be compatible with TStrings }
+ Filer.DefineProperty('WideStrings', ReadData, WriteData, _DoWrite);
+ Filer.DefineProperty('WideStringsW', ReadDataUTF8, nil, False);
+ Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, _DoWrite and DoWriteAsUTF7);
end;
-function WideFileExists(const Name: WideString): Boolean;
-var
- Code: Cardinal;
+procedure TTntStrings.EndUpdate;
begin
- Code := WideFileGetAttr(Name);
- Result := (Integer(Code) <> -1) and ((FILE_ATTRIBUTE_DIRECTORY and Code) = 0);
+ Dec(FUpdateCount);
+ if FUpdateCount = 0 then SetUpdateState(False);
end;
-function WideFileGetAttr(const FileName: WideString): Cardinal;
+function TTntStrings.Equals(Strings: TTntStrings): Boolean;
+var
+ I, Count: Integer;
begin
- if Win32PlatformIsUnicode then
- Result := GetFileAttributesW(PWideChar(FileName))
- else
- Result := GetFileAttributesA(PAnsiChar(AnsiString(FileName)))
+ Result := False;
+ Count := GetCount;
+ if Count <> Strings.GetCount then Exit;
+ for I := 0 to Count - 1 do if Get(I) <> Strings.Get(I) then Exit;
+ Result := True;
end;
-function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
+procedure TTntStrings.Error(const Msg: WideString; Data: Integer);
+
+ function ReturnAddr: Pointer;
+ asm
+ MOV EAX,[EBP+4]
+ end;
+
begin
- if Win32PlatformIsUnicode then
- Result := SetFileAttributesW(PWideChar(FileName), Attr)
- else
- Result := SetFileAttributesA(PAnsiChar(AnsiString(FileName)), Attr)
+ raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
end;
-function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
+procedure TTntStrings.Error(Msg: PResStringRec; Data: Integer);
begin
- Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = PathDelim);
+ Error(WideLoadResString(Msg), Data);
end;
-function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
+procedure TTntStrings.Exchange(Index1, Index2: Integer);
+var
+ TempObject: TObject;
+ TempString: WideString;
begin
- Result := False;
- if (Index <= 0) or (Index > Length(S)) then exit;
- Result := StrScanW(PWideChar(Delimiters), S[Index]) <> nil;
+ BeginUpdate;
+ try
+ TempString := Strings[Index1];
+ TempObject := Objects[Index1];
+ Strings[Index1] := Strings[Index2];
+ Objects[Index1] := Objects[Index2];
+ Strings[Index2] := TempString;
+ Objects[Index2] := TempObject;
+ finally
+ EndUpdate;
+ end;
end;
-function WideIncludeTrailingBackslash(const S: WideString): WideString;
+function TTntStrings.ExtractName(const S: WideString): WideString;
+var
+ P: Integer;
begin
Result := S;
- if not WideIsPathDelimiter(Result, Length(Result)) then Result := Result + PathDelim;
+ P := Pos(NameValueSeparator, Result);
+ if P <> 0 then
+ SetLength(Result, P-1) else
+ SetLength(Result, 0);
end;
-function WideExcludeTrailingBackslash(const S: WideString): WideString;
+function TTntStrings.GetCapacity: Integer;
+begin // descendents may optionally override/replace this default implementation
+ Result := Count;
+end;
+
+function TTntStrings.GetCommaText: WideString;
+var
+ LOldDefined: TWideStringsDefined;
+ LOldDelimiter: WideChar;
+ LOldQuoteChar: WideChar;
begin
- Result := S;
- if WideIsPathDelimiter(Result, Length(Result)) then
- SetLength(Result, Length(Result)-1);
+ LOldDefined := FDefined;
+ LOldDelimiter := FDelimiter;
+ LOldQuoteChar := FQuoteChar;
+ Delimiter := ',';
+ QuoteChar := '"';
+ try
+ Result := GetDelimitedText;
+ finally
+ FDelimiter := LOldDelimiter;
+ FQuoteChar := LOldQuoteChar;
+ FDefined := LOldDefined;
+ end;
end;
-function WideLastDelimiter(const Delimiters, S: WideString): Integer;
+function TTntStrings.GetDelimitedText: WideString;
var
+ S: WideString;
P: PWideChar;
+ I, Count: Integer;
begin
- Result := Length(S);
- P := PWideChar(Delimiters);
- while Result > 0 do
+ Count := GetCount;
+ if (Count = 1) and (Get(0) = '') then
+ Result := WideString(QuoteChar) + QuoteChar
+ else
begin
- if (S[Result] <> #0) and (StrScanW(P, S[Result]) <> nil) then
- Exit;
- Dec(Result);
+ Result := '';
+ for I := 0 to Count - 1 do
+ begin
+ S := Get(I);
+ P := PWideChar(S);
+ while not ((P^ in [WideChar(#0)..WideChar(' ')]) or (P^ = QuoteChar) or (P^ = Delimiter)) do
+ Inc(P);
+ if (P^ <> #0) then S := WideQuotedStr(S, QuoteChar);
+ Result := Result + S + Delimiter;
+ end;
+ System.Delete(Result, Length(Result), 1);
end;
end;
-function WideChangeFileExt(const FileName, Extension: WideString): WideString;
-var
- I: Integer;
+function TTntStrings.GetName(Index: Integer): WideString;
begin
- I := WideLastDelimiter('.\:',Filename);
- if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
- Result := Copy(FileName, 1, I - 1) + Extension;
+ Result := ExtractName(Get(Index));
end;
-function WideExtractFilePath(const FileName: WideString): WideString;
-var
- I: Integer;
+function TTntStrings.GetObject(Index: Integer): TObject;
begin
- I := WideLastDelimiter('\:', FileName);
- Result := Copy(FileName, 1, I);
+ Result := nil;
end;
-function WideExtractFileDir(const FileName: WideString): WideString;
-var
- I: Integer;
+function TTntStrings.GetTextW: PWideChar;
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);
+ Result := StrNewW(PWideChar(GetTextStr));
end;
-function WideExtractFileDrive(const FileName: WideString): WideString;
+function TTntStrings.GetTextStr: WideString;
var
- I, J: Integer;
+ I, L, Size, Count: Integer;
+ P: PWideChar;
+ S, LB: WideString;
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
+ Count := GetCount;
+ Size := 0;
+ LB := sLineBreak;
+ for I := 0 to Count - 1 do Inc(Size, Length(Get(I)) + Length(LB));
+ SetString(Result, nil, Size);
+ P := Pointer(Result);
+ for I := 0 to Count - 1 do
begin
- J := 0;
- I := 3;
- While (I < Length(FileName)) and (J < 2) do
+ S := Get(I);
+ L := Length(S);
+ if L <> 0 then
begin
- if FileName[I] = PathDelim then Inc(J);
- if J < 2 then Inc(I);
+ System.Move(Pointer(S)^, P^, L * SizeOf(WideChar));
+ Inc(P, L);
end;
- if FileName[I] = PathDelim then Dec(I);
- Result := Copy(FileName, 1, I);
- end else Result := '';
+ L := Length(LB);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(LB)^, P^, L * SizeOf(WideChar));
+ Inc(P, L);
+ end;
+ end;
end;
-function WideExtractFileName(const FileName: WideString): WideString;
+function TTntStrings.GetValue(const Name: 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
+ I := IndexOfName(Name);
+ if I >= 0 then
+ Result := Copy(Get(I), Length(Name) + 2, MaxInt) else
Result := '';
end;
-function WideForceDirectories(Dir: WideString): Boolean;
+function TTntStrings.IndexOf(const S: WideString): Integer;
begin
- Result := True;
- if Length(Dir) = 0 then
- raise Exception.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 begin
- if Win32PlatformIsUnicode then
- Result := CreateDirectoryW(PWideChar(Dir), nil)
- else
- Result := CreateDirectoryA(PAnsiChar(AnsiString(Dir)), nil)
- end;
+ for Result := 0 to GetCount - 1 do
+ if CompareStrings(Get(Result), S) = 0 then Exit;
+ Result := -1;
end;
-function WideFileSearch(const Name, DirList: WideString): WideString;
+function TTntStrings.IndexOfName(const Name: WideString): Integer;
var
- I, P, L: Integer;
- C: WideChar;
+ P: Integer;
+ S: WideString;
begin
- Result := Name;
- P := 1;
- L := Length(DirList);
- while True do
+ for Result := 0 to GetCount - 1 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;
+ S := Get(Result);
+ P := Pos(NameValueSeparator, S);
+ if (P <> 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then Exit;
end;
- Result := '';
+ Result := -1;
end;
+function TTntStrings.IndexOfObject(AObject: TObject): Integer;
+begin
+ for Result := 0 to GetCount - 1 do
+ if GetObject(Result) = AObject then Exit;
+ Result := -1;
+end;
-function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
+procedure TTntStrings.InsertObject(Index: Integer; const S: WideString;
+ AObject: TObject);
+begin
+ Insert(Index, S);
+ PutObject(Index, AObject);
+end;
+
+procedure TTntStrings.LoadFromFile(const FileName: 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)));
+ Stream: TStream;
+begin
+ Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ FLastFileCharSet := AutoDetectCharacterSet(Stream);
+ Stream.Position := 0;
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
end;
+end;
- function Next(var Lead: PWideChar): PWideChar;
- begin
- Result := Lead;
- if Result = nil then Exit;
- Lead := StrScanW(Lead, PathDelim);
- if Lead <> nil then
+procedure TTntStrings.LoadFromStream(Stream: TStream; WithBOM: Boolean = True);
+var
+ DataLeft: Integer;
+ StreamCharSet: TTntStreamCharSet;
+ SW: WideString;
+ SA: AnsiString;
+begin
+ BeginUpdate;
+ try
+ if WithBOM then
+ StreamCharSet := AutoDetectCharacterSet(Stream)
+ else
+ StreamCharSet := csUnicode;
+ DataLeft := Stream.Size - Stream.Position;
+ if (StreamCharSet in [csUnicode, csUnicodeSwapped]) then
begin
- Lead^ := #0;
- Inc(Lead);
+ // BOM indicates Unicode text stream
+ if DataLeft < SizeOf(WideChar) then
+ SW := ''
+ else begin
+ SetLength(SW, DataLeft div SizeOf(WideChar));
+ Stream.Read(PWideChar(SW)^, DataLeft);
+ if StreamCharSet = csUnicodeSwapped then
+ StrSwapByteOrder(PWideChar(SW));
+ end;
+ SetTextStr(SW);
+ end
+ else if StreamCharSet = csUtf8 then
+ begin
+ // BOM indicates UTF-8 text stream
+ SetLength(SA, DataLeft div SizeOf(AnsiChar));
+ Stream.Read(PAnsiChar(SA)^, DataLeft);
+ SetTextStr(UTF8ToWideString(SA));
+ end
+ else
+ begin
+ // without byte order mark it is assumed that we are loading ANSI text
+ SetLength(SA, DataLeft div SizeOf(AnsiChar));
+ Stream.Read(PAnsiChar(SA)^, DataLeft);
+ SetTextStr(SA);
end;
+ finally
+ EndUpdate;
end;
+end;
+procedure TTntStrings.Move(CurIndex, NewIndex: Integer);
+var
+ TempObject: TObject;
+ TempString: WideString;
begin
- if WideSameText(WideExtractFileDrive(BaseName), WideExtractFileDrive(DestName)) then
+ if CurIndex <> NewIndex 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);
+ BeginUpdate;
+ try
+ TempString := Get(CurIndex);
+ TempObject := GetObject(CurIndex);
+ Delete(CurIndex);
+ InsertObject(NewIndex, TempString, TempObject);
+ finally
+ EndUpdate;
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;
end;
-function WideRenameFile(const OldName, NewName: WideString): Boolean;
+procedure TTntStrings.Put(Index: Integer; const S: WideString);
+var
+ TempObject: TObject;
begin
- if Win32PlatformIsUnicode then
- Result := MoveFileW(PWideChar(OldName), PWideChar(NewName))
- else
- Result := MoveFileA(PAnsiChar(AnsiString(OldName)), PAnsiChar(AnsiString(NewName)))
+ TempObject := GetObject(Index);
+ Delete(Index);
+ InsertObject(Index, S, TempObject);
end;
-function WideDeleteFile(const FileName: WideString): Boolean;
+procedure TTntStrings.PutObject(Index: Integer; AObject: TObject);
begin
- if Win32PlatformIsUnicode then
- Result := DeleteFileW(PWideChar(FileName))
- else
- Result := DeleteFileA(PAnsiChar(AnsiString(FileName)))
end;
-function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
+procedure TTntStrings.ReadData(Reader: TReader);
begin
- if Win32PlatformIsUnicode then
- Result := CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists)
- else
- Result := CopyFileA(PAnsiChar(AnsiString(FromFile)), PAnsiChar(AnsiString(ToFile)), FailIfExists)
+ if Reader.NextValue in [vaString, vaLString] then
+ SetTextStr(Reader.ReadString) {JCL compatiblity}
+ else if Reader.NextValue = vaWString then
+ SetTextStr(Reader.ReadWideString) {JCL compatiblity}
+ else begin
+ BeginUpdate;
+ try
+ Clear;
+ Reader.ReadListBegin;
+ while not Reader.EndOfList do
+ if Reader.NextValue in [vaString, vaLString] then
+ Add(Reader.ReadString) {TStrings compatiblity}
+ else
+ Add(Reader.ReadWideString);
+ Reader.ReadListEnd;
+ finally
+ EndUpdate;
+ end;
+ end;
end;
-{ TTntFileStream }
-
-constructor TTntFileStream.Create(const FileName: WideString; Mode: Word);
-var
- CreateHandle: Integer;
+procedure TTntStrings.ReadDataUTF7(Reader: TReader);
begin
- if Mode = fmCreate then
+ Reader.ReadListBegin;
+ if ReaderNeedsUtfHelp(Reader) then
begin
- CreateHandle := WideFileCreate(FileName);
- if CreateHandle < 0 then
- raise EFCreateError.CreateResFmt(PResStringRec(@SFCreateError), [FileName]);
- end else
- begin
- CreateHandle := WideFileOpen(FileName, Mode);
- if CreateHandle < 0 then
- raise EFOpenError.CreateResFmt(PResStringRec(@SFOpenError), [FileName]);
+ BeginUpdate;
+ try
+ Clear;
+ while not Reader.EndOfList do
+ Add(UTF7ToWideString(Reader.ReadString))
+ finally
+ EndUpdate;
+ end;
+ end else begin
+ while not Reader.EndOfList do
+ Reader.ReadString; { do nothing with Result }
end;
- inherited Create(CreateHandle);
+ Reader.ReadListEnd;
end;
-destructor TTntFileStream.Destroy;
+procedure TTntStrings.ReadDataUTF8(Reader: TReader);
begin
- if Handle >= 0 then FileClose(Handle);
+ Reader.ReadListBegin;
+ if ReaderNeedsUtfHelp(Reader)
+ or (Count = 0){ Legacy support where 'WideStrings' was never written in lieu of WideStringsW }
+ then begin
+ BeginUpdate;
+ try
+ Clear;
+ while not Reader.EndOfList do
+ Add(UTF8ToWideString(Reader.ReadString))
+ finally
+ EndUpdate;
+ end;
+ end else begin
+ while not Reader.EndOfList do
+ Reader.ReadString; { do nothing with Result }
+ end;
+ Reader.ReadListEnd;
end;
-{ TTntResourceStream }
+procedure TTntStrings.SaveToFile(const FileName: WideString);
+var
+ Stream: TStream;
+begin
+ Stream := TTntFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
-constructor TTntResourceStream.Create(Instance: THandle; const ResName: WideString;
- ResType: PWideChar);
+procedure TTntStrings.SaveToStream(Stream: TStream; WithBOM: Boolean = True);
+// Saves the currently loaded text into the given stream.
+// WithBOM determines whether to write a byte order mark or not.
+var
+ SW: WideString;
+ BOM: WideChar;
begin
- inherited Create;
- Initialize(Instance, PWideChar(ResName), ResType);
+ if WithBOM then begin
+ BOM := UNICODE_BOM;
+ Stream.WriteBuffer(BOM, SizeOf(WideChar));
+ end;
+ SW := GetTextStr;
+ Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
end;
-constructor TTntResourceStream.CreateFromID(Instance: THandle; ResID: Word;
- ResType: PWideChar);
+procedure TTntStrings.SetCapacity(NewCapacity: Integer);
begin
- inherited Create;
- Initialize(Instance, PWideChar(ResID), ResType);
+ // do nothing - descendents may optionally implement this method
end;
-procedure TTntResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);
-
- procedure Error;
- begin
- raise EResNotFound.CreateFmt(SResNotFound, [Name]);
- end;
-
+procedure TTntStrings.SetCommaText(const Value: WideString);
begin
- HResInfo := FindResourceW(Instance, Name, ResType);
- if HResInfo = 0 then Error;
- HGlobal := LoadResource(Instance, HResInfo);
- if HGlobal = 0 then Error;
- SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
+ Delimiter := ',';
+ QuoteChar := '"';
+ SetDelimitedText(Value);
end;
-destructor TTntResourceStream.Destroy;
+procedure TTntStrings.SetStringsAdapter(const Value: IWideStringsAdapter);
begin
- UnlockResource(HGlobal);
- FreeResource(HGlobal);
- inherited Destroy;
+ if FAdapter <> nil then FAdapter.ReleaseStrings;
+ FAdapter := Value;
+ if FAdapter <> nil then FAdapter.ReferenceStrings(Self);
end;
-function TTntResourceStream.Write(const Buffer; Count: Longint): Longint;
+procedure TTntStrings.SetTextW(const Text: PWideChar);
begin
- raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));
+ SetTextStr(Text);
end;
-{ TAnsiStringsForWideStrings }
-
-type
- TAnsiStringsForWideStrings = class(TStrings{TNT-ALLOW TStrings})
- private
- FWideStrings: TTntWideStrings;
- protected
- function Get(Index: Integer): AnsiString; override;
- procedure Put(Index: Integer; const S: AnsiString); override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetUpdateState(Updating: Boolean); override;
- public
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- procedure Insert(Index: Integer; const S: AnsiString); override;
+procedure TTntStrings.SetTextStr(const Value: WideString);
+var
+ P, Start: PWideChar;
+ S: WideString;
+begin
+ BeginUpdate;
+ try
+ Clear;
+ P := Pointer(Value);
+ if P <> nil then
+ while P^ <> #0 do
+ begin
+ Start := P;
+ while not (P^ in [WideChar(#0), WideChar(#10), WideChar(#13)]) and (P^ <> WideLineSeparator) do
+ Inc(P);
+ SetString(S, Start, P - Start);
+ Add(S);
+ if P^ = #13 then Inc(P);
+ if P^ = #10 then Inc(P);
+ if P^ = WideLineSeparator then Inc(P);
+ end;
+ finally
+ EndUpdate;
end;
+end;
-procedure TAnsiStringsForWideStrings.Clear;
+procedure TTntStrings.SetUpdateState(Updating: Boolean);
begin
- FWideStrings.Clear;
end;
-procedure TAnsiStringsForWideStrings.Delete(Index: Integer);
+procedure TTntStrings.SetValue(const Name, Value: WideString);
+var
+ I: Integer;
begin
- FWideStrings.Delete(Index);
+ I := IndexOfName(Name);
+ if Value <> '' then
+ begin
+ if I < 0 then I := Add('');
+ Put(I, Name + NameValueSeparator + Value);
+ end else
+ begin
+ if I >= 0 then Delete(I);
+ end;
end;
-function TAnsiStringsForWideStrings.Get(Index: Integer): AnsiString;
+procedure TTntStrings.WriteData(Writer: TWriter);
+var
+ I: Integer;
begin
- Result := FWideStrings.Get(Index);
+ Writer.WriteListBegin;
+ for I := 0 to Count-1 do begin
+ {$IFDEF COMPILER_6_UP}
+ Writer.WriteWideString(Get(I));
+ {$ELSE}
+ { Delphi 5 and lower can't always read its own strings. }
+ { If a string is too long, CombineString/CombineWideString in Classes }
+ { requires that every segment be of the same type (toString/toWString). }
+ Writer.WriteString(Get(I));
+ {$ENDIF}
+ end;
+ Writer.WriteListEnd;
end;
-procedure TAnsiStringsForWideStrings.Put(Index: Integer; const S: AnsiString);
+procedure TTntStrings.WriteDataUTF7(Writer: TWriter);
+var
+ I: Integer;
begin
- FWideStrings.Put(Index, S);
+ Writer.WriteListBegin;
+ for I := 0 to Count-1 do
+ Writer.WriteString(WideStringToUTF7(Get(I)));
+ Writer.WriteListEnd;
end;
-function TAnsiStringsForWideStrings.GetCount: Integer;
+procedure TTntStrings.SetDelimitedText(const Value: WideString);
+var
+ P, P1: PWideChar;
+ S: WideString;
begin
- Result := FWideStrings.GetCount;
+ BeginUpdate;
+ try
+ Clear;
+ P := PWideChar(Value);
+ while P^ in [WideChar(#1)..WideChar(' ')] do
+ Inc(P);
+ while P^ <> #0 do
+ begin
+ if P^ = QuoteChar then
+ S := WideExtractQuotedStr(P, QuoteChar)
+ else
+ begin
+ P1 := P;
+ while (P^ > ' ') and (P^ <> Delimiter) do
+ Inc(P);
+ SetString(S, P1, P - P1);
+ end;
+ Add(S);
+ while P^ in [WideChar(#1)..WideChar(' ')] do
+ Inc(P);
+ if P^ = Delimiter then
+ begin
+ P1 := P;
+ Inc(P1);
+ if P1^ = #0 then
+ Add('');
+ repeat
+ Inc(P);
+ until not (P^ in [WideChar(#1)..WideChar(' ')]);
+ end;
+ end;
+ finally
+ EndUpdate;
+ end;
end;
-procedure TAnsiStringsForWideStrings.Insert(Index: Integer; const S: AnsiString);
+function TTntStrings.GetDelimiter: WideChar;
begin
- FWideStrings.Insert(Index, S);
+ if not (sdDelimiter in FDefined) then
+ Delimiter := ',';
+ Result := FDelimiter;
end;
-function TAnsiStringsForWideStrings.GetObject(Index: Integer): TObject;
+function TTntStrings.GetQuoteChar: WideChar;
begin
- Result := FWideStrings.GetObject(Index);
+ if not (sdQuoteChar in FDefined) then
+ QuoteChar := '"';
+ Result := FQuoteChar;
end;
-procedure TAnsiStringsForWideStrings.PutObject(Index: Integer; AObject: TObject);
+procedure TTntStrings.SetDelimiter(const Value: WideChar);
begin
- FWideStrings.PutObject(Index, AObject);
+ if (FDelimiter <> Value) or not (sdDelimiter in FDefined) then
+ begin
+ Include(FDefined, sdDelimiter);
+ FDelimiter := Value;
+ end
end;
-procedure TAnsiStringsForWideStrings.SetUpdateState(Updating: Boolean);
+procedure TTntStrings.SetQuoteChar(const Value: WideChar);
begin
- FWideStrings.SetUpdateState(Updating);
+ if (FQuoteChar <> Value) or not (sdQuoteChar in FDefined) then
+ begin
+ Include(FDefined, sdQuoteChar);
+ FQuoteChar := Value;
+ end
end;
-{ TTntWideStrings }
+function TTntStrings.CompareStrings(const S1, S2: WideString): Integer;
+begin
+ Result := WideCompareText(S1, S2);
+end;
-constructor TTntWideStrings.Create;
+function TTntStrings.GetNameValueSeparator: WideChar;
begin
- inherited;
- FAnsiStrings := TAnsiStringsForWideStrings.Create;
- TAnsiStringsForWideStrings(FAnsiStrings).FWideStrings := Self;
+ if not (sdNameValueSeparator in FDefined) then
+ NameValueSeparator := '=';
+ Result := FNameValueSeparator;
end;
-destructor TTntWideStrings.Destroy;
+procedure TTntStrings.SetNameValueSeparator(const Value: WideChar);
begin
- FreeAndNil(FAnsiStrings);
- inherited;
+ if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then
+ begin
+ Include(FDefined, sdNameValueSeparator);
+ FNameValueSeparator := Value;
+ end
end;
-procedure TTntWideStrings.SetAnsiStrings(const Value: TStrings{TNT-ALLOW TStrings});
+function TTntStrings.GetValueFromIndex(Index: Integer): WideString;
begin
- Clear;
- AddStrings(Value);
+ if Index >= 0 then
+ Result := Copy(Get(Index), Length(Names[Index]) + 2, MaxInt) else
+ Result := '';
end;
-{$IFDEF JCL}
-function TTntWideStrings.GetText: WideString;
+procedure TTntStrings.SetValueFromIndex(Index: Integer; const Value: WideString);
begin
- Result := GetTextStr;
+ if Value <> '' then
+ begin
+ if Index < 0 then Index := Add('');
+ Put(Index, Names[Index] + NameValueSeparator + Value);
+ end
+ else
+ if Index >= 0 then Delete(Index);
end;
-procedure TTntWideStrings.SetText(const Value: WideString);
+{ TTntStringList }
+
+destructor TTntStringList.Destroy;
begin
- SetTextStr(Value);
+ FOnChange := nil;
+ FOnChanging := nil;
+ inherited Destroy;
+ if FCount <> 0 then Finalize(FList^[0], FCount);
+ FCount := 0;
+ SetCapacity(0);
end;
-function TTntWideStrings.GetTextStr: WideString;
+function TTntStringList.Add(const S: WideString): Integer;
begin
- Result := GetSeparatedText(WideCRLF);
+ Result := AddObject(S, nil);
end;
-procedure TTntWideStrings.SetTextStr(const Value: WideString);
+function TTntStringList.AddObject(const S: WideString; AObject: TObject): Integer;
begin
- inherited SetText(Value);
+ if not Sorted then
+ Result := FCount
+ else
+ if Find(S, Result) then
+ case Duplicates of
+ dupIgnore: Exit;
+ dupError: Error(PResStringRec(@SDuplicateString), 0);
+ end;
+ InsertItem(Result, S, AObject);
end;
-procedure TTntWideStrings.PutObject(Index: Integer; AObject: TObject);
+procedure TTntStringList.Changed;
begin
- // do nothing.
+ if (FUpdateCount = 0) and Assigned(FOnChange) then
+ FOnChange(Self);
end;
-procedure TTntWideStrings.Put(Index: Integer; const S: WideString);
-var
- TempObject: TObject;
+procedure TTntStringList.Changing;
begin
- TempObject := GetObject(Index);
- Delete(Index);
- InsertObject(Index, S, TempObject);
+ if (FUpdateCount = 0) and Assigned(FOnChanging) then
+ FOnChanging(Self);
end;
-{$ENDIF}
-
-procedure TTntWideStrings.ReadData(Reader: TReader);
+procedure TTntStringList.Clear;
begin
- if Reader.NextValue in [vaString, vaLString] then
- SetTextStr(Reader.ReadString) {JCL compatiblity}
- else if Reader.NextValue = vaWString then
- SetTextStr(Reader.ReadWideString) {JCL compatiblity}
- else begin
- BeginUpdate;
- try
- Clear;
- Reader.ReadListBegin;
- while not Reader.EndOfList do
- if Reader.NextValue in [vaString, vaLString] then
- Add(Reader.ReadString) {TStrings compatiblity}
- else
- Add(Reader.ReadWideString);
- Reader.ReadListEnd;
- finally
- EndUpdate;
- end;
+ if FCount <> 0 then
+ begin
+ Changing;
+ Finalize(FList^[0], FCount);
+ FCount := 0;
+ SetCapacity(0);
+ Changed;
end;
end;
-procedure TTntWideStrings.WriteData(Writer: TWriter);
-var
- I: Integer;
+procedure TTntStringList.Delete(Index: Integer);
begin
- Writer.WriteListBegin;
- for I := 0 to Count-1 do
- Writer.WriteWideString(Get(I));
- Writer.WriteListEnd;
+ if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
+ Changing;
+ Finalize(FList^[Index]);
+ Dec(FCount);
+ if Index < FCount then
+ System.Move(FList^[Index + 1], FList^[Index],
+ (FCount - Index) * SizeOf(TWideStringItem));
+ Changed;
end;
-{$IFDEF VER130}
-const IsDelphi5 = True;
-{$ELSE}
-const IsDelphi5 = False;
-{$ENDIF}
-
-procedure TTntWideStrings.ReadDataUTF8(Reader: TReader);
+procedure TTntStringList.Exchange(Index1, Index2: Integer);
begin
- Reader.ReadListBegin;
- if IsDelphi5 { Delphi 5 always needs UTF help }
- or (csDesigning in Reader.Owner.ComponentState) { Designtime always needs UTF help }
- or (Count = 0){ Legacy support where 'WideStrings' was never written in lieu of WideStringsW }
- then begin
- BeginUpdate;
- try
- Clear;
- while not Reader.EndOfList do
- Add(UTF8ToWideString(Reader.ReadString))
- finally
- EndUpdate;
- end;
- end else begin
- while not Reader.EndOfList do
- Reader.ReadString; { do nothing with Result }
- end;
- Reader.ReadListEnd;
+ if (Index1 < 0) or (Index1 >= FCount) then Error(PResStringRec(@SListIndexError), Index1);
+ if (Index2 < 0) or (Index2 >= FCount) then Error(PResStringRec(@SListIndexError), Index2);
+ Changing;
+ ExchangeItems(Index1, Index2);
+ Changed;
end;
-procedure TTntWideStrings.ReadDataUTF7(Reader: TReader);
+procedure TTntStringList.ExchangeItems(Index1, Index2: Integer);
+var
+ Temp: Integer;
+ Item1, Item2: PWideStringItem;
begin
- Reader.ReadListBegin;
- if IsDelphi5 { Delphi 5 always needs UTF help }
- or (csDesigning in Reader.Owner.ComponentState) { Designtime always needs UTF help }
- then begin
- BeginUpdate;
- try
- Clear;
- while not Reader.EndOfList do
- Add(UTF7ToWideString(Reader.ReadString))
- finally
- EndUpdate;
- end;
- end else begin
- while not Reader.EndOfList do
- Reader.ReadString; { do nothing with Result }
- end;
- Reader.ReadListEnd;
+ Item1 := @FList^[Index1];
+ Item2 := @FList^[Index2];
+ Temp := Integer(Item1^.FString);
+ Integer(Item1^.FString) := Integer(Item2^.FString);
+ Integer(Item2^.FString) := Temp;
+ Temp := Integer(Item1^.FObject);
+ Integer(Item1^.FObject) := Integer(Item2^.FObject);
+ Integer(Item2^.FObject) := Temp;
end;
-procedure TTntWideStrings.WriteDataUTF7(Writer: TWriter);
+function TTntStringList.Find(const S: WideString; var Index: Integer): Boolean;
var
- I: Integer;
+ L, H, I, C: Integer;
begin
- Writer.WriteListBegin;
- for I := 0 to Count-1 do
- Writer.WriteString(WideStringToUTF7(Get(I)));
- Writer.WriteListEnd;
-end;
-
-procedure TTntWideStrings.DefineProperties(Filer: TFiler);
-
- function DoWrite: Boolean;
+ Result := False;
+ L := 0;
+ H := FCount - 1;
+ while L <= H do
begin
- if Filer.Ancestor <> nil then
+ I := (L + H) shr 1;
+ C := CompareStrings(FList^[I].FString, S);
+ if C < 0 then L := I + 1 else
begin
- Result := True;
- if Filer.Ancestor is TWideStrings then Result := not Equals(TWideStrings(Filer.Ancestor))
- end
- else Result := Count > 0;
- end;
-
- function DoWriteAsUTF7: Boolean;
- var
- i: integer;
- begin
- Result := False;
- for i := 0 to Count - 1 do begin
- if (Strings[i] <> '') and (WideStringToUTF8(Strings[i]) <> Strings[i]) then begin
+ H := I - 1;
+ if C = 0 then
+ begin
Result := True;
- break; { found a string with non-ASCII chars (> 127) }
+ if Duplicates <> dupAccept then L := I;
end;
end;
end;
+ Index := L;
+end;
-var
- _DoWrite: Boolean;
+function TTntStringList.Get(Index: Integer): WideString;
begin
- _DoWrite := DoWrite;
- Filer.DefineProperty('Strings', ReadData, nil, False); { to be compatible with TStrings }
- Filer.DefineProperty('WideStrings', ReadData, WriteData, _DoWrite);
- Filer.DefineProperty('WideStringsW', ReadDataUTF8, nil, False);
- Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, _DoWrite and DoWriteAsUTF7);
+ if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
+ Result := FList^[Index].FString;
end;
-procedure TTntWideStrings.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
+function TTntStringList.GetCapacity: Integer;
begin
- try
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
- except
- RaiseLastOSError;
- end;
+ Result := FCapacity;
end;
-procedure TTntWideStrings.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
+function TTntStringList.GetCount: Integer;
begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
+ Result := FCount;
end;
-{ TTntWideStringListHelper }
-type
- TTntWideStringListHelper = class(TWideStringList{TNT-ALLOW TWideStringList})
- private
- Parent: TTntWideStringList;
- procedure InheritedChanged;
- procedure InheritedChanging;
- function InheritedFind(const S: WideString; var Index: Integer): Boolean;
- procedure InheritedSort;
- protected
- procedure Changed; override;
- procedure Changing; override;
- public
- function Find(const S: WideString; var Index: Integer): Boolean; override;
- procedure Sort; override;
- end;
+function TTntStringList.GetObject(Index: Integer): TObject;
+begin
+ if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
+ Result := FList^[Index].FObject;
+end;
-procedure TTntWideStringListHelper.InheritedChanged;
+procedure TTntStringList.Grow;
+var
+ Delta: Integer;
begin
- inherited Changed;
+ if FCapacity > 64 then Delta := FCapacity div 4 else
+ if FCapacity > 8 then Delta := 16 else
+ Delta := 4;
+ SetCapacity(FCapacity + Delta);
end;
-procedure TTntWideStringListHelper.Changed;
+function TTntStringList.IndexOf(const S: WideString): Integer;
begin
- if Parent <> nil then
- Parent.Changed;
+ if not Sorted then Result := inherited IndexOf(S) else
+ if not Find(S, Result) then Result := -1;
end;
-procedure TTntWideStringListHelper.InheritedChanging;
+function TTntStringList.IndexOfName(const Name: WideString): Integer;
+var
+ NameKey: WideString;
begin
- inherited Changing;
+ if not Sorted then
+ Result := inherited IndexOfName(Name)
+ else begin
+ // use sort to find index more quickly
+ NameKey := Name + NameValueSeparator;
+ Find(NameKey, Result);
+ if (Result < 0) or (Result > Count - 1) then
+ Result := -1
+ else if CompareStrings(NameKey, Copy(Strings[Result], 1, Length(NameKey))) <> 0 then
+ Result := -1
+ end;
end;
-procedure TTntWideStringListHelper.Changing;
+procedure TTntStringList.Insert(Index: Integer; const S: WideString);
begin
- if Parent <> nil then
- Parent.Changing;
+ InsertObject(Index, S, nil);
end;
-function TTntWideStringListHelper.InheritedFind(const S: WideString; var Index: Integer): Boolean;
+procedure TTntStringList.InsertObject(Index: Integer; const S: WideString;
+ AObject: TObject);
begin
- Result := inherited Find(S, Index);
+ if Sorted then Error(PResStringRec(@SSortedListError), 0);
+ if (Index < 0) or (Index > FCount) then Error(PResStringRec(@SListIndexError), Index);
+ InsertItem(Index, S, AObject);
end;
-function TTntWideStringListHelper.Find(const S: WideString; var Index: Integer): Boolean;
+procedure TTntStringList.InsertItem(Index: Integer; const S: WideString; AObject: TObject);
begin
- if Parent <> nil then
- Result := Parent.Find(S, Index)
- else begin
- Index := 0;
- Result := False;
+ Changing;
+ if FCount = FCapacity then Grow;
+ if Index < FCount then
+ System.Move(FList^[Index], FList^[Index + 1],
+ (FCount - Index) * SizeOf(TWideStringItem));
+ with FList^[Index] do
+ begin
+ Pointer(FString) := nil;
+ FObject := AObject;
+ FString := S;
end;
+ Inc(FCount);
+ Changed;
end;
-procedure TTntWideStringListHelper.InheritedSort;
+procedure TTntStringList.Put(Index: Integer; const S: WideString);
begin
- inherited Sort;
+ if Sorted then Error(PResStringRec(@SSortedListError), 0);
+ if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
+ Changing;
+ FList^[Index].FString := S;
+ Changed;
end;
-procedure TTntWideStringListHelper.Sort;
+procedure TTntStringList.PutObject(Index: Integer; AObject: TObject);
begin
- if Parent <> nil then
- Parent.Sort;
+ if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
+ Changing;
+ FList^[Index].FObject := AObject;
+ Changed;
end;
-{ TTntWideStringList }
-
-constructor TTntWideStringList.Create;
+procedure TTntStringList.QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);
+var
+ I, J, P: Integer;
begin
- inherited Create;
- FList := TTntWideStringListHelper.Create;
- TTntWideStringListHelper(FList).Parent := Self;
+ repeat
+ I := L;
+ J := R;
+ P := (L + R) shr 1;
+ repeat
+ while SCompare(Self, I, P) < 0 do Inc(I);
+ while SCompare(Self, J, P) > 0 do Dec(J);
+ if I <= J then
+ begin
+ ExchangeItems(I, J);
+ if P = I then
+ P := J
+ else if P = J then
+ P := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if L < J then QuickSort(L, J, SCompare);
+ L := I;
+ until I >= R;
end;
-destructor TTntWideStringList.Destroy;
+procedure TTntStringList.SetCapacity(NewCapacity: Integer);
begin
- TTntWideStringListHelper(FList).Parent := nil;
- FreeAndNil(FList);
- inherited;
+ ReallocMem(FList, NewCapacity * SizeOf(TWideStringItem));
+ FCapacity := NewCapacity;
end;
-function TTntWideStringList.GetDuplicates: TDuplicates;
+procedure TTntStringList.SetSorted(Value: Boolean);
begin
- Result := FList.Duplicates;
+ if FSorted <> Value then
+ begin
+ if Value then Sort;
+ FSorted := Value;
+ end;
end;
-procedure TTntWideStringList.SetDuplicates(const Value: TDuplicates);
+procedure TTntStringList.SetUpdateState(Updating: Boolean);
begin
- FList.Duplicates := Value;
+ if Updating then Changing else Changed;
end;
-function TTntWideStringList.GetSorted: Boolean;
+function WideStringListCompareStrings(List: TTntStringList; Index1, Index2: Integer): Integer;
begin
- Result := FList.Sorted;
+ Result := List.CompareStrings(List.FList^[Index1].FString,
+ List.FList^[Index2].FString);
end;
-procedure TTntWideStringList.SetSorted(const Value: Boolean);
+procedure TTntStringList.Sort;
begin
- FList.Sorted := Value;
+ CustomSort(WideStringListCompareStrings);
end;
-function TTntWideStringList.GetOnChange: TNotifyEvent;
+procedure TTntStringList.CustomSort(Compare: TWideStringListSortCompare);
begin
- Result := FList.OnChange;
+ if not Sorted and (FCount > 1) then
+ begin
+ Changing;
+ QuickSort(0, FCount - 1, Compare);
+ Changed;
+ end;
end;
-procedure TTntWideStringList.SetOnChange(const Value: TNotifyEvent);
+function TTntStringList.CompareStrings(const S1, S2: WideString): Integer;
begin
- FList.OnChange := Value;
+ if CaseSensitive then
+ Result := WideCompareStr(S1, S2)
+ else
+ Result := WideCompareText(S1, S2);
end;
-function TTntWideStringList.GetOnChanging: TNotifyEvent;
+procedure TTntStringList.SetCaseSensitive(const Value: Boolean);
begin
- Result := FList.OnChanging;
+ if Value <> FCaseSensitive then
+ begin
+ FCaseSensitive := Value;
+ if Sorted then Sort;
+ end;
end;
-procedure TTntWideStringList.SetOnChanging(const Value: TNotifyEvent);
+//------------------------- TntClasses introduced procs ----------------------------------
+
+function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
+var
+ ByteOrderMark: WideChar;
+ BytesRead: Integer;
+ Utf8Test: array[0..2] of AnsiChar;
begin
- FList.OnChanging := Value;
+ // Byte Order Mark
+ ByteOrderMark := #0;
+ if (Stream.Size - Stream.Position) >= SizeOf(ByteOrderMark) then begin
+ BytesRead := Stream.Read(ByteOrderMark, SizeOf(ByteOrderMark));
+ if (ByteOrderMark <> UNICODE_BOM) and (ByteOrderMark <> UNICODE_BOM_SWAPPED) then begin
+ ByteOrderMark := #0;
+ Stream.Seek(-BytesRead, soFromCurrent);
+ if (Stream.Size - Stream.Position) >= Length(Utf8Test) * SizeOf(AnsiChar) then begin
+ BytesRead := Stream.Read(Utf8Test[0], Length(Utf8Test) * SizeOf(AnsiChar));
+ if Utf8Test <> UTF8_BOM then
+ Stream.Seek(-BytesRead, soFromCurrent);
+ end;
+ end;
+ end;
+ // Test Byte Order Mark
+ if ByteOrderMark = UNICODE_BOM then
+ Result := csUnicode
+ else if ByteOrderMark = UNICODE_BOM_SWAPPED then
+ Result := csUnicodeSwapped
+ else if Utf8Test = UTF8_BOM then
+ Result := csUtf8
+ else
+ Result := csAnsi;
end;
-function TTntWideStringList.Add(const S: WideString): Integer;
+function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;
+ Target: Pointer; var Index: Integer): Boolean;
+var
+ L, H, I, C: Integer;
begin
- Result := FList.Add(S);
+ Result := False;
+ L := 0;
+ H := List.Count - 1;
+ while L <= H do
+ begin
+ I := (L + H) shr 1;
+ C := TargetCompare(List[i], Target);
+ if C < 0 then L := I + 1 else
+ begin
+ H := I - 1;
+ if C = 0 then
+ begin
+ Result := True;
+ L := I;
+ end;
+ end;
+ end;
+ Index := L;
end;
-procedure TTntWideStringList.Clear;
+function ClassIsRegistered(const clsid: TCLSID): Boolean;
+var
+ OleStr: POleStr;
+ Reg: TRegIniFile;
+ Key, Filename: WideString;
begin
- FList.Clear;
+ // First, check to see if there is a ProgID. This will tell if the
+ // control is registered on the machine. No ProgID, control won't run
+ Result := ProgIDFromCLSID(clsid, OleStr) = S_OK;
+ if not Result then Exit; //Bail as soon as anything goes wrong.
+
+ // Next, make sure that the file is actually there by rooting it out
+ // of the registry
+ Key := WideFormat('\SOFTWARE\Classes\CLSID\%s', [GUIDToString(clsid)]);
+ Reg := TRegIniFile.Create;
+ try
+ Reg.RootKey := HKEY_LOCAL_MACHINE;
+ Result := Reg.OpenKeyReadOnly(Key);
+ if not Result then Exit; // Bail as soon as anything goes wrong.
+
+ FileName := Reg.ReadString('InProcServer32', '', EmptyStr);
+ if (Filename = EmptyStr) then // try another key for the file name
+ begin
+ FileName := Reg.ReadString('InProcServer', '', EmptyStr);
+ end;
+ Result := Filename <> EmptyStr;
+ if not Result then Exit;
+ Result := WideFileExists(Filename);
+ finally
+ Reg.Free;
+ end;
end;
-procedure TTntWideStringList.Delete(Index: Integer);
+{ TBufferedAnsiString }
+
+procedure TBufferedAnsiString.Clear;
begin
- FList.Delete(Index);
+ LastWriteIndex := 0;
+ if Length(FStringBuffer) > 0 then
+ FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(AnsiChar), 0);
end;
-procedure TTntWideStringList.Exchange(Index1, Index2: Integer);
+procedure TBufferedAnsiString.AddChar(const wc: AnsiChar);
+const
+ MIN_GROW_SIZE = 32;
+ MAX_GROW_SIZE = 256;
+var
+ GrowSize: Integer;
begin
- FList.Exchange(Index1, Index2);
+ Inc(LastWriteIndex);
+ if LastWriteIndex > Length(FStringBuffer) then begin
+ GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));
+ GrowSize := Min(GrowSize, MAX_GROW_SIZE);
+ SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);
+ FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(AnsiChar), 0);
+ end;
+ FStringBuffer[LastWriteIndex] := wc;
end;
-function TTntWideStringList.Get(Index: Integer): WideString;
+procedure TBufferedAnsiString.AddString(const s: AnsiString);
+var
+ LenS: Integer;
+ BlockSize: Integer;
+ AllocSize: Integer;
begin
- Result := FList.Strings[Index];
+ LenS := Length(s);
+ if LenS > 0 then begin
+ Inc(LastWriteIndex);
+ if LastWriteIndex + LenS - 1 > Length(FStringBuffer) then begin
+ // determine optimum new allocation size
+ BlockSize := Length(FStringBuffer) div 2;
+ if BlockSize < 8 then
+ BlockSize := 8;
+ AllocSize := ((LenS div BlockSize) + 1) * BlockSize;
+ // realloc buffer
+ SetLength(FStringBuffer, Length(FStringBuffer) + AllocSize);
+ FillChar(FStringBuffer[Length(FStringBuffer) - AllocSize + 1], AllocSize * SizeOf(AnsiChar), 0);
+ end;
+ CopyMemory(@FStringBuffer[LastWriteIndex], @s[1], LenS * SizeOf(AnsiChar));
+ Inc(LastWriteIndex, LenS - 1);
+ end;
end;
-function TTntWideStringList.GetCapacity: Integer;
+procedure TBufferedAnsiString.AddBuffer(Buff: PAnsiChar; Chars: Integer);
+var
+ i: integer;
begin
- Result := FList.Capacity;
+ for i := 1 to Chars do begin
+ if Buff^ = #0 then
+ break;
+ AddChar(Buff^);
+ Inc(Buff);
+ end;
end;
-function TTntWideStringList.GetCount: Integer;
+function TBufferedAnsiString.Value: AnsiString;
begin
- Result := FList.Count;
+ Result := PAnsiChar(FStringBuffer);
end;
-function TTntWideStringList.GetObject(Index: Integer): TObject;
+function TBufferedAnsiString.BuffPtr: PAnsiChar;
begin
- Result := FList.Objects[Index];
+ Result := PAnsiChar(FStringBuffer);
end;
-function TTntWideStringList.IndexOf(const S: WideString): Integer;
+{ TBufferedWideString }
+
+procedure TBufferedWideString.Clear;
begin
- Result := FList.IndexOf(S);
+ LastWriteIndex := 0;
+ if Length(FStringBuffer) > 0 then
+ FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(WideChar), 0);
end;
-procedure TTntWideStringList.Insert(Index: Integer; const S: WideString);
+procedure TBufferedWideString.AddChar(const wc: WideChar);
+const
+ MIN_GROW_SIZE = 32;
+ MAX_GROW_SIZE = 256;
+var
+ GrowSize: Integer;
begin
- FList.Insert(Index, S);
+ Inc(LastWriteIndex);
+ if LastWriteIndex > Length(FStringBuffer) then begin
+ GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));
+ GrowSize := Min(GrowSize, MAX_GROW_SIZE);
+ SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);
+ FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(WideChar), 0);
+ end;
+ FStringBuffer[LastWriteIndex] := wc;
end;
-procedure TTntWideStringList.Put(Index: Integer; const S: WideString);
+procedure TBufferedWideString.AddString(const s: WideString);
+var
+ i: integer;
begin
- FList.Strings[Index] := S;
+ for i := 1 to Length(s) do
+ AddChar(s[i]);
end;
-procedure TTntWideStringList.PutObject(Index: Integer; AObject: TObject);
+procedure TBufferedWideString.AddBuffer(Buff: PWideChar; Chars: Integer);
+var
+ i: integer;
begin
- FList.Objects[Index] := AObject;
+ for i := 1 to Chars do begin
+ if Buff^ = #0 then
+ break;
+ AddChar(Buff^);
+ Inc(Buff);
+ end;
end;
-procedure TTntWideStringList.SetCapacity(NewCapacity: Integer);
+function TBufferedWideString.Value: WideString;
begin
- FList.Capacity := NewCapacity;
+ Result := PWideChar(FStringBuffer);
end;
-procedure TTntWideStringList.SetLanguage(Value: LCID);
+function TBufferedWideString.BuffPtr: PWideChar;
begin
- FList.Language := Value;
+ Result := PWideChar(FStringBuffer);
end;
-procedure TTntWideStringList.SetUpdateState(Updating: Boolean);
+{ TBufferedStreamReader }
+
+constructor TBufferedStreamReader.Create(Stream: TStream; BufferSize: Integer = 1024);
begin
- TTntWideStringListHelper(FList).SetUpdateState(Updating);
+ // init stream
+ FStream := Stream;
+ FStreamSize := Stream.Size;
+ // init buffer
+ FBufferSize := BufferSize;
+ SetLength(FBuffer, BufferSize);
+ FBufferStartPosition := -FBufferSize; { out of any useful range }
+ // init virtual position
+ FVirtualPosition := 0;
end;
-procedure TTntWideStringList.Sort;
+function TBufferedStreamReader.Seek(Offset: Integer; Origin: Word): Longint;
begin
- TTntWideStringListHelper(FList).InheritedSort;
+ case Origin of
+ soFromBeginning: FVirtualPosition := Offset;
+ soFromCurrent: Inc(FVirtualPosition, Offset);
+ soFromEnd: FVirtualPosition := FStreamSize + Offset;
+ end;
+ Result := FVirtualPosition;
end;
-procedure TTntWideStringList.Changed;
+procedure TBufferedStreamReader.UpdateBufferFromPosition(StartPos: Integer);
begin
- TTntWideStringListHelper(FList).InheritedChanged;
+ try
+ FStream.Position := StartPos;
+ FStream.Read(FBuffer[0], FBufferSize);
+ FBufferStartPosition := StartPos;
+ except
+ FBufferStartPosition := -FBufferSize; { out of any useful range }
+ raise;
+ end;
end;
-procedure TTntWideStringList.Changing;
+function TBufferedStreamReader.Read(var Buffer; Count: Integer): Longint;
+var
+ BytesLeft: Integer;
+ FirstBufferRead: Integer;
+ StreamDirectRead: Integer;
+ Buf: PAnsiChar;
begin
- TTntWideStringListHelper(FList).InheritedChanging;
+ if (FVirtualPosition >= 0) and (Count >= 0) then
+ begin
+ Result := FStreamSize - FVirtualPosition;
+ if Result > 0 then
+ begin
+ if Result > Count then
+ Result := Count;
+
+ Buf := @Buffer;
+ BytesLeft := Result;
+
+ // try to read what is left in buffer
+ FirstBufferRead := FBufferStartPosition + FBufferSize - FVirtualPosition;
+ if (FirstBufferRead < 0) or (FirstBufferRead > FBufferSize) then
+ FirstBufferRead := 0;
+ FirstBufferRead := Min(FirstBufferRead, Result);
+ if FirstBufferRead > 0 then begin
+ Move(FBuffer[FVirtualPosition - FBufferStartPosition], Buf[0], FirstBufferRead);
+ Dec(BytesLeft, FirstBufferRead);
+ end;
+
+ if BytesLeft > 0 then begin
+ // The first read in buffer was not enough
+ StreamDirectRead := (BytesLeft div FBufferSize) * FBufferSize;
+ FStream.Position := FVirtualPosition + FirstBufferRead;
+ FStream.Read(Buf[FirstBufferRead], StreamDirectRead);
+ Dec(BytesLeft, StreamDirectRead);
+
+ if BytesLeft > 0 then begin
+ // update buffer, and read what is left
+ UpdateBufferFromPosition(FStream.Position);
+ Move(FBuffer[0], Buf[FirstBufferRead + StreamDirectRead], BytesLeft);
+ end;
+ end;
+
+ Inc(FVirtualPosition, Result);
+ Exit;
+ end;
+ end;
+ Result := 0;
end;
-function TTntWideStringList.Find(const S: WideString; var Index: Integer): Boolean;
+function TBufferedStreamReader.Write(const Buffer; Count: Integer): Longint;
begin
- Result := TTntWideStringListHelper(FList).InheritedFind(S, Index);
+ raise ETntInternalError.Create('Internal Error: class can not write.');
+ Result := 0;
end;
initialization
- Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
- Win32PlatformIsXP := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1))
- or (Win32MajorVersion > 5);
+ {$IFDEF COMPILER_6_UP}
+ RuntimeUTFStreaming := False; { Delphi 6 and higher don't need UTF help at runtime. }
+ {$ELSE}
+ RuntimeUTFStreaming := True { Delphi 5 and less need UTF help at runtime. }
+ {$ENDIF}
end.
Modified: trunk/TntUnicodeControls/TntComCtrls.pas
===================================================================
--- trunk/TntUnicodeControls/TntComCtrls.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntComCtrls.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,19 +1,23 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntComCtrls;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, Controls, {$IFNDEF VER130} ListActns, {$ENDIF} ComCtrls, Messages, Windows,
- CommCtrl, {$IFDEF JCL} JclUnicode, {$ELSE} Unicode, {$ENDIF} Contnrs, TntControls, TntClasses;
+uses
+ Forms, Classes, Controls, {$IFDEF COMPILER_6_UP} ListActns, {$ENDIF} ComCtrls, Messages,
+ Windows, CommCtrl, Contnrs, TntControls, TntClasses, Graphics, TntSysUtils;
type
TTntCustomListView = class;
@@ -50,11 +54,11 @@
TTntListItem = class(TListItem{TNT-ALLOW TListItem})
private
FCaption: WideString;
- FSubItems: TTntWideStrings;
+ FSubItems: TTntStrings;
procedure SetInheritedCaption(const Value: AnsiString);
function GetCaption: WideString;
procedure SetCaption(const Value: WideString);
- procedure SetSubItems(const Value: TTntWideStrings);
+ procedure SetSubItems(const Value: TTntStrings);
function GetListView: TTntCustomListView;
function GetTntOwner: TTntListItems;
public
@@ -64,7 +68,7 @@
property ListView: TTntCustomListView read GetListView;
procedure Assign(Source: TPersistent); override;
property Caption: WideString read GetCaption write SetCaption;
- property SubItems: TTntWideStrings read FSubItems write SetSubItems;
+ property SubItems: TTntStrings read FSubItems write SetSubItems;
end;
{TNT-WARN TListItems}
@@ -76,9 +80,9 @@
function Owner: TTntCustomListView;
property Item[Index: Integer]: TTntListItem read GetItem write SetItem; default;
function Add: TTntListItem;
-{$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
function AddItem(Item: TTntListItem; Index: Integer = -1): TTntListItem;
-{$ENDIF}
+ {$ENDIF}
function Insert(Index: Integer): TTntListItem;
end;
@@ -89,8 +93,24 @@
var Index: Integer) of object;
{TNT-WARN TCustomListView}
- TTntCustomListView = class(TCustomListView{TNT-ALLOW TCustomListView}, IWideCustomListControl)
+ _TntInternalCustomListView = class(TCustomListView{TNT-ALLOW TCustomListView})
private
+ PWideFindString: PWideChar;
+ CurrentDispInfo: PLVDispInfoW;
+ OriginalDispInfoMask: Cardinal;
+ function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; virtual; abstract;
+ function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; virtual; abstract;
+ protected
+ function OwnerDataFind(Find: TItemFind; const FindString: AnsiString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; override;
+ function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
+ end;
+
+ TTntCustomListView = class(_TntInternalCustomListView, IWideCustomListControl)
+ private
FEditHandle: THandle;
FEditInstance: Pointer;
FDefEditProc: Pointer;
@@ -106,16 +126,24 @@
procedure SetListColumns(const Value: TTntListColumns);
function ColumnFromIndex(Index: Integer): TTntListColumn;
function GetColumnFromTag(Tag: Integer): TTntListColumn;
+ function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; override;
+ function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
+ function GetDropTarget: TTntListItem;
+ procedure SetDropTarget(const Value: TTntListItem);
+ function GetItemFocused: TTntListItem;
+ procedure SetItemFocused(const Value: TTntListItem);
+ function GetSelected: TTntListItem;
+ procedure SetSelected(const Value: TTntListItem);
+ function GetTopItem: TTntListItem;
private
FSavedItems: TObjectList;
FTestingForSortProc: Boolean;
- PWideFindString: PWideChar;
FChangingWideItemCount: Integer;
- OriginalDispInfoMask: Cardinal;
- CurrentDispInfo: PLVDispInfoW;
FTempItem: TTntListItem;
- FListItems: TTntListItems;
function AreItemsStored: Boolean;
+ function GetItems: TTntListItems;
procedure SetItems(Value: TTntListItems);
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
function GetItemW(Value: TLVItemW): TTntListItem;
@@ -128,13 +156,16 @@
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure WndProc(var Message: TMessage); override;
- function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
+ function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; reintroduce; virtual;
function CreateListItem: TListItem{TNT-ALLOW TListItem}; override;
- property Items: TTntListItems read FListItems write SetItems stored AreItemsStored;
+ {$IFDEF COMPILER_6_UP}
+ function CreateListItems: TListItems{TNT-ALLOW TListItems}; override;
+ {$ENDIF}
+ property Items: TTntListItems read GetItems write SetItems stored AreItemsStored;
procedure Edit(const Item: TLVItem); override;
- function OwnerDataFind(Find: TItemFind; const FindString: AnsiString;
+ function OwnerDataFind(Find: TItemFind; const FindString: WideString;
const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
- Direction: TSearchDirection; Wrap: Boolean): Integer; override;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; reintroduce; virtual;
property Columns: TTntListColumns read GetListColumns write SetListColumns;
procedure DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect; State: TOwnerDrawState); override;
property OnEdited: TTntLVEditedEvent read FOnEdited write FOnEdited;
@@ -143,14 +174,19 @@
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Column[Index: Integer]: TTntListColumn read ColumnFromIndex;
-{$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
procedure CopySelection(Destination: TCustomListControl); override;
-{$ENDIF}
+ {$ENDIF}
procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
function FindCaption(StartIndex: Integer; Value: WideString; Partial,
Inclusive, Wrap: Boolean): TTntListItem;
function GetSearchString: WideString;
function StringWidth(S: WideString): Integer;
+ public
+ property DropTarget: TTntListItem read GetDropTarget write SetDropTarget;
+ property ItemFocused: TTntListItem read GetItemFocused write SetItemFocused;
+ property Selected: TTntListItem read GetSelected write SetSelected;
+ property TopItem: TTntListItem read GetTopItem;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
@@ -260,10 +296,10 @@
{TNT-WARN TCustomRichEdit}
TTntCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit})
private
- FRichEditStrings: TTntWideStrings;
+ FRichEditStrings: TTntStrings;
FPrintingTextLength: Integer;
procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
- procedure SetRichEditStrings(const Value: TTntWideStrings);
+ procedure SetRichEditStrings(const Value: TTntStrings);
function GetWideSelText: WideString;
function GetText: WideString;
procedure SetWideSelText(const Value: WideString);
@@ -271,6 +307,7 @@
function GetHint: WideString;
function IsHintStored: Boolean;
procedure SetHint(const Value: WideString);
+ procedure SetRTFText(Flags: DWORD; const Value: AnsiString);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
@@ -279,20 +316,28 @@
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
function GetSelText: string{TNT-ALLOW string}; override;
- function CharPosToGet(CharPos: Integer): Integer;
- function CharPosToSet(CharPos: Integer): Integer;
- function GetSelLength: Integer; override;
- function GetSelStart: Integer; override;
- procedure SetSelLength(Value: Integer); override;
- procedure SetSelStart(Value: Integer); override;
+ function CharPosToGet(RawWin32CharPos: Integer): Integer; {$IFDEF COMPILER_6_UP} deprecated; {$ENDIF} // use EmulatedCharPos()
+ function CharPosToSet(EmulatedCharPos: Integer): Integer; {$IFDEF COMPILER_6_UP} deprecated; {$ENDIF} // use RawWin32CharPos()
+ 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 LineBreakStyle: TTntTextLineBreakStyle;
- property Lines: TTntWideStrings read FRichEditStrings write SetRichEditStrings;
+ property Lines: TTntStrings read FRichEditStrings write SetRichEditStrings;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
+ //
+ function EmulatedCharPos(RawWin32CharPos: Integer): Integer;
+ function RawWin32CharPos(EmulatedCharPos: Integer): Integer;
+ //
procedure Print(const Caption: string{TNT-ALLOW string}); override;
property SelText: WideString read GetWideSelText write SetWideSelText;
+ property SelStart: Integer read GetSelStart write SetSelStart;
+ property SelLength: Integer read GetSelLength write SetSelLength;
property Text: WideString read GetText write SetText;
+ function FindText(const SearchStr: WideString; StartPos,
+ Length: Integer; Options: TSearchTypes): Integer;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
@@ -370,10 +415,10 @@
{TNT-WARN TCustomTabControl}
TTntCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl})
private
- FTabs: TTntWideStrings;
+ FTabs: TTntStrings;
FSaveTabIndex: Integer;
- FSaveTabs: TTntWideStrings;
- procedure SetTabs(const Value: TTntWideStrings);
+ FSaveTabs: TTntStrings;
+ procedure SetTabs(const Value: TTntStrings);
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
function GetHint: WideString;
function IsHintStored: Boolean;
@@ -385,7 +430,7 @@
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
- property Tabs: TTntWideStrings read FTabs write SetTabs;
+ property Tabs: TTntStrings read FTabs write SetTabs;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -577,11 +622,14 @@
{TNT-WARN TDateTimePicker}
TTntDateTimePicker = class(TDateTimePicker{TNT-ALLOW TDateTimePicker})
private
+ FHadFirstMouseClick: Boolean;
function IsHintStored: Boolean;
function GetHint: WideString;
procedure SetHint(const Value: WideString);
+ procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
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;
@@ -624,10 +672,398 @@
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
+type
+{TNT-WARN TStatusPanel}
+ TTntStatusPanel = class(TStatusPanel{TNT-ALLOW TStatusPanel})
+ private
+ FText: WideString;
+ function GetText: Widestring;
+ procedure SetText(const Value: Widestring);
+ procedure SetInheritedText(const Value: AnsiString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Text: Widestring read GetText write SetText;
+ end;
+
+{TNT-WARN TStatusPanels}
+ TTntStatusPanels = class(TStatusPanels{TNT-ALLOW TStatusPanels})
+ private
+ function GetItem(Index: Integer): TTntStatusPanel;
+ procedure SetItem(Index: Integer; Value: TTntStatusPanel);
+ public
+ {$IFNDEF COMPILER_6_UP}
+ constructor Create(StatusBar: TStatusBar{TNT-ALLOW TStatusBar});
+ {$ENDIF}
+ function Add: TTntStatusPanel;
+ {$IFDEF COMPILER_6_UP}
+ function AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
+ function Insert(Index: Integer): TTntStatusPanel;
+ {$ENDIF}
+ property Items[Index: Integer]: TTntStatusPanel read GetItem write SetItem; default;
+ end;
+
+{$IFNDEF COMPILER_6_UP} // Delphi 5 compatibility
+ TCustomStatusBar{TNT-ALLOW TCustomStatusBar} = class(TStatusBar{TNT-ALLOW TStatusBar});
+{$ENDIF}
+
+{TNT-WARN TCustomStatusBar}
+ TTntCustomStatusBar = class(TCustomStatusBar{TNT-ALLOW TCustomStatusBar})
+ private
+ FSimpleText: WideString;
+ function GetSimpleText: WideString;
+ procedure SetSimpleText(const Value: WideString);
+ procedure SetInheritedSimpleText(const Value: AnsiString);
+ function SyncLeadingTabs(const WideVal: WideString; const AnsiVal: AnsiString): WideString;
+ function GetHint: WideString;
+ function IsHintStored: Boolean;
+ procedure SetHint(const Value: WideString);
+ procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
+ function GetPanels: TTntStatusPanels;
+ procedure SetPanels(const Value: TTntStatusPanels);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ {$IFDEF COMPILER_6_UP}
+ function CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels}; override;
+ function GetPanelClass: TStatusPanelClass; override;
+ {$ENDIF}
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure WndProc(var Msg: TMessage); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ {$IFNDEF COMPILER_6_UP}
+ procedure FlipChildren(AllLevels: Boolean); override;
+ {$ENDIF}
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ property Panels: TTntStatusPanels read GetPanels write SetPanels;
+ property SimpleText: WideString read GetSimpleText write SetSimpleText;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TStatusBar}
+ TTntStatusBar = class(TTntCustomStatusBar{TNT-ALLOW TStatusBar})
+ private
+ {$IFDEF COMPILER_6_UP}
+ function GetOnDrawPanel: TDrawPanelEvent;
+ procedure SetOnDrawPanel(const Value: TDrawPanelEvent);
+ {$ELSE}
+ function IsFontStored: Boolean;
+ {$ENDIF}
+ published
+ property Action;
+ property AutoHint default False;
+ property Align default alBottom;
+ property Anchors;
+ property BiDiMode;
+ property BorderWidth;
+ property Color default clBtnFace;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font stored IsFontStored;
+ property Constraints;
+ property Panels;
+ property ParentBiDiMode;
+ property ParentColor default False;
+ property ParentFont default False;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property SimplePanel {$IFDEF COMPILER_7_UP} default False {$ENDIF};
+ property SimpleText;
+ property SizeGrip default True;
+ property UseSystemFont default True;
+ property Visible;
+ property OnClick;
+ property OnContextPopup;
+ {$IFDEF COMPILER_6_UP}
+ property OnCreatePanelClass;
+ {$ENDIF}
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnHint;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ {$IFDEF COMPILER_6_UP}
+ // Required for backwards compatibility with the old event signature
+ property OnDrawPanel: TDrawPanelEvent read GetOnDrawPanel write SetOnDrawPanel;
+ {$ELSE}
+ property OnDrawPanel;
+ {$ENDIF}
+ property OnResize;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+type
+ TTntTreeNodes = class;
+ TTntCustomTreeView = class;
+
+{TNT-WARN TTreeNode}
+ TTntTreeNode = class(TTreeNode{TNT-ALLOW TTreeNode})
+ private
+ FText: WideString;
+ procedure SetText(const Value: WideString);
+ procedure SetInheritedText(const Value: AnsiString);
+ function GetText: WideString;
+ function GetItem(Index: Integer): TTntTreeNode;
+ function GetNodeOwner: TTntTreeNodes;
+ function GetParent: TTntTreeNode;
+ function GetTreeView: TTntCustomTreeView;
+ procedure SetItem(Index: Integer; const Value: TTntTreeNode);
+ function IsEqual(Node: TTntTreeNode): Boolean;
+ procedure ReadData(Stream: TStream; Info: PNodeInfo);
+ procedure WriteData(Stream: TStream; Info: PNodeInfo);
+ public
+ procedure Assign(Source: TPersistent); override;
+ function getFirstChild: TTntTreeNode; {GetFirstChild conflicts with C++ macro}
+ function GetLastChild: TTntTreeNode;
+ function GetNext: TTntTreeNode;
+ function GetNextChild(Value: TTntTreeNode): TTntTreeNode;
+ function getNextSibling: TTntTreeNode; {GetNextSibling conflicts with C++ macro}
+ function GetNextVisible: TTntTreeNode;
+ function GetPrev: TTntTreeNode;
+ function GetPrevChild(Value: TTntTreeNode): TTntTreeNode;
+ function getPrevSibling: TTntTreeNode; {GetPrevSibling conflicts with a C++ macro}
+ function GetPrevVisible: TTntTreeNode;
+ property Item[Index: Integer]: TTntTreeNode read GetItem write SetItem; default;
+ property Owner: TTntTreeNodes read GetNodeOwner;
+ property Parent: TTntTreeNode read GetParent;
+ property Text: WideString read GetText write SetText;
+ property TreeView: TTntCustomTreeView read GetTreeView;
+ end;
+
+ TTntTreeNodeClass = class of TTntTreeNode;
+
+{TNT-WARN TTreeNodes}
+ TTntTreeNodes = class(TTreeNodes{TNT-ALLOW TTreeNodes})
+ private
+ function GetNodeFromIndex(Index: Integer): TTntTreeNode;
+ function GetNodesOwner: TTntCustomTreeView;
+ procedure ClearCache;
+ procedure ReadData(Stream: TStream);
+ procedure WriteData(Stream: TStream);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ function Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddChildFirst(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddChildObject(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function InsertObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ {$IFDEF COMPILER_6_UP}
+ function InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddNode(Node, Relative: TTntTreeNode; const S: WideString;
+ Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
+ {$ELSE}
+ function InternalAddObject(Node: TTntTreeNode; const S: WideString;
+ Ptr: Pointer; AddMode: TAddMode): TTntTreeNode;
+ {$ENDIF}
+ public
+ function GetFirstNode: TTntTreeNode;
+ function GetNode(ItemId: HTreeItem): TTntTreeNode;
+ property Item[Index: Integer]: TTntTreeNode read GetNodeFromIndex; default;
+ property Owner: TTntCustomTreeView read GetNodesOwner;
+ end;
+
+ TTntTVEditedEvent = procedure(Sender: TObject; Node: TTntTreeNode; var S: WideString) of object;
+
+{TNT-WARN TCustomTreeView}
+ _TntInternalCustomTreeView = class(TCustomTreeView{TNT-ALLOW TCustomTreeView})
+ {$IFDEF COMPILER_6_UP}
+ private
+ function Wide_FindNextToSelect: TTntTreeNode; virtual; abstract;
+ function Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
+ public
+ function FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode}; override;
+ {$ENDIF}
+ end;
+
+ TTntCustomTreeView = class(_TntInternalCustomTreeView)
+ private
+ FSavedNodeText: TTntStrings;
+ FOnEdited: TTntTVEditedEvent;
+ FTestingForSortProc: Boolean;
+ FEditHandle: THandle;
+ FEditInstance: Pointer;
+ FDefEditProc: Pointer;
+ function GetTreeNodes: TTntTreeNodes;
+ procedure SetTreeNodes(const Value: TTntTreeNodes);
+ procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
+ procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
+ function GetNodeFromItem(const Item: TTVItem): TTntTreeNode;
+ procedure EditWndProcW(var Message: TMessage);
+ {$IFDEF COMPILER_6_UP}
+ function Wide_FindNextToSelect: TTntTreeNode; override;
+ {$ENDIF}
+ function GetDropTarget: TTntTreeNode;
+ function GetSelected: TTntTreeNode;
+ {$IFDEF COMPILER_6_UP}
+ function GetSelection(Index: Integer): TTntTreeNode;
+ {$ENDIF}
+ function GetTopItem: TTntTreeNode;
+ procedure SetDropTarget(const Value: TTntTreeNode);
+ procedure SetSelected(const Value: TTntTreeNode);
+ procedure SetTopItem(const Value: TTntTreeNode);
+ function GetHint: WideString;
+ function IsHintStored: Boolean;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure DestroyWnd; override;
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure WndProc(var Message: TMessage); override;
+ procedure Edit(const Item: TTVItem); override;
+ function CreateNode: TTreeNode{TNT-ALLOW TTreeNode}; override;
+ {$IFDEF COMPILER_6_UP}
+ function CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes}; override;
+ {$ENDIF}
+ property Items: TTntTreeNodes read GetTreeNodes write SetTreeNodes;
+ property OnEdited: TTntTVEditedEvent read FOnEdited write FOnEdited;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure LoadFromFile(const FileName: WideString);
+ procedure LoadFromStream(Stream: TStream);
+ procedure SaveToFile(const FileName: WideString);
+ procedure SaveToStream(Stream: TStream);
+ function GetNodeAt(X, Y: Integer): TTntTreeNode;
+ property DropTarget: TTntTreeNode read GetDropTarget write SetDropTarget;
+ property Selected: TTntTreeNode read GetSelected write SetSelected;
+ property TopItem: TTntTreeNode read GetTopItem write SetTopItem;
+ {$IFDEF COMPILER_6_UP}
+ property Selections[Index: Integer]: TTntTreeNode read GetSelection;
+ function GetSelections(AList: TList): TTntTreeNode;
+ function FindNextToSelect: TTntTreeNode; reintroduce; virtual;
+ {$ENDIF}
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TTreeView}
+ TTntTreeView = class(TTntCustomTreeView)
+ published
+ property Align;
+ property Anchors;
+ property AutoExpand;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind default bkNone;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property BorderWidth;
+ property ChangeDelay;
+ property Color;
+ property Ctl3D;
+ property Constraints;
+ property DragKind;
+ property DragCursor;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property HotTrack;
+ property Images;
+ property Indent;
+ {$IFDEF COMPILER_6_UP}
+ property MultiSelect;
+ property MultiSelectStyle;
+ {$ENDIF}
+ property ParentBiDiMode;
+ property ParentColor default False;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ReadOnly;
+ property RightClickSelect;
+ property RowSelect;
+ property ShowButtons;
+ property ShowHint;
+ property ShowLines;
+ property ShowRoot;
+ property SortType;
+ property StateImages;
+ property TabOrder;
+ property TabStop default True;
+ property ToolTips;
+ property Visible;
+ {$IFDEF COMPILER_6_UP}
+ property OnAddition;
+ {$ENDIF}
+ property OnAdvancedCustomDraw;
+ property OnAdvancedCustomDrawItem;
+ property OnChange;
+ property OnChanging;
+ property OnClick;
+ property OnCollapsed;
+ property OnCollapsing;
+ property OnCompare;
+ property OnContextPopup;
+ {$IFDEF COMPILER_6_UP}
+ property OnCreateNodeClass;
+ {$ENDIF}
+ property OnCustomDraw;
+ property OnCustomDrawItem;
+ property OnDblClick;
+ property OnDeletion;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEdited;
+ property OnEditing;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnExpanding;
+ property OnExpanded;
+ property OnGetImageIndex;
+ property OnGetSelectedIndex;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDock;
+ property OnStartDrag;
+ { Items must be published after OnGetImageIndex and OnGetSelectedIndex }
+ property Items;
+ end;
+
implementation
-uses SysUtils, Forms, TntGraphics, Graphics, ImgList, TntStdCtrls, StdCtrls,
- RichEdit, TntWideStrPropHelper, ActiveIMM_TLB, Printers, TntForms, ComStrs, TntActnList;
+uses
+ SysUtils, TntGraphics, ImgList, TntSystem, TntStdCtrls, StdCtrls,
+ RichEdit, ActiveIMM_TLB, Printers, TntForms, ComStrs,
+ TntActnList, TntStdActns, TntWindows;
procedure CreateUnicodeHandle_ComCtl(Control: TWinControl; const Params: TCreateParams;
const SubClass: WideString);
@@ -652,7 +1088,7 @@
procedure TTntListColumn.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntListColumn.SetInheritedCaption(const Value: AnsiString);
@@ -672,27 +1108,34 @@
{ TTntListColumns }
-{$IFDEF VER130} // Delphi 5
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
type
THackCollection = class(TPersistent)
protected
FItemClass: TCollectionItemClass;
end;
{$ENDIF}
-{$IFDEF VER140} // Delphi 6
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
type
THackCollection = class(TPersistent)
protected
FItemClass: TCollectionItemClass;
end;
{$ENDIF}
-{$IFDEF VER150} // Delphi 7
+{$IFDEF DELPHI_7}
type
THackCollection = class(TPersistent)
protected
FItemClass: TCollectionItemClass;
end;
{$ENDIF}
+{$IFDEF DELPHI_9}
+type
+ THackCollection = class(TPersistent)
+ protected
+ FItemClass: TCollectionItemClass;
+ end;
+{$ENDIF}
constructor TTntListColumns.Create(AOwner: TTntCustomListView);
begin
@@ -723,7 +1166,7 @@
{ TWideSubItems }
type
- TWideSubItems = class(TTntWideStringList)
+ TWideSubItems = class(TTntStringList)
private
FIgnoreInherited: Boolean;
FInheritedOwner: TListItem{TNT-ALLOW TListItem};
@@ -735,7 +1178,6 @@
procedure SetUpdateState(Updating: Boolean); override;
public
procedure Insert(Index: Integer; const S: WideString); override;
- function Add(const S: WideString): Integer; override;
function AddObject(const S: WideString; AObject: TObject): Integer; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
@@ -750,18 +1192,6 @@
FOwner := AOwner;
end;
-function TWideSubItems.Add(const S: WideString): Integer;
-begin
- FOwner.ListView.BeginChangingWideItem;
- try
- Result := inherited Add(S);
- if (not FIgnoreInherited) then
- FInheritedOwner.SubItems.Add(S);
- finally
- FOwner.ListView.EndChangingWideItem;
- end;
-end;
-
function TWideSubItems.AddObject(const S: WideString; AObject: TObject): Integer;
begin
FOwner.ListView.BeginChangingWideItem;
@@ -891,7 +1321,7 @@
else inherited Assign(Source);
end;
-procedure TTntListItem.SetSubItems(const Value: TTntWideStrings);
+procedure TTntListItem.SetSubItems(const Value: TTntStrings);
begin
if Value <> nil then
FSubItems.Assign(Value);
@@ -914,7 +1344,7 @@
Result := (inherited Add) as TTntListItem;
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
function TTntListItems.AddItem(Item: TTntListItem; Index: Integer): TTntListItem;
begin
Result := (inherited AddItem(Item, Index)) as TTntListItem;
@@ -945,7 +1375,7 @@
type
TSavedListItem = class
FCaption: WideString;
- FSubItems: TTntWideStrings;
+ FSubItems: TTntStrings;
constructor Create;
destructor Destroy; override;
end;
@@ -953,7 +1383,7 @@
constructor TSavedListItem.Create;
begin
inherited;
- FSubItems := TTntWideStringList.Create;
+ FSubItems := TTntStringList.Create;
end;
destructor TSavedListItem.Destroy;
@@ -962,9 +1392,36 @@
inherited;
end;
+{ _TntInternalCustomListView }
+
+function _TntInternalCustomListView.OwnerDataFind(Find: TItemFind;
+ const FindString: AnsiString; const FindPosition: TPoint;
+ FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
+ Wrap: Boolean): Integer;
+var
+ WideFindString: WideString;
+begin
+ if Assigned(PWideFindString) then
+ WideFindString := PWideFindString
+ else
+ WideFindString := FindString;
+ Result := OwnerDataFindW(Find, WideFindString, FindPosition, FindData, StartIndex, Direction, Wrap);
+end;
+
+function _TntInternalCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem};
+ Request: TItemRequest): Boolean;
+begin
+ if (CurrentDispInfo <> nil)
+ and (OriginalDispInfoMask and LVIF_TEXT <> 0) then begin
+ (Item as TTntListItem).FCaption := CurrentDispInfo.item.pszText
+ end;
+ (Item as TTntListItem).FSubItems.Clear;
+ Result := OwnerDataFetchW(Item, Request);
+end;
+
{ TTntCustomListView }
-{$IFDEF VER130} // Delphi 5
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
type
THackCustomListView = class(TWinControl)
protected
@@ -980,6 +1437,30 @@
FxxxSortType: TSortType;
FxxxColumnClick: Boolean;
FxxxShowColumnHeaders: Boolean;
+ FListItems: TListItems{TNT-ALLOW TListItems};
+ FxxxClicked: Boolean;
+ FxxxRClicked: Boolean;
+ FxxxIconOptions: TIconOptions;
+ FxxxHideSelection: Boolean;
+ FListColumns: TListColumns{TNT-ALLOW TListColumns};
+ end;
+{$ENDIF}
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+type
+ THackCustomListView = class(TCustomMultiSelectListControl)
+ protected
+ FxxxCanvas: TCanvas;
+ FxxxBorderStyle: TBorderStyle;
+ FxxxViewStyle: TViewStyle;
+ FxxxReadOnly: Boolean;
+ FxxxLargeImages: TCustomImageList;
+ FxxxSmallImages: TCustomImageList;
+ FxxxStateImages: TCustomImageList;
+ FxxxDragImage: TDragImageList;
+ FxxxMultiSelect: Boolean;
+ FxxxSortType: TSortType;
+ FxxxColumnClick: Boolean;
+ FxxxShowColumnHeaders: Boolean;
FxxxListItems: TListItems{TNT-ALLOW TListItems};
FxxxClicked: Boolean;
FxxxRClicked: Boolean;
@@ -988,7 +1469,7 @@
FListColumns: TListColumns{TNT-ALLOW TListColumns};
end;
{$ENDIF}
-{$IFDEF VER140} // Delphi 6
+{$IFDEF DELPHI_7}
type
THackCustomListView = class(TCustomMultiSelectListControl)
protected
@@ -1012,7 +1493,7 @@
FListColumns: TListColumns{TNT-ALLOW TListColumns};
end;
{$ENDIF}
-{$IFDEF VER150} // Delphi 7
+{$IFDEF DELPHI_9}
type
THackCustomListView = class(TCustomMultiSelectListControl)
protected
@@ -1040,11 +1521,27 @@
var
ComCtrls_DefaultListViewSort: TLVCompare = nil;
+{$IFDEF COMPILER_5}
+type
+ THackListItem = class(TPersistent)
+ private
+ FOwner: TListItems{TNT-ALLOW TListItems};
+ end;
+{$ENDIF}
+
constructor TTntCustomListView.Create(AOwner: TComponent);
begin
inherited;
- FListItems := TTntListItems.Create(Self);
- FEditInstance := TntClasses.MakeObjectInstance(EditWndProcW);
+ FEditInstance := MakeObjectInstance(EditWndProcW);
+ {$IFNDEF COMPILER_6_UP}
+ // create list items
+ Assert(THackCustomListView(Self).FListItems = inherited Items, 'Internal Error in TTntCustomListView.Create().');
+ FreeAndNil(THackCustomListView(Self).FListItems);
+ THackCustomListView(Self).FListItems := TTntListItems.Create(Self);
+ Assert(FTempItem <> nil);
+ THackListItem(FTempItem).FOwner := Items;
+ {$ENDIF}
+ // create list columns
Assert(THackCustomListView(Self).FListColumns = inherited Columns, 'Internal Error in TTntCustomListView.Create().');
FreeAndNil(THackCustomListView(Self).FListColumns);
THackCustomListView(Self).FListColumns := TTntListColumns.Create(Self);
@@ -1053,8 +1550,7 @@
destructor TTntCustomListView.Destroy;
begin
inherited;
- FreeAndNil(FListItems);
- TntClasses.FreeObjectInstance(FEditInstance);
+ FreeObjectInstance(FEditInstance);
end;
procedure TTntCustomListView.CreateWindowHandle(const Params: TCreateParams);
@@ -1068,6 +1564,7 @@
FTestingForSortProc := False;
end;
end;
+
var
Column: TLVColumn;
begin
@@ -1085,7 +1582,7 @@
procedure TTntCustomListView.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomListView.CreateWnd;
@@ -1113,6 +1610,41 @@
inherited;
end;
+function TTntCustomListView.GetDropTarget: TTntListItem;
+begin
+ Result := inherited DropTarget as TTntListItem;
+end;
+
+procedure TTntCustomListView.SetDropTarget(const Value: TTntListItem);
+begin
+ inherited DropTarget := Value;
+end;
+
+function TTntCustomListView.GetItemFocused: TTntListItem;
+begin
+ Result := inherited ItemFocused as TTntListItem;
+end;
+
+procedure TTntCustomListView.SetItemFocused(const Value: TTntListItem);
+begin
+ inherited ItemFocused := Value;
+end;
+
+function TTntCustomListView.GetSelected: TTntListItem;
+begin
+ Result := inherited Selected as TTntListItem;
+end;
+
+procedure TTntCustomListView.SetSelected(const Value: TTntListItem);
+begin
+ inherited Selected := Value;
+end;
+
+function TTntCustomListView.GetTopItem: TTntListItem;
+begin
+ Result := inherited TopItem as TTntListItem;
+end;
+
function TTntCustomListView.GetListColumns: TTntListColumns;
begin
Result := inherited Columns as TTntListColumns;
@@ -1120,10 +1652,10 @@
procedure TTntCustomListView.SetListColumns(const Value: TTntListColumns);
begin
- Columns := Value;
+ inherited Columns := Value;
end;
-{$IFDEF VER130} // Delphi 5
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
type
THackListColumn = class(TCollectionItem)
protected
@@ -1138,7 +1670,7 @@
FOrderTag: Integer;
end;
{$ENDIF}
-{$IFDEF VER140} // Delphi 6
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
type
THackListColumn = class(TCollectionItem)
protected
@@ -1153,7 +1685,7 @@
FOrderTag: Integer;
end;
{$ENDIF}
-{$IFDEF VER150} // Delphi 7
+{$IFDEF DELPHI_7}
type
THackListColumn = class(TCollectionItem)
protected
@@ -1168,6 +1700,21 @@
FOrderTag: Integer;
end;
{$ENDIF}
+{$IFDEF DELPHI_9}
+type
+ THackListColumn = class(TCollectionItem)
+ protected
+ FxxxxxxxxAlignment: TAlignment;
+ FxxxxAutoSize: Boolean;
+ FxxxxCaption: AnsiString;
+ FxxxxMaxWidth: TWidth;
+ FxxxxMinWidth: TWidth;
+ FxxxxImageIndex: TImageIndex;
+ FxxxxPrivateWidth: TWidth;
+ FxxxxWidth: TWidth;
+ FOrderTag: Integer;
+ end;
+{$ENDIF}
function TTntCustomListView.GetColumnFromTag(Tag: Integer): TTntListColumn;
var
@@ -1188,9 +1735,7 @@
function TTntCustomListView.AreItemsStored: Boolean;
begin
-{$IFDEF VER130}
- Result := not OwnerData;
-{$ELSE}
+ {$IFDEF COMPILER_6_UP}
if Assigned(Action) then
begin
if Action is TCustomListAction{TNT-ALLOW TCustomListAction} then
@@ -1200,12 +1745,19 @@
end
else
Result := not OwnerData;
-{$ENDIF}
+ {$ELSE}
+ Result := not OwnerData;
+ {$ENDIF}
end;
+function TTntCustomListView.GetItems: TTntListItems;
+begin
+ Result := inherited Items as TTntListItems;
+end;
+
procedure TTntCustomListView.SetItems(Value: TTntListItems);
begin
- FListItems.Assign(Value);
+ inherited Items := Value;
end;
type TTntListItemClass = class of TTntListItem;
@@ -1216,18 +1768,25 @@
TntLClass: TTntListItemClass;
begin
LClass := TTntListItem;
-{$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
if Assigned(OnCreateItemClass) then
OnCreateItemClass(Self, TListItemClass(LClass));
if not LClass.InheritsFrom(TTntListItem) then
- raise Exception.Create('Internal Error: OnCreateItemClass.ItemClass must inherit from TTntListItem.');
-{$ENDIF}
+ raise ETntInternalError.Create('Internal Error: OnCreateItemClass.ItemClass must inherit from TTntListItem.');
+ {$ENDIF}
TntLClass := TTntListItemClass(LClass);
Result := TntLClass.Create(inherited Items);
if FTempItem = nil then
FTempItem := Result as TTntListItem; { In Delphi 5/6, the first item creates is the temp item }
end;
+{$IFDEF COMPILER_6_UP}
+function TTntCustomListView.CreateListItems: TListItems{TNT-ALLOW TListItems};
+begin
+ Result := TTntListItems.Create(Self);
+end;
+{$ENDIF}
+
function TTntCustomListView.GetItemW(Value: TLVItemW): TTntListItem;
begin
with Value do begin
@@ -1242,14 +1801,19 @@
end;
end;
+function TTntCustomListView.OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
+begin
+ Result := OwnerDataFetch(Item, Request);
+end;
+
function TTntCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
begin
- if (CurrentDispInfo <> nil)
- and (OriginalDispInfoMask and LVIF_TEXT <> 0) then begin
- (Item as TTntListItem).FCaption := CurrentDispInfo.item.pszText
- end;
- (Item as TTntListItem).FSubItems.Clear;
- Result := inherited OwnerDataFetch(Item, Request);
+ if Assigned(OnData) then
+ begin
+ OnData(Self, Item);
+ Result := True;
+ end
+ else Result := False;
end;
function TntDefaultListViewSort(Item1, Item2: TTntListItem; lParam: Integer): Integer; stdcall;
@@ -1355,7 +1919,7 @@
Result := SendMessageW(Handle, LVM_SETITEMTEXTW, WParam, LParam)
else if (Win32PlatformIsUnicode)
and (Msg = LVM_SORTITEMS) and (Pointer(lParam) = @ComCtrls_DefaultListViewSort) then
- // Unicode:: call wide version of sort proc instread
+ // Unicode:: call wide version of sort proc instead
Result := SendMessageW(Handle, LVM_SORTITEMS, wParam, Integer(@TntDefaultListViewSort))
else if (Win32PlatformIsUnicode)
and (Msg = LVM_SETCOLUMNA) and ((PLVColumn(lParam).mask and LVCF_TEXT) <> 0)
@@ -1434,7 +1998,8 @@
NMHdr^.code := LVN_GETDISPINFOW;
end;
finally
- PLVDispInfoW(NMHdr)^.item.mask := OriginalDispInfoMask;
+ if (OriginalDispInfoMask and LVIF_TEXT <> 0) then
+ PLVDispInfoW(NMHdr)^.item.mask := PLVDispInfoW(NMHdr)^.item.mask or LVIF_TEXT;
end;
finally
CurrentDispInfo := nil;
@@ -1482,7 +2047,7 @@
if Result = 0 then
begin
FEditHandle := ListView_GetEditControl(Handle);
- FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
+ FDefEditProc := Pointer(GetWindowLongW(FEditHandle, GWL_WNDPROC));
SetWindowLongW(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
end;
end;
@@ -1506,23 +2071,26 @@
end;
end;
-function TTntCustomListView.OwnerDataFind(Find: TItemFind; const FindString: AnsiString;
+function TTntCustomListView.OwnerDataFindW(Find: TItemFind;
+ const FindString: WideString; const FindPosition: TPoint;
+ FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
+ Wrap: Boolean): Integer;
+begin
+ Result := OwnerDataFind(Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap);
+end;
+
+function TTntCustomListView.OwnerDataFind(Find: TItemFind; const FindString: WideString;
const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
Direction: TSearchDirection; Wrap: Boolean): Integer;
var
- WideFindString: WideString;
AnsiEvent: TLVOwnerDataFindEvent;
begin
- if Assigned(PWideFindString) then
- WideFindString := PWideFindString
- else
- WideFindString := FindString;
Result := -1;
if Assigned(OnDataFind) then
- OnDataFind(Self, Find, WideFindString, FindPosition, FindData, StartIndex, Direction, Wrap, Result)
+ OnDataFind(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap, Result)
else if Assigned(inherited OnDataFind) then begin
AnsiEvent := inherited OnDataFind;
- AnsiEvent(Self, Find, WideFindString, FindPosition, FindData, StartIndex, Direction,
+ AnsiEvent(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction,
Wrap, Result);
end;
end;
@@ -1610,7 +2178,7 @@
end;
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure TTntCustomListView.CopySelection(Destination: TCustomListControl);
var
I: Integer;
@@ -1714,28 +2282,21 @@
procedure SetTextStr(const Value: WideString); override;
public
constructor Create;
- procedure AddStrings(Strings: TStrings{TNT-ALLOW TStrings}); overload; override;
- procedure AddStrings(Strings: TWideStrings); overload; override;
+ procedure AddStrings(Strings: TTntStrings); override;
//--
- procedure LoadFromStream(Stream: TStream); override;
-{$IFDEF JCL}
+ procedure LoadFromStream(Stream: TStream; WithBOM: Boolean = True); override;
procedure SaveToStream(Stream: TStream; WithBOM: Boolean = True); override;
-{$ELSE}
- procedure SaveToStream(Stream: TStream); override;
-{$ENDIF}
procedure LoadFromFile(const FileName: WideString); override;
procedure SaveToFile(const FileName: WideString); override;
end;
-{ TTntRichEditStrings }
-
constructor TTntRichEditStrings.Create;
begin
inherited Create;
FRichEditMode := True;
end;
-procedure TTntRichEditStrings.AddStrings(Strings: TStrings{TNT-ALLOW TStrings});
+procedure TTntRichEditStrings.AddStrings(Strings: TTntStrings);
var
SelChange: TNotifyEvent;
begin
@@ -1748,19 +2309,6 @@
end;
end;
-procedure TTntRichEditStrings.AddStrings(Strings: TWideStrings);
-var
- SelChange: TNotifyEvent;
-begin
- SelChange := TTntCustomRichEdit(RichEdit).OnSelectionChange;
- TTntCustomRichEdit(RichEdit).OnSelectionChange := nil;
- try
- inherited;
- finally
- TTntCustomRichEdit(RichEdit).OnSelectionChange := SelChange;
- end;
-end;
-
procedure TTntRichEditStrings.EnableChange(const Value: Boolean);
var
EventMask: Longint;
@@ -1787,28 +2335,36 @@
type TAccessCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit});
-procedure TTntRichEditStrings.LoadFromStream(Stream: TStream);
+procedure TTntRichEditStrings.LoadFromStream(Stream: TStream; WithBOM: Boolean = True);
begin
- TAccessCustomRichEdit(RichEdit).Lines.LoadFromStream(Stream);
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited LoadFromStream(Stream, WithBOM)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.LoadFromStream(Stream);
end;
-{$IFDEF JCL}
procedure TTntRichEditStrings.SaveToStream(Stream: TStream; WithBOM: Boolean = True);
-{$ELSE}
-procedure TTntRichEditStrings.SaveToStream(Stream: TStream);
-{$ENDIF}
begin
- TAccessCustomRichEdit(RichEdit).Lines.SaveToStream(Stream);
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited SaveToStream(Stream, WithBOM)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.SaveToStream(Stream);
end;
procedure TTntRichEditStrings.LoadFromFile(const FileName: WideString);
begin
- TAccessCustomRichEdit(RichEdit).Lines.LoadFromFile(FileName);
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited LoadFromFile(FileName)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.LoadFromFile(FileName);
end;
procedure TTntRichEditStrings.SaveToFile(const FileName: WideString);
begin
- TAccessCustomRichEdit(RichEdit).Lines.SaveToFile(FileName);
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited SaveToFile(FileName)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.SaveToFile(FileName);
end;
{ TTntCustomRichEdit }
@@ -1830,10 +2386,17 @@
RICHED20_DLL = 'RICHED20.DLL';
begin
if FRichEdit20Module = 0 then
- FRichEdit20Module := LoadLibrary(RICHED20_DLL);
+ FRichEdit20Module := Tnt_LoadLibraryW(RICHED20_DLL);
Result := FRichEdit20Module <> 0;
end;
+{function IsRichEdit30Available: Boolean;
+begin
+ Result := False;
+ exit;
+ Result := IsRichEdit20Available and (Win32MajorVersion >= 5);
+end;}
+
procedure TTntCustomRichEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
@@ -1884,7 +2447,7 @@
procedure TTntCustomRichEdit.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
destructor TTntCustomRichEdit.Destroy;
@@ -1901,17 +2464,14 @@
Result := tlbsCRLF;
end;
-procedure TTntCustomRichEdit.SetRichEditStrings(const Value: TTntWideStrings);
+procedure TTntCustomRichEdit.SetRichEditStrings(const Value: TTntStrings);
begin
FRichEditStrings.Assign(Value);
end;
function TTntCustomRichEdit.GetSelText: string{TNT-ALLOW string};
begin
- if (not IsWindowUnicode(Handle)) then begin
- Result := TntAdjustLineBreaks(inherited SelText, tlbsCRLF)
- end else
- Result := GetWideSelText;
+ Result := GetWideSelText;
end;
function TTntCustomRichEdit.GetWideSelText: WideString;
@@ -1920,7 +2480,7 @@
Length: Integer;
begin
if (not IsWindowUnicode(Handle)) then
- Result := inherited SelText
+ Result := inherited GetSelText
else begin
SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
SetLength(Result, CharRange.cpMax - CharRange.cpMin + 1);
@@ -1931,23 +2491,49 @@
Result := TntAdjustLineBreaks(Result, tlbsCRLF)
end;
+type
+ TSetTextEx = record
+ flags:dword;
+ codepage:uint;
+ end;
+
+procedure TTntCustomRichEdit.SetRTFText(Flags: DWORD; const Value: AnsiString);
+const
+ EM_SETTEXTEX = (WM_USER + 97);
+var
+ Info: TSetTextEx;
+begin
+ Info.flags := Flags;
+ Info.codepage := CP_ACP{TNT-ALLOW CP_ACP};
+ SendMessage(Handle, EM_SETTEXTEX, Integer(@Info), Integer(PAnsiChar(Value)));
+end;
+
procedure TTntCustomRichEdit.SetWideSelText(const Value: WideString);
+const
+ ST_SELECTION = 2;
begin
- TntCustomEdit_SetSelText(Self, TntAdjustLineBreaks(Value, LineBreakStyle));
+ if Win32PlatformIsUnicode and IsRichEdit20Available and IsRTF(Value) then begin
+ // emulate RichEdit 1.0 so that RTF code is inserted as RTF (not plain text)
+ SetRTFText(ST_SELECTION, Value)
+ end else
+ TntCustomEdit_SetSelText(Self, TntAdjustLineBreaks(Value, LineBreakStyle));
end;
function TTntCustomRichEdit.GetText: WideString;
begin
Result := TntControl_GetText(Self);
- if IsWindowUnicode(WindowHandle) and (LineBreakStyle <> tlbsCRLF) then
+ if (LineBreakStyle <> tlbsCRLF) then
Result := TntAdjustLineBreaks(Result, tlbsCRLF);
end;
procedure TTntCustomRichEdit.SetText(const Value: WideString);
+const
+ ST_DEFAULT = 0;
begin
- if (not IsWindowUnicode(WindowHandle)) then
- TntControl_SetText(Self, Value)
- else
+ if Win32PlatformIsUnicode and IsRichEdit20Available and IsRTF(Value) then begin
+ // emulate RichEdit 1.0 so that RTF code is inserted as RTF (not plain text)
+ SetRTFText(ST_DEFAULT, Value)
+ end else if Value <> Text then
TntControl_SetText(Self, TntAdjustLineBreaks(Value, LineBreakStyle));
end;
@@ -1987,102 +2573,144 @@
end;
end;
-function TTntCustomRichEdit.CharPosToGet(CharPos: Integer): Integer;
+{$IFDEF COMPILER_6_UP}
+{$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+function TTntCustomRichEdit.CharPosToGet(RawWin32CharPos: Integer): Integer;
+begin
+ Result := EmulatedCharPos(RawWin32CharPos);
+end;
+
+function TTntCustomRichEdit.CharPosToSet(EmulatedCharPos: Integer): Integer;
+begin
+ Result := RawWin32CharPos(EmulatedCharPos);
+end;
+{$IFDEF COMPILER_6_UP}
+{$WARN SYMBOL_DEPRECATED ON}
+{$ENDIF}
+
+function TTntCustomRichEdit.EmulatedCharPos(RawWin32CharPos: Integer): Integer;
var
i: Integer;
ThisLine: Integer;
CharCount: Integer;
- LineStart: Integer;
+ Line_Start: Integer;
NumLineBreaks: Integer;
begin
- if (LineBreakStyle = tlbsCRLF) or (CharPos <= 0) then
- Result := CharPos
+ if (LineBreakStyle = tlbsCRLF) or (RawWin32CharPos <= 0) then
+ Result := RawWin32CharPos
else begin
Assert(Win32PlatformIsUnicode);
- ThisLine := SendMessageW(Handle, EM_EXLINEFROMCHAR, 0, CharPos);
- CharCount := 0;
- for i := 0 to ThisLine - 1 do
- Inc(CharCount, TntMemo_LineLength(Handle, i));
- LineStart := TntMemo_LineStart(Handle, ThisLine);
- NumLineBreaks := LineStart - CharCount;
- Result := CharPos + NumLineBreaks; {inflate CR -> CR/LF}
+ ThisLine := SendMessageW(Handle, EM_EXLINEFROMCHAR, 0, RawWin32CharPos);
+ if (not WordWrap) then
+ NumLineBreaks := ThisLine
+ else begin
+ CharCount := 0;
+ for i := 0 to ThisLine - 1 do
+ Inc(CharCount, TntMemo_LineLength(Handle, i));
+ Line_Start := TntMemo_LineStart(Handle, ThisLine);
+ NumLineBreaks := Line_Start - CharCount;
+ end;
+ Result := RawWin32CharPos + NumLineBreaks; {inflate CR -> CR/LF}
end;
end;
-function TTntCustomRichEdit.CharPosToSet(CharPos: Integer): Integer;
+function TTntCustomRichEdit.RawWin32CharPos(EmulatedCharPos: Integer): Integer;
var
Line: Integer;
NumLineBreaks: Integer;
CharCount: Integer;
- LineStart: Integer;
+ Line_Start: Integer;
LineLength: Integer;
begin
- if (LineBreakStyle = tlbsCRLF) or (CharPos <= 0) then
- Result := CharPos
+ if (LineBreakStyle = tlbsCRLF) or (EmulatedCharPos <= 0) then
+ Result := EmulatedCharPos
else begin
Assert(Win32PlatformIsUnicode);
NumLineBreaks := 0;
CharCount := 0;
- for Line := 0 to Lines.Count - 1 do begin
- LineStart := TntMemo_LineStart(Handle, Line);
- if CharPos < (LineStart + NumLineBreaks) then
+ for Line := 0 to Lines.Count do begin
+ Line_Start := TntMemo_LineStart(Handle, Line);
+ if EmulatedCharPos < (Line_Start + NumLineBreaks) then
break; {found it (it must have been the line separator)}
- if LineStart > CharCount then begin
+ if Line_Start > CharCount then begin
Inc(NumLineBreaks);
Inc(CharCount);
end;
- LineLength := TntMemo_LineLength(Handle, Line);
+ LineLength := TntMemo_LineLength(Handle, Line, Line_Start);
Inc(CharCount, LineLength);
- if (CharPos >= (LineStart + NumLineBreaks))
- and (CharPos < (LineStart + LineLength + NumLineBreaks)) then
+ if (EmulatedCharPos >= (Line_Start + NumLineBreaks))
+ and (EmulatedCharPos < (Line_Start + LineLength + NumLineBreaks)) then
break; {found it}
end;
- Result := CharPos - NumLineBreaks; {deflate CR/LF -> CR}
+ Result := EmulatedCharPos - NumLineBreaks; {deflate CR/LF -> CR}
end;
end;
-function TTntCustomRichEdit.GetSelLength: Integer;
+function TTntCustomRichEdit.FindText(const SearchStr: WideString;
+ StartPos, Length: Integer; Options: TSearchTypes): Integer;
+const
+ EM_FINDTEXTEXW = WM_USER + 124;
+const
+ FR_DOWN = $00000001;
+ FR_WHOLEWORD = $00000002;
+ FR_MATCHCASE = $00000004;
var
- CharRange: TCharRange;
+ Find: TFindTextW;
+ Flags: Integer;
begin
- if (not IsWindowUnicode(Handle))
- or (LineBreakStyle = tlbsCRLF) then
- Result := inherited GetSelLength
+ if (not Win32PlatformIsUnicode) then
+ Result := inherited FindText(SearchStr, StartPos, Length, Options)
else begin
- SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
- Result := CharPosToGet(CharRange.cpMax) - CharPosToGet(CharRange.cpMin);
+ with Find.chrg do
+ begin
+ cpMin := RawWin32CharPos(StartPos);
+ cpMax := RawWin32CharPos(StartPos + Length);
+ end;
+ Flags := FR_DOWN; { RichEdit 2.0 and later needs this }
+ if stWholeWord in Options then Flags := Flags or FR_WHOLEWORD;
+ if stMatchCase in Options then Flags := Flags or FR_MATCHCASE;
+ Find.lpstrText := PWideChar(SearchStr);
+ Result := SendMessageW(Handle, EM_FINDTEXT, Flags, LongInt(@Find));
+ Result := EmulatedCharPos(Result);
end;
end;
function TTntCustomRichEdit.GetSelStart: Integer;
begin
- Result := inherited GetSelStart;
- if IsWindowUnicode(Handle)
- and (LineBreakStyle <> tlbsCRLF) then
- Result := CharPosToGet(Result);
+ Result := TntCustomEdit_GetSelStart(Self);
+ Result := EmulatedCharPos(Result);
end;
-procedure TTntCustomRichEdit.SetSelStart(Value: Integer);
+procedure TTntCustomRichEdit.SetSelStart(const Value: Integer);
begin
- if (not IsWindowUnicode(Handle))
- or (LineBreakStyle = tlbsCRLF) then
- inherited SetSelStart(Value)
- else
- inherited SetSelStart(CharPosToSet(Value));
+ TntCustomEdit_SetSelStart(Self, RawWin32CharPos(Value));
end;
-procedure TTntCustomRichEdit.SetSelLength(Value: Integer);
+function TTntCustomRichEdit.GetSelLength: Integer;
var
- SelStart: Integer;
+ CharRange: TCharRange;
+begin
+ if (LineBreakStyle = tlbsCRLF) then
+ Result := TntCustomEdit_GetSelLength(Self)
+ else begin
+ Assert(Win32PlatformIsUnicode);
+ SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
+ Result := EmulatedCharPos(CharRange.cpMax) - EmulatedCharPos(CharRange.cpMin);
+ end;
+end;
+
+procedure TTntCustomRichEdit.SetSelLength(const Value: Integer);
+var
+ StartPos: Integer;
SelEnd: Integer;
begin
- if (not IsWindowUnicode(Handle))
- or (LineBreakStyle = tlbsCRLF) then
- inherited SetSelLength(Value)
+ if (LineBreakStyle = tlbsCRLF) then
+ TntCustomEdit_SetSelLength(Self, Value)
else begin
- SelStart := Self.SelStart;
- SelEnd := SelStart + Value;
- inherited SetSelLength(CharPosToSet(SelEnd) - CharPosToSet(SelStart));
+ StartPos := Self.SelStart;
+ SelEnd := StartPos + Value;
+ inherited SetSelLength(RawWin32CharPos(SelEnd) - RawWin32CharPos(StartPos));
end;
end;
@@ -2102,7 +2730,7 @@
type TAccessCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl});
type
- TTntTabStrings = class(TTntWideStrings)
+ TTntTabStrings = class(TTntStrings)
private
FTabControl: TCustomTabControl{TNT-ALLOW TCustomTabControl};
FAnsiTabs: TStrings{TNT-ALLOW TStrings};
@@ -2244,7 +2872,7 @@
procedure TTntCustomTabControl.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomTabControl.CreateWnd;
@@ -2262,14 +2890,14 @@
begin
if (FTabs <> nil) and (FTabs.Count > 0) then
begin
- FSaveTabs := TTntWideStringList.Create;
+ FSaveTabs := TTntStringList.Create;
FSaveTabs.Assign(FTabs);
FSaveTabIndex := TabIndex;
end;
inherited;
end;
-procedure TTntCustomTabControl.SetTabs(const Value: TTntWideStrings);
+procedure TTntCustomTabControl.SetTabs(const Value: TTntStrings);
begin
FTabs.Assign(Value);
end;
@@ -2343,7 +2971,7 @@
procedure TTntTabSheet.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntTabSheet.IsHintStored: Boolean;
@@ -2400,7 +3028,7 @@
procedure TTntPageControl.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntPageControl.IsHintStored: Boolean;
@@ -2500,10 +3128,8 @@
try
try
DockCtl := Message.DockSource.Control;
- if DockCtl is TTntForm{TNT-ALLOW TTntForm} then
- FNewDockSheet.Caption := TTntForm{TNT-ALLOW TTntForm}(DockCtl).Caption
- else if DockCtl is TCustomForm then
- FNewDockSheet.Caption := TCustomForm(DockCtl).Caption;
+ if DockCtl is TCustomForm then
+ FNewDockSheet.Caption := TntControl_GetText(DockCtl);
FNewDockSheet.PageControl := Self;
DockCtl.Dock(Self, Message.DockSource.DockRect);
except
@@ -2574,7 +3200,7 @@
procedure TTntTrackBar.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntTrackBar.IsHintStored: Boolean;
@@ -2613,7 +3239,7 @@
procedure TTntProgressBar.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntProgressBar.IsHintStored: Boolean;
@@ -2652,7 +3278,7 @@
procedure TTntCustomUpDown.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomUpDown.IsHintStored: Boolean;
@@ -2691,7 +3317,7 @@
procedure TTntDateTimePicker.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntDateTimePicker.IsHintStored: Boolean;
@@ -2720,6 +3346,44 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
+procedure TTntDateTimePicker.CreateWnd;
+var
+ SaveChecked: Boolean;
+begin
+ FHadFirstMouseClick := False;
+ SaveChecked := Checked;
+ inherited;
+ // This fixes an issue where TDateTimePicker.CNNotify causes "FChecked := True" to occur
+ // during window creation. This issue results in .Checked to read True even though
+ // it is not visually checked.
+ Checked := SaveChecked;
+end;
+
+procedure TTntDateTimePicker.WMLButtonDown(var Message: TWMLButtonDown);
+
+ procedure UpdateValues;
+ var
+ Hdr: TNMDateTimeChange;
+ begin
+ Hdr.nmhdr.hwndFrom := Handle;
+ Hdr.nmhdr.idFrom := 0;
+ Hdr.nmhdr.code := DTN_DATETIMECHANGE;
+ Hdr.dwFlags := DateTime_GetSystemTime(Handle, Hdr.st);
+ if (Hdr.dwFlags <> Cardinal(GDT_ERROR)) then begin
+ if Hdr.dwFlags = GDT_NONE then
+ ZeroMemory(@Hdr.st, SizeOf(Hdr.st));
+ Perform(CN_NOTIFY, Handle, Integer(@Hdr));
+ end;
+ end;
+
+begin
+ inherited;
+ if ShowCheckBox and (not FHadFirstMouseClick) then begin
+ FHadFirstMouseClick := True;
+ UpdateValues; // Sometimes the first mouse click doesn't result in WM_NOTIFY.
+ end;
+end;
+
{ TTntMonthCalendar }
procedure TTntMonthCalendar.CreateWindowHandle(const Params: TCreateParams);
@@ -2753,7 +3417,7 @@
procedure TTntMonthCalendar.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntMonthCalendar.IsHintStored: Boolean;
@@ -2802,7 +3466,7 @@
procedure TTntPageScroller.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntPageScroller.IsHintStored: Boolean;
@@ -2831,10 +3495,1412 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
+{ TTntStatusPanel }
+
+procedure TTntStatusPanel.Assign(Source: TPersistent);
+begin
+ inherited;
+ if Source is TTntStatusPanel then
+ Text := TTntStatusPanel(Source).Text;
+end;
+
+procedure TTntStatusPanel.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntStatusPanel.GetText: Widestring;
+begin
+ Result := GetSyncedWideString(FText, inherited Text);
+end;
+
+procedure TTntStatusPanel.SetInheritedText(const Value: AnsiString);
+begin
+ inherited Text := Value;
+end;
+
+procedure TTntStatusPanel.SetText(const Value: Widestring);
+begin
+ SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
+end;
+
+{ TTntStatusPanels }
+
+{$IFNDEF COMPILER_6_UP}
+constructor TTntStatusPanels.Create(StatusBar: TStatusBar{TNT-ALLOW TStatusBar});
+begin
+ inherited;
+ Assert(THackCollection(Self).FItemClass = ItemClass, 'Internal Error in TTntStatusPanels.Create().');
+ THackCollection(Self).FItemClass := TTntStatusPanel;
+end;
+{$ENDIF}
+
+function TTntStatusPanels.GetItem(Index: Integer): TTntStatusPanel;
+begin
+ Result := (inherited GetItem(Index)) as TTntStatusPanel;
+end;
+
+procedure TTntStatusPanels.SetItem(Index: Integer; Value: TTntStatusPanel);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+function TTntStatusPanels.Add: TTntStatusPanel;
+begin
+ Result := (inherited Add) as TTntStatusPanel;
+end;
+
+{$IFDEF COMPILER_6_UP}
+function TTntStatusPanels.AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
+begin
+ Result := (inherited AddItem(Item, Index)) as TTntStatusPanel;
+end;
+
+function TTntStatusPanels.Insert(Index: Integer): TTntStatusPanel;
+begin
+ Result := (inherited Insert(Index)) as TTntStatusPanel;
+end;
+{$ENDIF}
+
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
+type
+ THackStatusBar = class(TWinControl)
+ private
+ FPanels: TStatusPanels{TNT-ALLOW TStatusPanels};
+ end;
+{$ENDIF}
+
+{ TTntCustomStatusBar }
+
+constructor TTntCustomStatusBar.Create(AOwner: TComponent);
+begin
+ inherited;
+ {$IFNDEF COMPILER_6_UP}
+ THackStatusBar(Self).FPanels.Free;
+ THackStatusBar(Self).FPanels := TTntStatusPanels.Create(Self);
+ {$ENDIF}
+end;
+
+function TTntCustomStatusBar.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntCustomStatusBar.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+function TTntCustomStatusBar.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+{$IFDEF COMPILER_6_UP}
+function TTntCustomStatusBar.CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels};
+begin
+ Result := TTntStatusPanels.Create(Self);
+end;
+
+function TTntCustomStatusBar.GetPanelClass: TStatusPanelClass;
+begin
+ Result := TTntStatusPanel;
+end;
+{$ENDIF}
+
+function TTntCustomStatusBar.SyncLeadingTabs(const WideVal: WideString; const AnsiVal: AnsiString): WideString;
+
+ function CountLeadingTabs(const Val: WideString): Integer;
+ var
+ i: integer;
+ begin
+ Result := 0;
+ for i := 1 to Length(Val) do begin
+ if Val[i] <> #9 then break;
+ Inc(Result);
+ end;
+ end;
+
+var
+ AnsiTabCount: Integer;
+ WideTabCount: Integer;
+begin
+ AnsiTabCount := CountLeadingTabs(AnsiVal);
+ WideTabCount := CountLeadingTabs(WideVal);
+ Result := WideVal;
+ while WideTabCount < AnsiTabCount do begin
+ Insert(#9, Result, 1);
+ Inc(WideTabCount);
+ end;
+ while WideTabCount > AnsiTabCount do begin
+ Delete(Result, 1, 1);
+ Dec(WideTabCount);
+ end;
+end;
+
+function TTntCustomStatusBar.GetSimpleText: WideString;
+begin
+ FSimpleText := SyncLeadingTabs(FSimpleText, inherited SimpleText);
+ Result := GetSyncedWideString(FSimpleText, inherited SimpleText);
+end;
+
+procedure TTntCustomStatusBar.SetInheritedSimpleText(const Value: AnsiString);
+begin
+ inherited SimpleText := Value;
+end;
+
+procedure TTntCustomStatusBar.SetSimpleText(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FSimpleText, inherited SimpleText, SetInheritedSimpleText);
+end;
+
+procedure TTntCustomStatusBar.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+procedure TTntCustomStatusBar.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, STATUSCLASSNAME);
+end;
+
+procedure TTntCustomStatusBar.WndProc(var Msg: TMessage);
+const
+ SB_SIMPLEID = Integer($FF);
+var
+ iPart: Integer;
+ szText: PAnsiChar;
+ WideText: WideString;
+begin
+ if Win32PlatformIsUnicode and (Msg.Msg = SB_SETTEXTA) and ((Msg.WParam and SBT_OWNERDRAW) = 0)
+ then begin
+ // convert SB_SETTEXTA message to Unicode
+ iPart := (Msg.WParam and SB_SIMPLEID);
+ szText := PAnsiChar(Msg.LParam);
+ if iPart = SB_SIMPLEID then
+ WideText := SimpleText
+ else if Panels.Count > 0 then
+ WideText := Panels[iPart].Text
+ else begin
+ WideText := szText;
+ end;
+ WideText := SyncLeadingTabs(WideText, szText);
+ Msg.Result := SendMessageW(Handle, SB_SETTEXTW, Msg.wParam, Integer(PWideChar(WideText)));
+ end else
+ inherited;
+end;
+
+procedure TTntCustomStatusBar.WMGetTextLength(var Message: TWMGetTextLength);
+begin
+ Message.Result := Length(SimpleText);
+end;
+
+procedure TTntCustomStatusBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomStatusBar.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntCustomStatusBar.GetPanels: TTntStatusPanels;
+begin
+ Result := inherited Panels as TTntStatusPanels;
+end;
+
+procedure TTntCustomStatusBar.SetPanels(const Value: TTntStatusPanels);
+begin
+ inherited Panels := Value;
+end;
+
+function TTntCustomStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ if AutoHint and (Action is TTntHintAction) and not DoHint then
+ begin
+ if SimplePanel or (Panels.Count = 0) then
+ SimpleText := TTntHintAction(Action).Hint else
+ Panels[0].Text := TTntHintAction(Action).Hint;
+ Result := True;
+ end
+ else Result := inherited ExecuteAction(Action);
+end;
+
+{$IFNDEF COMPILER_6_UP}
+procedure TTntCustomStatusBar.FlipChildren(AllLevels: Boolean);
+var
+ Loop, FirstWidth, LastWidth: Integer;
+ APanels: TTntStatusPanels;
+begin
+ if HandleAllocated and
+ (not SimplePanel) and (Panels.Count > 0) then
+ begin
+ { Get the true width of the last panel }
+ LastWidth := ClientWidth;
+ FirstWidth := Panels[0].Width;
+ for Loop := 0 to Panels.Count - 2 do Dec(LastWidth, Panels[Loop].Width);
+ { Flip 'em }
+ APanels := TTntStatusPanels.Create(Self);
+ try
+ for Loop := 0 to Panels.Count - 1 do with APanels.Add do
+ Assign(Self.Panels[Loop]);
+ for Loop := 0 to Panels.Count - 1 do
+ Panels[Loop].Assign(APanels[Panels.Count - Loop - 1]);
+ finally
+ APanels.Free;
+ end;
+ { Set the width of the last panel }
+ if Panels.Count > 1 then
+ begin
+ Panels[Panels.Count-1].Width := FirstWidth;
+ Panels[0].Width := LastWidth;
+ end;
+ Perform(CM_BIDIMODECHANGED, 0, 0); // calls UpdatePanels(True, True)
+ end;
+end;
+{$ENDIF}
+
+{ TTntStatusBar }
+
+{$IFDEF COMPILER_6_UP}
+function TTntStatusBar.GetOnDrawPanel: TDrawPanelEvent;
+begin
+ Result := TDrawPanelEvent(inherited OnDrawPanel);
+end;
+
+procedure TTntStatusBar.SetOnDrawPanel(const Value: TDrawPanelEvent);
+begin
+ inherited OnDrawPanel := TCustomDrawPanelEvent(Value);
+end;
+{$ELSE}
+function TTntStatusBar.IsFontStored: Boolean; // Delphi 5 compatibility
+begin
+ Result := not UseSystemFont and not ParentFont and not DesktopFont;
+end;
+{$ENDIF}
+
+{ TTntTreeNode }
+
+function TTntTreeNode.IsEqual(Node: TTntTreeNode): Boolean;
+begin
+ Result := (Text = Node.Text) and (Data = Node.Data);
+end;
+
+procedure TTntTreeNode.ReadData(Stream: TStream; Info: PNodeInfo);
+var
+ I, Size, ItemCount: Integer;
+ LNode: TTntTreeNode;
+ Utf8Text: AnsiString;
+begin
+ Owner.ClearCache;
+ Stream.ReadBuffer(Size, SizeOf(Size));
+ Stream.ReadBuffer(Info^, Size);
+
+ if Pos(UTF8_BOM, Info^.Text) = 1 then begin
+ Utf8Text := Copy(Info^.Text, Length(UTF8_BOM) + 1, MaxInt);
+ try
+ Text := UTF8ToWideString(Utf8Text);
+ except
+ Text := Utf8Text;
+ end;
+ end else
+ Text := Info^.Text;
+
+ ImageIndex := Info^.ImageIndex;
+ SelectedIndex := Info^.SelectedIndex;
+ StateIndex := Info^.StateIndex;
+ OverlayIndex := Info^.OverlayIndex;
+ Data := Info^.Data;
+ ItemCount := Info^.Count;
+ for I := 0 to ItemCount - 1 do
+ begin
+ LNode := Owner.AddChild(Self, '');
+ LNode.ReadData(Stream, Info);
+ {$IFDEF COMPILER_6_UP}
+ Owner.Owner.Added(LNode);
+ {$ENDIF}
+ end;
+end;
+
+procedure TTntTreeNode.WriteData(Stream: TStream; Info: PNodeInfo);
+var
+ I, Size, L, ItemCount: Integer;
+ WideLen: Integer; Utf8Text: AnsiString;
+begin
+ WideLen := 255;
+ repeat
+ Utf8Text := UTF8_BOM + WideStringToUTF8(Copy(Text, 1, WideLen));
+ L := Length(Utf8Text);
+ Dec(WideLen);
+ until
+ L <= 255;
+
+ Size := SizeOf(TNodeInfo) + L - 255;
+ Info^.Text := Utf8Text;
+ Info^.ImageIndex := ImageIndex;
+ Info^.SelectedIndex := SelectedIndex;
+ Info^.OverlayIndex := OverlayIndex;
+ Info^.StateIndex := StateIndex;
+ Info^.Data := Data;
+ ItemCount := Count;
+ Info^.Count := ItemCount;
+ Stream.WriteBuffer(Size, SizeOf(Size));
+ Stream.WriteBuffer(Info^, Size);
+ for I := 0 to ItemCount - 1 do
+ Item[I].WriteData(Stream, Info);
+end;
+
+procedure TTntTreeNode.Assign(Source: TPersistent);
+var
+ Node: TTntTreeNode;
+begin
+ inherited;
+ if (not Deleting) and (Source is TTntTreeNode) then
+ begin
+ Node := TTntTreeNode(Source);
+ Text := Node.Text;
+ end;
+end;
+
+function TTntTreeNode.GetText: WideString;
+begin
+ Result := GetSyncedWideString(FText, inherited Text);
+end;
+
+procedure TTntTreeNode.SetInheritedText(const Value: AnsiString);
+begin
+ inherited Text := Value;
+end;
+
+procedure TTntTreeNode.SetText(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
+end;
+
+function TTntTreeNode.getFirstChild: TTntTreeNode;
+begin
+ Result := inherited getFirstChild as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetItem(Index: Integer): TTntTreeNode;
+begin
+ Result := inherited Item[Index] as TTntTreeNode;
+end;
+
+procedure TTntTreeNode.SetItem(Index: Integer; const Value: TTntTreeNode);
+begin
+ inherited Item[Index] := Value;
+end;
+
+function TTntTreeNode.GetLastChild: TTntTreeNode;
+begin
+ Result := inherited GetLastChild as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNext: TTntTreeNode;
+begin
+ Result := inherited GetNext as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNextChild(Value: TTntTreeNode): TTntTreeNode;
+begin
+ Result := inherited GetNextChild(Value) as TTntTreeNode;
+end;
+
+function TTntTreeNode.getNextSibling: TTntTreeNode;
+begin
+ Result := inherited getNextSibling as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNextVisible: TTntTreeNode;
+begin
+ Result := inherited GetNextVisible as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNodeOwner: TTntTreeNodes;
+begin
+ Result := inherited Owner as TTntTreeNodes;
+end;
+
+function TTntTreeNode.GetParent: TTntTreeNode;
+begin
+ Result := inherited Parent as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetPrev: TTntTreeNode;
+begin
+ Result := inherited GetPrev as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetPrevChild(Value: TTntTreeNode): TTntTreeNode;
+begin
+ Result := inherited GetPrevChild(Value) as TTntTreeNode;
+end;
+
+function TTntTreeNode.getPrevSibling: TTntTreeNode;
+begin
+ Result := inherited getPrevSibling as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetPrevVisible: TTntTreeNode;
+begin
+ Result := inherited GetPrevVisible as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetTreeView: TTntCustomTreeView;
+begin
+ Result := inherited TreeView as TTntCustomTreeView;
+end;
+
+{ TTntTreeNodes }
+
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ end;
+{$ENDIF}
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ FReading: Boolean;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_7}
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ FReading: Boolean;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_9}
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ FReading: Boolean;
+ end;
+{$ENDIF}
+
+procedure SaveNodeTextToStrings(Nodes: TTntTreeNodes; sList: TTntStrings);
+var
+ ANode: TTntTreeNode;
+begin
+ sList.Clear;
+ if Nodes.Count > 0 then
+ begin
+ ANode := Nodes[0];
+ while ANode <> nil do
+ begin
+ sList.Add(ANode.Text);
+ ANode := ANode.GetNext;
+ end;
+ end;
+end;
+
+procedure TTntTreeNodes.Assign(Source: TPersistent);
+var
+ TreeNodes: TTntTreeNodes;
+ MemStream: TTntMemoryStream;
+begin
+ ClearCache;
+ if Source is TTntTreeNodes then
+ begin
+ TreeNodes := TTntTreeNodes(Source);
+ Clear;
+ MemStream := TTntMemoryStream.Create;
+ try
+ TreeNodes.WriteData(MemStream);
+ MemStream.Position := 0;
+ ReadData(MemStream);
+ finally
+ MemStream.Free;
+ end;
+ end else
+ inherited Assign(Source);
+end;
+
+function TTntTreeNodes.GetNodeFromIndex(Index: Integer): TTntTreeNode;
+begin
+ Result := inherited Item[Index] as TTntTreeNode;
+end;
+
+function TTntTreeNodes.AddChildFirst(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Parent, S, nil, naAddChildFirst);
+ {$ELSE}
+ Result := AddChildObjectFirst(Parent, S, nil);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Parent, S, Ptr, naAddChildFirst);
+ {$ELSE}
+ Result := InternalAddObject(Parent, S, Ptr, taAddFirst);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Parent, S, nil, naAddChild);
+ {$ELSE}
+ Result := AddChildObject(Parent, S, nil);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.AddChildObject(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Parent, S, Ptr, naAddChild);
+ {$ELSE}
+ Result := InternalAddObject(Parent, S, Ptr, taAdd);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Sibling, S, nil, naAddFirst);
+ {$ELSE}
+ Result := AddObjectFirst(Sibling, S, nil);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Sibling, S, Ptr, naAddFirst);
+ {$ELSE}
+ if Sibling <> nil then Sibling := Sibling.Parent;
+ Result := InternalAddObject(Sibling, S, Ptr, taAddFirst);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Sibling, S, nil, naAdd);
+ {$ELSE}
+ Result := AddObject(Sibling, S, nil);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.AddObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Sibling, S, Ptr, naAdd);
+ {$ELSE}
+ if Sibling <> nil then Sibling := Sibling.Parent;
+ Result := InternalAddObject(Sibling, S, Ptr, taAdd);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Sibling, S, nil, naInsert);
+ {$ELSE}
+ Result := InsertObject(Sibling, S, nil);
+ {$ENDIF}
+end;
+
+function TTntTreeNodes.InsertObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ {$IFDEF COMPILER_6_UP}
+ Result := AddNode(nil, Sibling, S, Ptr, naInsert);
+ {$ELSE}
+ Result := inherited InsertObject(Sibling, '', Ptr) as TTntTreeNode;
+ Result.Text := S;
+ {$ENDIF}
+end;
+
+{$IFDEF COMPILER_6_UP}
+
+function TTntTreeNodes.InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ Result := AddNode(Node, Sibling, S, Ptr, naInsert);
+end;
+
+function TTntTreeNodes.AddNode(Node, Relative: TTntTreeNode; const S: WideString;
+ Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
+begin
+ Result := inherited AddNode(Node, Relative, '', Ptr, Method) as TTntTreeNode;
+ Result.Text := S;
+end;
+
+{$ELSE}
+
+function TTntTreeNodes.InternalAddObject(Node: TTntTreeNode; const S: WideString;
+ Ptr: Pointer; AddMode: TAddMode): TTntTreeNode;
+begin
+ Result := inherited InternalAddObject(Node, '', Ptr, AddMode) as TTntTreeNode;
+ Result.Text := S;
+end;
+
+{$ENDIF}
+
+function TTntTreeNodes.GetNode(ItemId: HTreeItem): TTntTreeNode;
+begin
+ Result := inherited GetNode(ItemID) as TTntTreeNode;
+end;
+
+function TTntTreeNodes.GetFirstNode: TTntTreeNode;
+begin
+ Result := inherited GetFirstNode as TTntTreeNode;
+end;
+
+function TTntTreeNodes.GetNodesOwner: TTntCustomTreeView;
+begin
+ Result := inherited Owner as TTntCustomTreeView;
+end;
+
+procedure TTntTreeNodes.ClearCache;
+begin
+ THackTreeNodes(Self).FNodeCache.CacheNode := nil;
+end;
+
+procedure TTntTreeNodes.DefineProperties(Filer: TFiler);
+
+ function WriteNodes: Boolean;
+ var
+ I: Integer;
+ Nodes: TTntTreeNodes;
+ begin
+ Nodes := TTntTreeNodes(Filer.Ancestor);
+ if Nodes = nil then
+ Result := Count > 0
+ else if Nodes.Count <> Count then
+ Result := True
+ else
+ begin
+ Result := False;
+ for I := 0 to Count - 1 do
+ begin
+ Result := not Item[I].IsEqual(Nodes[I]);
+ if Result then
+ Break;
+ end
+ end;
+ end;
+
+begin
+ inherited DefineProperties(Filer);
+ Filer.DefineBinaryProperty('Utf8Data', ReadData, WriteData, WriteNodes);
+end;
+
+procedure TTntTreeNodes.ReadData(Stream: TStream);
+var
+ I, Count: Integer;
+ NodeInfo: TNodeInfo;
+ LNode: TTntTreeNode;
+ LHandleAllocated: Boolean;
+begin
+ LHandleAllocated := Owner.HandleAllocated;
+ if LHandleAllocated then
+ BeginUpdate;
+ {$IFDEF COMPILER_6_UP}
+ THackTreeNodes(Self).FReading := True;
+ {$ENDIF}
+ try
+ Clear;
+ Stream.ReadBuffer(Count, SizeOf(Count));
+ for I := 0 to Count - 1 do
+ begin
+ LNode := Add(nil, '');
+ LNode.ReadData(Stream, @NodeInfo);
+ {$IFDEF COMPILER_6_UP}
+ Owner.Added(LNode);
+ {$ENDIF}
+ end;
+ finally
+ {$IFDEF COMPILER_6_UP}
+ THackTreeNodes(Self).FReading := False;
+ {$ENDIF}
+ if LHandleAllocated then
+ EndUpdate;
+ end;
+end;
+
+procedure TTntTreeNodes.WriteData(Stream: TStream);
+var
+ I: Integer;
+ Node: TTntTreeNode;
+ NodeInfo: TNodeInfo;
+begin
+ I := 0;
+ Node := GetFirstNode;
+ while Node <> nil do
+ begin
+ Inc(I);
+ Node := Node.GetNextSibling;
+ end;
+ Stream.WriteBuffer(I, SizeOf(I));
+ Node := GetFirstNode;
+ while Node <> nil do
+ begin
+ Node.WriteData(Stream, @NodeInfo);
+ Node := Node.GetNextSibling;
+ end;
+end;
+
+{ TTntTreeStrings }
+
+type
+ TTntTreeStrings = class(TTntStringList)
+ protected
+ function GetBufStart(Buffer: PWideChar; var Level: Integer): PWideChar;
+ public
+ procedure SaveToTree(Tree: TTntCustomTreeView);
+ procedure LoadFromTree(Tree: TTntCustomTreeView);
+ end;
+
+function TTntTreeStrings.GetBufStart(Buffer: PWideChar; var Level: Integer): PWideChar;
+begin
+ Level := 0;
+ while Buffer^ in [WideChar(' '), WideChar(#9)] do
+ begin
+ Inc(Buffer);
+ Inc(Level);
+ end;
+ Result := Buffer;
+end;
+
+procedure TTntTreeStrings.SaveToTree(Tree: TTntCustomTreeView);
+var
+ ANode, NextNode: TTntTreeNode;
+ ALevel, i: Integer;
+ CurrStr: WideString;
+ Owner: TTntTreeNodes;
+begin
+ Owner := Tree.Items;
+ Owner.BeginUpdate;
+ try
+ try
+ Owner.Clear;
+ ANode := nil;
+ for i := 0 to Count - 1 do
+ begin
+ CurrStr := GetBufStart(PWideChar(Strings[i]), ALevel);
+ if ANode = nil then
+ ANode := Owner.AddChild(nil, CurrStr)
+ else if ANode.Level = ALevel then
+ ANode := Owner.AddChild(ANode.Parent, CurrStr)
+ else if ANode.Level = (ALevel - 1) then
+ ANode := Owner.AddChild(ANode, CurrStr)
+ else if ANode.Level > ALevel then
+ begin
+ NextNode := ANode.Parent;
+ while NextNode.Level > ALevel do
+ NextNode := NextNode.Parent;
+ ANode := Owner.AddChild(NextNode.Parent, CurrStr);
+ end
+ else
+ raise ETreeViewError.CreateFmt(sInvalidLevelEx, [ALevel, CurrStr]);
+ end;
+ finally
+ Owner.EndUpdate;
+ end;
+ except
+ Owner.Owner.Invalidate; // force repaint on exception
+ raise;
+ end;
+end;
+
+procedure TTntTreeStrings.LoadFromTree(Tree: TTntCustomTreeView);
+const
+ TabChar = #9;
+var
+ i: Integer;
+ ANode: TTntTreeNode;
+ NodeStr: WideString;
+ Owner: TTntTreeNodes;
+begin
+ Clear;
+ Owner := Tree.Items;
+ if Owner.Count > 0 then
+ begin
+ ANode := Owner[0];
+ while ANode <> nil do
+ begin
+ NodeStr := '';
+ for i := 0 to ANode.Level - 1 do NodeStr := NodeStr + TabChar;
+ NodeStr := NodeStr + ANode.Text;
+ Add(NodeStr);
+ ANode := ANode.GetNext;
+ end;
+ end;
+end;
+
+{$IFDEF COMPILER_5_UP}
+type
+ THackCustomTreeView = class(TWinControl)
+ protected
+ F_xxxxxxx_AutoExpand: Boolean;
+ F_xxxxxxx_BorderStyle: TBorderStyle;
+ F_xxxxxxx_Canvas: TCanvas;
+ F_xxxxxxx_CanvasChanged: Boolean;
+ F_xxxxxxx_DefEditProc: Pointer;
+ F_xxxxxxx_Dragged: Boolean;
+ F_xxxxxxx_DragImage: TDragImageList;
+ F_xxxxxxx_DragNode: TTreeNode{TNT-ALLOW TTreeNode};
+ F_xxxxxxx_EditHandle: HWND;
+ F_xxxxxxx_EditInstance: Pointer;
+ F_xxxxxxx_HideSelection: Boolean;
+ F_xxxxxxx_HotTrack: Boolean;
+ F_xxxxxxx_ImageChangeLink: TChangeLink;
+ F_xxxxxxx_Images: TCustomImageList;
+ F_xxxxxxx_LastDropTarget: TTreeNode{TNT-ALLOW TTreeNode};
+ F_xxxxxxx_MemStream: TMemoryStream{TNT-ALLOW TMemoryStream};
+ F_xxxxxxx_RClickNode: TTreeNode{TNT-ALLOW TTreeNode};
+ F_xxxxxxx_RightClickSelect: Boolean;
+ F_xxxxxxx_ManualNotify: Boolean;
+ F_xxxxxxx_ReadOnly: Boolean;
+ F_xxxxxxx_RowSelect: Boolean;
+ F_xxxxxxx_SaveIndex: Integer;
+ F_xxxxxxx_SaveIndent: Integer;
+ F_xxxxxxx_SaveItems: TStringList{TNT-ALLOW TStringList};
+ F_xxxxxxx_SaveTopIndex: Integer;
+ F_xxxxxxx_ShowButtons: Boolean;
+ F_xxxxxxx_ShowLines: Boolean;
+ F_xxxxxxx_ShowRoot: Boolean;
+ F_xxxxxxx_SortType: TSortType;
+ F_xxxxxxx_StateChanging: Boolean;
+ F_xxxxxxx_StateImages: TCustomImageList;
+ F_xxxxxxx_StateChangeLink: TChangeLink;
+ F_xxxxxxx_ToolTips: Boolean;
+ FTreeNodes: TTreeNodes{TNT-ALLOW TTreeNodes};
+ end;
+{$ENDIF}
+
+{ _TntInternalCustomTreeView }
+
+{$IFDEF COMPILER_6_UP}
+function _TntInternalCustomTreeView.FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
+begin
+ Result := Wide_FindNextToSelect;
+end;
+
+function _TntInternalCustomTreeView.Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
+begin
+ Result := inherited FindNextToSelect;
+end;
+{$ENDIF}
+
+{ TTntCustomTreeView }
+
+function TntDefaultTreeViewSort(Node1, Node2: TTntTreeNode; lParam: Integer): Integer; stdcall;
+begin
+ with Node1 do
+ if Assigned(TreeView.OnCompare) then
+ TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result)
+ else Result := lstrcmpw(PWideChar(Node1.Text), PWideChar(Node2.Text));
+end;
+
+constructor TTntCustomTreeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEditInstance := MakeObjectInstance(EditWndProcW);
+ {$IFNDEF COMPILER_6_UP}
+ // create nodes
+ Assert(THackCustomTreeView(Self).FTreeNodes = inherited Items, 'Internal Error in TTntCustomTreeView.Create().');
+ FreeAndNil(THackCustomTreeView(Self).FTreeNodes);
+ THackCustomTreeView(Self).FTreeNodes := TTntTreeNodes.Create(Self);
+ {$ENDIF}
+end;
+
+destructor TTntCustomTreeView.Destroy;
+begin
+ Destroying;
+ FreeObjectInstance(FEditInstance);
+ FreeAndNil(FSavedNodeText);
+ inherited;
+end;
+
+var
+ ComCtrls_DefaultTreeViewSort: TTVCompare = nil;
+
+procedure TTntCustomTreeView.CreateWindowHandle(const Params: TCreateParams);
+
+ procedure Capture_ComCtrls_DefaultTreeViewSort;
+ begin
+ FTestingForSortProc := True;
+ try
+ AlphaSort;
+ finally
+ FTestingForSortProc := False;
+ end;
+ end;
+
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, WC_TREEVIEW);
+ if (Win32PlatformIsUnicode) then begin
+ if not Assigned(ComCtrls_DefaultTreeViewSort) then
+ Capture_ComCtrls_DefaultTreeViewSort;
+ end;
+end;
+
+procedure TTntCustomTreeView.CreateWnd;
+begin
+ inherited;
+ FreeAndNil(FSavedNodeText);
+end;
+
+procedure TTntCustomTreeView.DestroyWnd;
+begin
+ if (not (csDestroying in ComponentState)) then begin
+ FSavedNodeText := TTntStringList.Create;
+ SaveNodeTextToStrings(Items, FSavedNodeText);
+ end;
+ inherited;
+end;
+
+procedure TTntCustomTreeView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntCustomTreeView.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomTreeView.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntCustomTreeView.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomTreeView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomTreeView.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntCustomTreeView.CreateNode: TTreeNode{TNT-ALLOW TTreeNode};
+var
+ LClass: TClass;
+ TntLClass: TTntTreeNodeClass;
+begin
+ LClass := TTntTreeNode;
+ {$IFDEF COMPILER_6_UP}
+ if Assigned(OnCreateNodeClass) then
+ OnCreateNodeClass(Self, TTreeNodeClass(LClass));
+ if not LClass.InheritsFrom(TTntTreeNode) then
+ raise ETntInternalError.Create('Internal Error: OnCreateNodeClass.ItemClass must inherit from TTntTreeNode.');
+ {$ENDIF}
+ TntLClass := TTntTreeNodeClass(LClass);
+ Result := TntLClass.Create(inherited Items);
+end;
+
+{$IFDEF COMPILER_6_UP}
+function TTntCustomTreeView.CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes};
+begin
+ Result := TTntTreeNodes.Create(Self);
+end;
+{$ENDIF}
+
+function TTntCustomTreeView.GetTreeNodes: TTntTreeNodes;
+begin
+ Result := inherited Items as TTntTreeNodes;
+end;
+
+procedure TTntCustomTreeView.SetTreeNodes(const Value: TTntTreeNodes);
+begin
+ Items.Assign(Value);
+end;
+
+function TTntCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTntTreeNode;
+begin
+ Result := nil;
+ if Items <> nil then
+ with Item do
+ if (state and TVIF_PARAM) <> 0 then
+ Result := Pointer(lParam)
+ else
+ Result := Items.GetNode(hItem);
+end;
+
+{$IFDEF COMPILER_6_UP}
+function TTntCustomTreeView.Wide_FindNextToSelect: TTntTreeNode;
+begin
+ Result := FindNextToSelect;
+end;
+
+function TTntCustomTreeView.FindNextToSelect: TTntTreeNode;
+begin
+ Result := Inherited_FindNextToSelect as TTntTreeNode;
+end;
+{$ENDIF}
+
+function TTntCustomTreeView.GetDropTarget: TTntTreeNode;
+begin
+ Result := inherited DropTarget as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetNodeAt(X, Y: Integer): TTntTreeNode;
+begin
+ Result := inherited GetNodeAt(X, Y) as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetSelected: TTntTreeNode;
+begin
+ Result := inherited Selected as TTntTreeNode;
+end;
+
+{$IFDEF COMPILER_6_UP}
+function TTntCustomTreeView.GetSelection(Index: Integer): TTntTreeNode;
+begin
+ Result := inherited Selections[Index] as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetSelections(AList: TList): TTntTreeNode;
+begin
+ Result := inherited GetSelections(AList) as TTntTreeNode;
+end;
+{$ENDIF}
+
+function TTntCustomTreeView.GetTopItem: TTntTreeNode;
+begin
+ Result := inherited TopItem as TTntTreeNode;
+end;
+
+procedure TTntCustomTreeView.SetDropTarget(const Value: TTntTreeNode);
+begin
+ inherited DropTarget := Value;
+end;
+
+procedure TTntCustomTreeView.SetSelected(const Value: TTntTreeNode);
+begin
+ inherited Selected := Value;
+end;
+
+procedure TTntCustomTreeView.SetTopItem(const Value: TTntTreeNode);
+begin
+ inherited TopItem := Value;
+end;
+
+procedure TTntCustomTreeView.WndProc(var Message: TMessage);
+type
+ PTVSortCB = ^TTVSortCB;
+begin
+ with Message do begin
+ // capture ANSI version of DefaultTreeViewSort from ComCtrls
+ if (FTestingForSortProc)
+ and (Msg = TVM_SORTCHILDRENCB) then begin
+ ComCtrls_DefaultTreeViewSort := PTVSortCB(lParam).lpfnCompare;
+ exit;
+ end;
+
+ if (Win32PlatformIsUnicode)
+ and (Msg = TVM_SORTCHILDRENCB)
+ and (@PTVSortCB(lParam).lpfnCompare = @ComCtrls_DefaultTreeViewSort) then
+ begin
+ // Unicode:: call wide version of sort proc instead
+ PTVSortCB(lParam)^.lpfnCompare := TTVCompare(@TntDefaultTreeViewSort);
+ Result := SendMessageW(Handle, TVM_SORTCHILDRENCB, wParam, lParam);
+ end else
+ inherited;
+ end;
+end;
+
+procedure TTntCustomTreeView.CNNotify(var Message: TWMNotify);
+var
+ Node: TTntTreeNode;
+begin
+ if (not Win32PlatformIsUnicode) then
+ inherited
+ else begin
+ with Message do begin
+ case NMHdr^.code of
+ TVN_BEGINDRAGW:
+ begin
+ NMHdr^.code := TVN_BEGINDRAGA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_BEGINDRAGW;
+ end;
+ end;
+ TVN_BEGINLABELEDITW:
+ begin
+ with PTVDispInfo(NMHdr)^ do
+ if Dragging or not CanEdit(GetNodeFromItem(item)) then
+ Result := 1;
+ if Result = 0 then
+ begin
+ FEditHandle := TreeView_GetEditControl(Handle);
+ FDefEditProc := Pointer(GetWindowLongW(FEditHandle, GWL_WNDPROC));
+ SetWindowLongW(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
+ end;
+ end;
+ TVN_ENDLABELEDITW:
+ Edit(PTVDispInfo(NMHdr)^.item);
+ TVN_ITEMEXPANDINGW:
+ begin
+ NMHdr^.code := TVN_ITEMEXPANDINGA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_ITEMEXPANDINGW;
+ end;
+ end;
+ TVN_ITEMEXPANDEDW:
+ begin
+ NMHdr^.code := TVN_ITEMEXPANDEDA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_ITEMEXPANDEDW;
+ end;
+ end;
+ TVN_DELETEITEMW:
+ begin
+ NMHdr^.code := TVN_DELETEITEMA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_DELETEITEMW;
+ end;
+ end;
+ TVN_SETDISPINFOW:
+ with PTVDispInfo(NMHdr)^ do
+ begin
+ Node := GetNodeFromItem(item);
+ if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then
+ Node.Text := TTVItemW(item).pszText;
+ end;
+ TVN_GETDISPINFOW:
+ with PTVDispInfo(NMHdr)^ do
+ begin
+ Node := GetNodeFromItem(item);
+ if Node <> nil then
+ begin
+ if (item.mask and TVIF_TEXT) <> 0 then begin
+ if (FSavedNodeText <> nil)
+ and (FSavedNodeText.Count > 0)
+ and (AnsiString(FSavedNodeText[0]) = AnsiString(Node.Text)) then
+ begin
+ Node.FText := FSavedNodeText[0]; // recover saved text
+ FSavedNodeText.Delete(0);
+ end;
+ StrLCopyW(TTVItemW(item).pszText, PWideChar(Node.Text), item.cchTextMax - 1);
+ end;
+
+ if (item.mask and TVIF_IMAGE) <> 0 then
+ begin
+ GetImageIndex(Node);
+ item.iImage := Node.ImageIndex;
+ end;
+ if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then
+ begin
+ GetSelectedIndex(Node);
+ item.iSelectedImage := Node.SelectedIndex;
+ end;
+ end;
+ end;
+ else
+ inherited;
+ end;
+ end;
+ end;
+end;
+
+procedure TTntCustomTreeView.WMNotify(var Message: TWMNotify);
+var
+ Node: TTntTreeNode;
+ FWideText: WideString;
+ MaxTextLen: Integer;
+ Pt: TPoint;
+begin
+ with Message do
+ if NMHdr^.code = TTN_NEEDTEXTW then
+ begin
+ // Work around NT COMCTL32 problem with tool tips >= 80 characters
+ GetCursorPos(Pt);
+ Pt := ScreenToClient(Pt);
+ Node := GetNodeAt(Pt.X, Pt.Y);
+ if (Node = nil) or (Node.Text = '') or
+ (PToolTipTextW(NMHdr)^.uFlags and TTF_IDISHWND = 0) then Exit;
+ if (GetComCtlVersion >= ComCtlVersionIE4)
+ or {Borland's VCL wrongly uses "and"} (Length(Node.Text) < 80) then
+ begin
+ DefaultHandler(Message);
+ Exit;
+ end;
+ FWideText := Node.Text;
+ MaxTextLen := SizeOf(PToolTipTextW(NMHdr)^.szText) div SizeOf(WideChar);
+ if Length(FWideText) >= MaxTextLen then
+ SetLength(FWideText, MaxTextLen - 1);
+ PToolTipTextW(NMHdr)^.lpszText := PWideChar(FWideText);
+ FillChar(PToolTipTextW(NMHdr)^.szText, MaxTextLen, 0);
+ Move(Pointer(FWideText)^, PToolTipTextW(NMHdr)^.szText, Length(FWideText) * SizeOf(WideChar));
+ PToolTipTextW(NMHdr)^.hInst := 0;
+ SetWindowPos(NMHdr^.hwndFrom, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or
+ SWP_NOSIZE or SWP_NOMOVE or SWP_NOOWNERZORDER);
+ Result := 1;
+ end
+ else inherited;
+end;
+
+procedure TTntCustomTreeView.Edit(const Item: TTVItem);
+var
+ S: WideString;
+ AnsiS: AnsiString;
+ Node: TTntTreeNode;
+ AnsiEvent: TTVEditedEvent;
+begin
+ with Item do
+ begin
+ Node := GetNodeFromItem(Item);
+ if pszText <> nil then
+ begin
+ if Win32PlatformIsUnicode then
+ S := TTVItemW(Item).pszText
+ else
+ S := pszText;
+
+ if Assigned(FOnEdited) then
+ FOnEdited(Self, Node, S)
+ else if Assigned(inherited OnEdited) then
+ begin
+ AnsiEvent := inherited OnEdited;
+ AnsiS := S;
+ AnsiEvent(Self, Node, AnsiS);
+ S := AnsiS;
+ end;
+
+ if Node <> nil then Node.Text := S;
+ end
+ {$IFDEF COMPILER_6_UP}
+ else if Assigned(OnCancelEdit) then OnCancelEdit(Self, Node);
+ {$ENDIF}
+ end;
+end;
+
+procedure TTntCustomTreeView.EditWndProcW(var Message: TMessage);
+begin
+ Assert(Win32PlatformIsUnicode);
+ try
+ with Message do
+ begin
+ case Msg of
+ WM_KEYDOWN,
+ WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
+ WM_CHAR:
+ begin
+ MakeWMCharMsgSafeForAnsi(Message);
+ try
+ if DoKeyPress(TWMKey(Message)) then Exit;
+ finally
+ RestoreWMCharMsg(Message);
+ end;
+ end;
+ WM_KEYUP,
+ WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
+ CN_KEYDOWN,
+ CN_CHAR, CN_SYSKEYDOWN,
+ CN_SYSCHAR:
+ begin
+ WndProc(Message);
+ Exit;
+ end;
+ end;
+ Result := CallWindowProcW(FDefEditProc, FEditHandle, Msg, WParam, LParam);
+ end;
+ except
+ Application.HandleException(Self);
+ end;
+end;
+
+procedure TTntCustomTreeView.LoadFromFile(const FileName: WideString);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromFile(FileName);
+ TreeStrings.SaveToTree(Self);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
+procedure TTntCustomTreeView.LoadFromStream(Stream: TStream);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromStream(Stream);
+ TreeStrings.SaveToTree(Self);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
+procedure TTntCustomTreeView.SaveToFile(const FileName: WideString);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromTree(Self);
+ TreeStrings.SaveToFile(FileName);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
+procedure TTntCustomTreeView.SaveToStream(Stream: TStream);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromTree(Self);
+ TreeStrings.SaveToStream(Stream);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
initialization
- RegisterClasses([TTntListItems]);
- RegisterClasses([TTntListItem]);
- RegisterClasses([TTntTabSheet]);
finalization
if Assigned(AIMM) then
Modified: trunk/TntUnicodeControls/TntControls.pas
===================================================================
--- trunk/TntUnicodeControls/TntControls.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntControls.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,15 +1,18 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntControls;
+{$INCLUDE TntCompilers.inc}
+
{
Windows NT provides support for native Unicode windows. To add Unicode support to a
TWinControl descendant, override CreateWindowHandle() and call CreateUnicodeHandle().
@@ -48,19 +51,18 @@
5) If descending from TWinControl, verify Unicode chars are preserved after RecreateWnd.
6) Consider using storage specifiers for Hint and Caption properties.
7) If any class could possibly have published WideString properties,
- override DefineProperties and call DefineWideProperties.
+ override DefineProperties and call TntPersistent_AfterInherited_DefineProperties.
8) Check if TTntThemeManager needs to be updated.
9) Override GetActionLinkClass() and ActionChange().
+ 10) If class updates Application.Hint then update TntApplication.Hint instead.
}
interface
-{$IFNDEF VER130}
-{$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! }
-{$ENDIF}
+uses
+ Forms, Classes, Windows, Messages, Controls, TntClasses, TypInfo, ActnList, Menus, TntMenus,
+ TntSysUtils;
-uses Classes, Windows, Messages, Controls, Forms, TntClasses, TypInfo, ActnList, Menus, TntMenus;
-
{TNT-WARN TCaption}
type TWideCaption = type WideString;
@@ -81,12 +83,13 @@
function TntControl_GetHint(Control: TControl): WideString;
procedure TntControl_SetHint(Control: TControl; const Value: WideString);
+function WideGetHint(Control: TControl): WideString;
function WideGetShortHint(const Hint: WideString): WideString;
function WideGetLongHint(const Hint: WideString): WideString;
procedure ProcessCMHintShowMsg(var Message: TMessage);
type
- TTntHintWindow = class(THintWindow)
+ TTntCustomHintWindow = class(THintWindow)
private
FActivating: Boolean;
FBlockPaint: Boolean;
@@ -95,17 +98,24 @@
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
-{$IFNDEF VER150}
+{$IFNDEF COMPILER_7_UP}
procedure CreateParams(var Params: TCreateParams); override;
{$ENDIF}
procedure Paint; override;
public
- procedure ActivateHint(Rect: TRect; const AHint: Ansistring); override;
- procedure ActivateHintData(Rect: TRect; const AHint: Ansistring; AData: Pointer); override;
+ procedure ActivateHint(Rect: TRect; const AHint: AnsiString); override;
+ procedure ActivateHintData(Rect: TRect; const AHint: AnsiString; AData: Pointer); override;
function CalcHintRect(MaxWidth: Integer; const AHint: AnsiString; AData: Pointer): TRect; override;
property Caption: TWideCaption read GetCaption write SetCaption;
end;
+ TTntHintWindow = class(TTntCustomHintWindow)
+ public
+ procedure ActivateHint(Rect: TRect; const AHint: WideString); reintroduce;
+ procedure ActivateHintData(Rect: TRect; const AHint: WideString; AData: Pointer); reintroduce;
+ function CalcHintRect(MaxWidth: Integer; const AHint: WideString; AData: Pointer): TRect; reintroduce;
+ end;
+
// text/char message
function IsTextMessage(Msg: UINT): Boolean;
procedure MakeWMCharMsgSafeForAnsi(var Message: TMessage);
@@ -125,13 +135,17 @@
['{C1801F41-51E9-4DB5-8DB8-58AC86698C2E}']
procedure AddItem(const Item: WideString; AObject: TObject);
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure WideListControl_AddItem(Control: TCustomListControl; const Item: WideString; AObject: TObject);
{$ENDIF}
+var
+ _IsShellProgramming: Boolean = False;
+
implementation
-uses SysUtils, Graphics, Imm, Contnrs, TntForms, TntGraphics;
+uses
+ SysUtils, Graphics, Imm, Contnrs, TntForms, TntGraphics, TntWindows;
type
TAccessControl = class(TControl);
@@ -183,12 +197,33 @@
{ TWideCaptionHolder }
+function CompareCaptionHolderToTarget(Item, Target: Pointer): Integer;
+begin
+ if Integer(TWideCaptionHolder(Item).FControl) < Integer(Target) then
+ Result := -1
+ else if Integer(TWideCaptionHolder(Item).FControl) > Integer(Target) then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function FindWideCaptionHolderIndex(Control: TControl; var Index: Integer): Boolean;
+begin
+ // find control in sorted wide caption list (list is sorted by TWideCaptionHolder.FControl)
+ Result := FindSortedListByTarget(WideCaptionHolders, CompareCaptionHolderToTarget, Control, Index);
+end;
+
constructor TWideCaptionHolder.Create(AOwner: TControl);
+var
+ Index: Integer;
begin
inherited Create(nil);
FControl := AOwner;
FControl.FreeNotification(Self);
- WideCaptionHolders.Add(Self)
+
+ // insert into list according sort
+ FindWideCaptionHolderIndex(FControl, Index);
+ WideCaptionHolders.Insert(Index, Self);
end;
procedure TWideCaptionHolder.Notification(AComponent: TComponent; Operation: TOperation);
@@ -212,18 +247,16 @@
function FindWideCaptionHolder(Control: TControl; CreateIfNotFound: Boolean = True): TWideCaptionHolder;
var
- i: integer;
+ Index: integer;
begin
- Result := nil;
- for i := 0 to WideCaptionHolders.Count - 1 do begin
- if (TWideCaptionHolder(WideCaptionHolders[i]).FControl = Control) then begin
- Result := TWideCaptionHolder(WideCaptionHolders[i]);
- exit; // found it!
- end;
- end;
- if (Result = nil) and CreateIfNotFound then begin
- Result := TWideCaptionHolder.Create(Control);
- end;
+ if FindWideCaptionHolderIndex(Control, Index) then begin
+ Result := TWideCaptionHolder(WideCaptionHolders[Index]);
+ Assert(Result.FControl = Control, 'TNT Internal Error: FindWideCaptionHolderIndex failed.');
+ end else
+ Result := nil;
+
+ if (Result = nil) and CreateIfNotFound then
+ Result := TWideCaptionHolder.Create(Control);
end;
//----------------------------------------------- GET/SET WINDOW CAPTION/HINT -------------
@@ -247,16 +280,18 @@
procedure TntControl_SetStoredText(Control: TControl; const Value: WideString);
begin
- FindWideCaptionHolder(Control).FWideCaption := Value
+ FindWideCaptionHolder(Control).FWideCaption := Value;
+ TAccessControl(Control).Text := Value;
end;
function TntControl_GetText(Control: TControl): WideString;
var
WideCaptionHolder: TWideCaptionHolder;
begin
- if (not Win32PlatformIsUnicode) then
- // Win9x
- Result := TAccessWinControl(Control).Text
+ if (not Win32PlatformIsUnicode)
+ or ((Control is TWinControl) and TWinControl(Control).HandleAllocated and (not IsWindowUnicode(TWinControl(Control).Handle))) then
+ // Win9x / non-unicode handle
+ Result := TAccessControl(Control).Text
else if (not (Control is TWinControl)) then begin
// non-windowed TControl
WideCaptionHolder := FindWideCaptionHolder(Control, False);
@@ -264,9 +299,8 @@
Result := TAccessControl(Control).Text
else
Result := GetSyncedWideString(WideCaptionHolder.FWideCaption, TAccessControl(Control).Text);
- end else if (not TWinControl(Control).HandleAllocated)
- or (not IsWindowUnicode(TWinControl(Control).Handle)) then begin
- // NO HANDLE -OR- NOT UNICODE
+ end else if (not TWinControl(Control).HandleAllocated) then begin
+ // NO HANDLE
Result := TntControl_GetStoredText(Control, TAccessControl(Control).Text)
end else begin
// UNICODE & HANDLE
@@ -278,21 +312,20 @@
procedure TntControl_SetText(Control: TControl; const Text: WideString);
begin
- if (not Win32PlatformIsUnicode) then
- // Win9x
- TAccessWinControl(Control).Text := Text
+ if (not Win32PlatformIsUnicode)
+ or ((Control is TWinControl) and TWinControl(Control).HandleAllocated and (not IsWindowUnicode(TWinControl(Control).Handle))) then
+ // Win9x / non-unicode handle
+ TAccessControl(Control).Text := Text
else if (not (Control is TWinControl)) then begin
// non-windowed TControl
with FindWideCaptionHolder(Control) do
- SetSyncedWideString(Text, FWideCaption, TAccessWinControl(Control).Text, SetAnsiText)
- end else if (not TWinControl(Control).HandleAllocated)
- or (not IsWindowUnicode(TWinControl(Control).Handle)) then begin
- // NO HANDLE -OR- NOT UNICODE
+ SetSyncedWideString(Text, FWideCaption, TAccessControl(Control).Text, SetAnsiText)
+ end else if (not TWinControl(Control).HandleAllocated) then begin
+ // NO HANDLE
TntControl_SetStoredText(Control, Text);
- TAccessWinControl(Control).Text := Text
end else if TntControl_GetText(Control) <> Text then begin
// UNICODE & HANDLE
- SetWindowTextW(TWinControl(Control).Handle, PWideChar(Text));
+ Tnt_SetWindowTextW(TWinControl(Control).Handle, PWideChar(Text));
Control.Perform(CM_TEXTCHANGED, 0, 0);
end;
end;
@@ -309,18 +342,22 @@
var
WideCaptionHolder: TWideCaptionHolder;
begin
- Result := Control.Hint;
- if Win32PlatformIsUnicode then begin
+ if (not Win32PlatformIsUnicode) then
+ Result := Control.Hint
+ else begin
WideCaptionHolder := FindWideCaptionHolder(Control, False);
if WideCaptionHolder <> nil then
- Result := GetSyncedWideString(WideCaptionHolder.FWideHint, Control.Hint);
+ Result := GetSyncedWideString(WideCaptionHolder.FWideHint, Control.Hint)
+ else
+ Result := Control.Hint;
end;
end;
procedure TntControl_SetHint(Control: TControl; const Value: WideString);
begin
- Control.Hint := Value;
- if Win32PlatformIsUnicode then
+ if (not Win32PlatformIsUnicode) then
+ Control.Hint := Value
+ else
with FindWideCaptionHolder(Control) do
SetSyncedWideString(Value, FWideHint, Control.Hint, SetAnsiHint);
end;
@@ -393,7 +430,16 @@
begin
with TWMChar(Message) do begin
Assert(Msg = WM_CHAR);
- Assert(Unused = 0);
+ if not _IsShellProgramming then
+ Assert(Unused = 0)
+ else begin
+ Assert((Unused = 0) or (CharCode <= Word(High(AnsiChar))));
+ // When a Unicode control is embedded under non-Delphi Unicode
+ // window something strange happens
+ if (Unused <> 0) then begin
+ CharCode := (Unused shl 8) or CharCode;
+ end;
+ end;
if (CharCode > Word(High(AnsiChar))) then begin
Unused := CharCode;
CharCode := ANSI_UNICODE_HOLDER;
@@ -472,16 +518,16 @@
inherited Create(nil);
FControl.FreeNotification(Self);
- WinControl_ObjectInstance := TntClasses.MakeObjectInstance(FControl.MainWndProc);
- ObjectInstance := TntClasses.MakeObjectInstance(Win32Proc);
- DefObjectInstance := TntClasses.MakeObjectInstance(DefWin32Proc);
+ WinControl_ObjectInstance := MakeObjectInstance(FControl.MainWndProc);
+ ObjectInstance := MakeObjectInstance(Win32Proc);
+ DefObjectInstance := MakeObjectInstance(DefWin32Proc);
end;
destructor TWinControlTrap.Destroy;
begin
- TntClasses.FreeObjectInstance(ObjectInstance);
- TntClasses.FreeObjectInstance(DefObjectInstance);
- TntClasses.FreeObjectInstance(WinControl_ObjectInstance);
+ FreeObjectInstance(ObjectInstance);
+ FreeObjectInstance(DefObjectInstance);
+ FreeObjectInstance(WinControl_ObjectInstance);
inherited;
end;
@@ -551,31 +597,49 @@
PendingRecreateWndTrapList.Add(Self);
end;
+var
+ Finalized: Boolean; { If any tnt controls are still around after finalization it must be due to a memory leak.
+ Windows will still try to send a WM_DESTROY, but we will just ignore it if we're finalized. }
+
procedure TWinControlTrap.Win32Proc(var Message: TMessage);
begin
- Inc(Win32ProcLevel);
- try
- with Message do begin
- {$IFDEF TNT_VERIFY_WINDOWPROC}
- if not SameWndMethod(FControl.WindowProc, LastVerifiedWindowProc) then begin
- SubClassWindowProc;
- LastVerifiedWindowProc := FControl.WindowProc;
+ if (not Finalized) then begin
+ Inc(Win32ProcLevel);
+ try
+ with Message do begin
+ {$IFDEF TNT_VERIFY_WINDOWPROC}
+ if not SameWndMethod(FControl.WindowProc, LastVerifiedWindowProc) then begin
+ SubClassWindowProc;
+ LastVerifiedWindowProc := FControl.WindowProc;
+ end;
+ {$ENDIF}
+ LastWin32Msg := Msg;
+ Result := CallWindowProcW(PrevWin32Proc, Handle, Msg, wParam, lParam);
end;
- {$ENDIF}
- if Msg = WM_DESTROY then begin
- UnSubClassUnicodeControl;
- end;
- LastWin32Msg := Msg;
- Result := CallWindowProcW(PrevWin32Proc, Handle, Msg, wParam, lParam);
+ finally
+ Dec(Win32ProcLevel);
end;
- finally
- Dec(Win32ProcLevel);
- end;
- if (Win32ProcLevel = 0) and (DestroyTrap) then
- Free;
+ if (Win32ProcLevel = 0) and (DestroyTrap) then
+ Free;
+ end else if (Message.Msg = WM_DESTROY) then
+ FControl.WindowHandle := 0
end;
procedure TWinControlTrap.DefWin32Proc(var Message: TMessage);
+
+ function IsChildEdit(AHandle: HWND): Boolean;
+ var
+ AHandleClass: WideString;
+ begin
+ Result := False;
+ if (FControl.Handle = GetParent(Handle)) then begin
+ // child control
+ SetLength(AHandleClass, 255);
+ SetLength(AHandleClass, GetClassNameW(AHandle, PWideChar(AHandleClass), Length(AHandleClass)));
+ Result := WideSameText(AHandleClass, 'EDIT');
+ end;
+ end;
+
begin
with Message do begin
if Msg = WM_NOTIFYFORMAT then
@@ -584,32 +648,39 @@
if (Msg = WM_CHAR) then begin
RestoreWMCharMsg(Message)
end;
- if (Msg = WM_IME_CHAR) and (not Win32PlatformIsXP) then
+ if (Msg = WM_IME_CHAR) and (not _IsShellProgramming) and (not Win32PlatformIsXP) then
begin
{ In Windows XP, DefWindowProc handles WM_IME_CHAR fine for VCL windows. }
{ Before XP, DefWindowProc will sometimes produce incorrect, non-Unicode WM_CHAR. }
{ Also, using PostMessageW on Windows 2000 didn't always produce the correct results. }
Message.Result := SendMessageW(Handle, WM_CHAR, wParam, lParam)
- end else
+ end else if (Msg = WM_IME_CHAR) and (_IsShellProgramming) then begin
+ { When a Tnt control is hosted by a non-delphi control, DefWindowProc doesn't always work even on XP. }
+ if IsChildEdit(Handle) then
+ Message.Result := Integer(PostMessageW(Handle, WM_CHAR, wParam, lParam)) // native edit child control
+ else
+ Message.Result := SendMessageW(Handle, WM_CHAR, wParam, lParam);
+ end else begin
+ if (Msg = WM_DESTROY) then begin
+ UnSubClassUnicodeControl; {The reason for doing this in DefWin32Proc is because in D9, TWinControl.WMDestroy() does a perform(WM_TEXT) operation. }
+ end;
+ { Normal DefWindowProc }
Result := CallWindowProcW(PrevDefWin32Proc, Handle, Msg, wParam, lParam);
+ end;
end;
end;
end;
-var
- OriginalHintStr: AnsiString = '';
-
procedure ProcessCMHintShowMsg(var Message: TMessage);
begin
if Win32PlatformIsUnicode then begin
with TCMHintShow(Message) do begin
if (HintInfo.HintWindowClass = THintWindow)
- or (HintInfo.HintWindowClass.InheritsFrom(TTntHintWindow)) then begin
+ or (HintInfo.HintWindowClass.InheritsFrom(TTntCustomHintWindow)) then begin
if (HintInfo.HintWindowClass = THintWindow) then
- HintInfo.HintWindowClass := TTntHintWindow;
+ HintInfo.HintWindowClass := TTntCustomHintWindow;
HintInfo.HintData := HintInfo;
HintInfo.HintStr := WideGetShortHint(WideGetHint(HintInfo.HintControl));
- OriginalHintStr := HintInfo.HintStr;
end;
end;
end;
@@ -685,7 +756,7 @@
WinControlTrap: TWinControlTrap;
begin
if not IsWindowUnicode(Control.Handle) then
- raise Exception.Create('TNT Internal Error: SubClassUnicodeControl.Control is not Unicode.');
+ raise ETntInternalError.Create('Internal Error: SubClassUnicodeControl.Control is not Unicode.');
WinControlTrap := FindOrCreateWinControlTrap(Control);
WinControlTrap.SubClassControl(Params_Caption);
@@ -721,10 +792,10 @@
TAccessWinControl(CreationControl).WindowHandle := HWindow;
ObjectInstance := GetObjectInstance(CreationControl);
{Controls.InitWndProc converts control to ANSI here by calling SetWindowLongA()!}
- SetWindowLongW(HWindow, GWL_WNDPROC, Longint(ObjectInstance));
+ SetWindowLongW(HWindow, GWL_WNDPROC, Integer(ObjectInstance));
if (GetWindowLongW(HWindow, GWL_STYLE) and WS_CHILD <> 0)
and (GetWindowLongW(HWindow, GWL_ID) = 0) then
- SetWindowLongW(HWindow, GWL_ID, HWindow);
+ SetWindowLongW(HWindow, GWL_ID, Integer(HWindow));
SetProp(HWindow, MakeIntAtom(ControlAtom), THandle(CreationControl));
SetProp(HWindow, MakeIntAtom(WindowAtom), THandle(CreationControl));
CreationControl := nil;
@@ -747,12 +818,13 @@
with Params do begin
WideWinClassName := WinClassName + UNICODE_CLASS_EXT;
- ClassRegistered := GetClassInfoW(WindowClass.hInstance, PWideChar(WideWinClassName), TempClass);
+ ClassRegistered := GetClassInfoW(hInstance, PWideChar(WideWinClassName), TempClass);
if (not ClassRegistered) or (TempClass.lpfnWndProc <> InitialProc)
then begin
- if ClassRegistered then Windows.UnregisterClassW(PWideChar(WideWinClassName), WindowClass.hInstance);
+ if ClassRegistered then Win32Check(Windows.UnregisterClassW(PWideChar(WideWinClassName), hInstance));
// Prepare a TWndClassW record
WideClass := TWndClassW(WindowClass);
+ WideClass.hInstance := hInstance;
WideClass.lpfnWndProc := InitialProc;
if not Tnt_Is_IntResource(PWideChar(WindowClass.lpszMenuName)) then begin
WideClass.lpszMenuName := PWideChar(WideString(WindowClass.lpszMenuName));
@@ -792,7 +864,7 @@
try
with Params do
Handle := CreateWindowExW(ExStyle, PWideChar(WideWinClassName), nil,
- Style, X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
+ Style, X, Y, Width, Height, WndParent, 0, hInstance, Param);
if Handle = 0 then
RaiseLastOSError;
TAccessWinControl(Control).WindowHandle := Handle;
@@ -817,7 +889,7 @@
CreateParams(Params);
CreationControl := Control;
CreateUnicodeHandle(Control, Params, SubClass, IDEWindow);
- StrDispose(WindowText);
+ StrDispose{TNT-ALLOW StrDispose}(WindowText);
WindowText := nil;
Perform(WM_SETFONT, Integer(Font.Handle), 1);
if AutoSize then AdjustSize;
@@ -826,14 +898,14 @@
end;
end;
-{ TTntHintWindow procs }
+{ TTntCustomHintWindow procs }
function DataPointsToHintInfoForTnt(AData: Pointer): Boolean;
begin
try
Result := (AData <> nil)
and (PHintInfo(AData).HintData = AData) {points to self}
- and (PHintInfo(AData).HintWindowClass.InheritsFrom(TTntHintWindow));
+ and (PHintInfo(AData).HintWindowClass.InheritsFrom(TTntCustomHintWindow));
except
Result := False;
end;
@@ -865,15 +937,15 @@
end;
end;
-{ TTntHintWindow procs }
+{ TTntCustomHintWindow }
-procedure TTntHintWindow.CreateWindowHandle(const Params: TCreateParams);
+procedure TTntCustomHintWindow.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, '');
end;
-{$IFNDEF VER150}
-procedure TTntHintWindow.CreateParams(var Params: TCreateParams);
+{$IFNDEF COMPILER_7_UP}
+procedure TTntCustomHintWindow.CreateParams(var Params: TCreateParams);
const
CS_DROPSHADOW = $00020000;
begin
@@ -883,25 +955,17 @@
end;
{$ENDIF}
-function TTntHintWindow.GetCaption: TWideCaption;
+function TTntCustomHintWindow.GetCaption: TWideCaption;
begin
Result := TntControl_GetText(Self)
end;
-procedure TTntHintWindow.SetCaption(const Value: TWideCaption);
+procedure TTntCustomHintWindow.SetCaption(const Value: TWideCaption);
begin
TntControl_SetText(Self, Value);
end;
-procedure TTntHintWindow.CMTextChanged(var Message: TMessage);
-begin
- { Avoid flicker when calling ActivateHint }
- if FActivating then Exit;
- Width := WideCanvasTextWidth(Canvas, Caption) + 6;
- Height := WideCanvasTextHeight(Canvas, Caption) + 6;
-end;
-
-procedure TTntHintWindow.Paint;
+procedure TTntCustomHintWindow.Paint;
var
R: TRect;
begin
@@ -914,13 +978,21 @@
Inc(R.Left, 2);
Inc(R.Top, 2);
Canvas.Font.Color := Screen.HintFont.Color;
- DrawTextW(Canvas.Handle, PWideChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
+ Tnt_DrawTextW(Canvas.Handle, PWideChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
end;
end;
-procedure TTntHintWindow.ActivateHint(Rect: TRect; const AHint: Ansistring);
+procedure TTntCustomHintWindow.CMTextChanged(var Message: TMessage);
begin
+ { Avoid flicker when calling ActivateHint }
+ if FActivating then Exit;
+ Width := WideCanvasTextWidth(Canvas, Caption) + 6;
+ Height := WideCanvasTextHeight(Canvas, Caption) + 6;
+end;
+
+procedure TTntCustomHintWindow.ActivateHint(Rect: TRect; const AHint: AnsiString);
+begin
FActivating := True;
try
inherited;
@@ -929,7 +1001,7 @@
end;
end;
-procedure TTntHintWindow.ActivateHintData(Rect: TRect; const AHint: Ansistring; AData: Pointer);
+procedure TTntCustomHintWindow.ActivateHintData(Rect: TRect; const AHint: AnsiString; AData: Pointer);
begin
if (not Win32PlatformIsUnicode)
or (not DataPointsToHintInfoForTnt(AData)) then
@@ -937,8 +1009,13 @@
else begin
FBlockPaint := True;
try
- inherited;
- Caption := ExtractTntHintCaption(AData);
+ FActivating := True;
+ try
+ Caption := ExtractTntHintCaption(AData);
+ inherited;
+ finally
+ FActivating := False;
+ end;
finally
FBlockPaint := False;
end;
@@ -946,7 +1023,16 @@
end;
end;
-function TTntHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: AnsiString; AData: Pointer): TRect;
+function TntHintWindow_CalcHintRect(HintWindow: TTntCustomHintWindow; MaxWidth: Integer; const AHint: WideString): TRect;
+begin
+ Result := Rect(0, 0, MaxWidth, 0);
+ Tnt_DrawTextW(HintWindow.Canvas.Handle, PWideChar(AHint), -1, Result, DT_CALCRECT or DT_LEFT or
+ DT_WORDBREAK or DT_NOPREFIX or HintWindow.DrawTextBiDiModeFlagsReadingOnly);
+ Inc(Result.Right, 6);
+ Inc(Result.Bottom, 2);
+end;
+
+function TTntCustomHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: AnsiString; AData: Pointer): TRect;
var
WideHintStr: WideString;
begin
@@ -955,15 +1041,46 @@
Result := inherited CalcHintRect(MaxWidth, AHint, AData)
else begin
WideHintStr := ExtractTntHintCaption(AData);
- Result := Rect(0, 0, MaxWidth, 0);
- DrawTextW(Canvas.Handle, PWideChar(WideHintStr), -1, Result, DT_CALCRECT or DT_LEFT or
- DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
- Inc(Result.Right, 6);
- Inc(Result.Bottom, 2);
+ Result := TntHintWindow_CalcHintRect(Self, MaxWidth, WideHintStr);
end;
end;
-{$IFNDEF VER130}
+{ TTntHintWindow }
+
+procedure TTntHintWindow.ActivateHint(Rect: TRect; const AHint: WideString);
+begin
+ FActivating := True;
+ try
+ Caption := AHint;
+ inherited ActivateHint(Rect, AHint);
+ finally
+ FActivating := False;
+ end;
+end;
+
+procedure TTntHintWindow.ActivateHintData(Rect: TRect; const AHint: WideString; AData: Pointer);
+begin
+ FBlockPaint := True;
+ try
+ FActivating := True;
+ try
+ Caption := AHint;
+ inherited ActivateHintData(Rect, AHint, AData);
+ finally
+ FActivating := False;
+ end;
+ finally
+ FBlockPaint := False;
+ end;
+ Invalidate;
+end;
+
+function TTntHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: WideString; AData: Pointer): TRect;
+begin
+ Result := TntHintWindow_CalcHintRect(Self, MaxWidth, AHint);
+end;
+
+{$IFDEF COMPILER_6_UP}
procedure WideListControl_AddItem(Control: TCustomListControl; const Item: WideString; AObject: TObject);
var
WideControl: IWideCustomListControl;
@@ -977,55 +1094,56 @@
procedure InitControls;
- procedure InitAtomStrings_D5_D6_D7;
+ procedure InitAtomStrings_D5_D6_D7_D9;
+ var
+ Controls_HInstance: Cardinal;
begin
+ Controls_HInstance := FindClassHInstance(TWinControl);
WindowAtomString := Format{TNT-ALLOW Format}('Delphi%.8X',[GetCurrentProcessID]);
- ControlAtomString := Format{TNT-ALLOW Format}('ControlOfs%.8X%.8X', [HInstance, GetCurrentThreadID]);
+ ControlAtomString := Format{TNT-ALLOW Format}('ControlOfs%.8X%.8X', [Controls_HInstance, GetCurrentThreadID]);
end;
- {$IFDEF VER130} // Delphi 5
+ {$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
procedure InitAtomStrings;
begin
- InitAtomStrings_D5_D6_D7;
+ InitAtomStrings_D5_D6_D7_D9;
end;
{$ENDIF}
-
- {$IFDEF VER140} // Delphi 6
+ {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
procedure InitAtomStrings;
begin
- InitAtomStrings_D5_D6_D7;
+ InitAtomStrings_D5_D6_D7_D9;
end;
{$ENDIF}
-
- {$IFDEF VER150} // Delphi 7
+ {$IFDEF DELPHI_7}
procedure InitAtomStrings;
begin
- InitAtomStrings_D5_D6_D7;
+ InitAtomStrings_D5_D6_D7_D9;
end;
{$ENDIF}
+ {$IFDEF DELPHI_9}
+ procedure InitAtomStrings;
+ begin
+ InitAtomStrings_D5_D6_D7_D9;
+ end;
+ {$ENDIF}
begin
InitAtomStrings;
- WindowAtom := GlobalAddAtom(PAnsiChar(WindowAtomString));
- ControlAtom := GlobalAddAtom(PAnsiChar(ControlAtomString));
+ WindowAtom := WinCheckH(GlobalAddAtom(PAnsiChar(WindowAtomString)));
+ ControlAtom := WinCheckH(GlobalAddAtom(PAnsiChar(ControlAtomString)));
end;
-procedure DoneControls;
-begin
- GlobalDeleteAtom(ControlAtom);
- ControlAtomString := '';
- GlobalDeleteAtom(WindowAtom);
- WindowAtomString := '';
-end;
-
initialization
WideCaptionHolders := TComponentList.Create(True);
PendingRecreateWndTrapList := TComponentList.Create(False);
InitControls;
finalization
+ GlobalDeleteAtom(ControlAtom);
+ GlobalDeleteAtom(WindowAtom);
WideCaptionHolders.Free;
PendingRecreateWndTrapList.Free;
- DoneControls;
+ Finalized := True;
end.
Modified: trunk/TntUnicodeControls/TntExtActns.pas
===================================================================
--- trunk/TntUnicodeControls/TntExtActns.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntExtActns.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,8 +1,22 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntExtActns;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, ActnList, TntActnList, TntStdActns, ExtActns;
+uses
+ Classes, ActnList, TntActnList, TntStdActns, ExtActns;
type
{TNT-WARN TCustomFileRun}
@@ -423,7 +437,8 @@
implementation
-uses TntWideStrPropHelper;
+uses
+ TntClasses;
{TNT-IGNORE-UNIT}
@@ -466,7 +481,7 @@
end;
// TBrowseURL
if (Action is TBrowseURL) and (Source is TBrowseURL) then begin
- {$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
TBrowseURL(Action).BeforeBrowse := TBrowseURL(Source).BeforeBrowse;
TBrowseURL(Action).AfterBrowse := TBrowseURL(Source).AfterBrowse;
{$ENDIF}
@@ -474,7 +489,7 @@
// TDownloadURL
if (Action is TDownloadURL) and (Source is TDownloadURL) then begin
TDownloadURL(Action).FileName := TDownloadURL(Source).FileName;
- {$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
TDownloadURL(Action).BeforeDownload := TDownloadURL(Source).BeforeDownload;
TDownloadURL(Action).AfterDownload := TDownloadURL(Source).AfterDownload;
{$ENDIF}
@@ -509,7 +524,7 @@
procedure TTntCustomFileRun.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomFileRun.GetCaption: WideString;
@@ -543,7 +558,7 @@
procedure TTntFileRun.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFileRun.GetCaption: WideString;
@@ -577,7 +592,7 @@
procedure TTntRichEditAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditAction.GetCaption: WideString;
@@ -611,7 +626,7 @@
procedure TTntRichEditBold.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditBold.GetCaption: WideString;
@@ -645,7 +660,7 @@
procedure TTntRichEditItalic.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditItalic.GetCaption: WideString;
@@ -679,7 +694,7 @@
procedure TTntRichEditUnderline.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditUnderline.GetCaption: WideString;
@@ -713,7 +728,7 @@
procedure TTntRichEditStrikeOut.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditStrikeOut.GetCaption: WideString;
@@ -747,7 +762,7 @@
procedure TTntRichEditBullets.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditBullets.GetCaption: WideString;
@@ -781,7 +796,7 @@
procedure TTntRichEditAlignLeft.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditAlignLeft.GetCaption: WideString;
@@ -815,7 +830,7 @@
procedure TTntRichEditAlignRight.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditAlignRight.GetCaption: WideString;
@@ -849,7 +864,7 @@
procedure TTntRichEditAlignCenter.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntRichEditAlignCenter.GetCaption: WideString;
@@ -883,7 +898,7 @@
procedure TTntTabAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntTabAction.GetCaption: WideString;
@@ -917,7 +932,7 @@
procedure TTntPreviousTab.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntPreviousTab.GetCaption: WideString;
@@ -951,7 +966,7 @@
procedure TTntNextTab.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntNextTab.GetCaption: WideString;
@@ -985,7 +1000,7 @@
procedure TTntOpenPicture.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntOpenPicture.GetCaption: WideString;
@@ -1019,7 +1034,7 @@
procedure TTntSavePicture.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSavePicture.GetCaption: WideString;
@@ -1053,7 +1068,7 @@
procedure TTntURLAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntURLAction.GetCaption: WideString;
@@ -1087,7 +1102,7 @@
procedure TTntBrowseURL.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntBrowseURL.GetCaption: WideString;
@@ -1121,7 +1136,7 @@
procedure TTntDownLoadURL.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntDownLoadURL.GetCaption: WideString;
@@ -1155,7 +1170,7 @@
procedure TTntSendMail.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSendMail.GetCaption: WideString;
@@ -1189,7 +1204,7 @@
procedure TTntListControlAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntListControlAction.GetCaption: WideString;
@@ -1223,7 +1238,7 @@
procedure TTntListControlCopySelection.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntListControlCopySelection.GetCaption: WideString;
@@ -1257,7 +1272,7 @@
procedure TTntListControlDeleteSelection.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntListControlDeleteSelection.GetCaption: WideString;
@@ -1291,7 +1306,7 @@
procedure TTntListControlSelectAll.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntListControlSelectAll.GetCaption: WideString;
@@ -1325,7 +1340,7 @@
procedure TTntListControlClearSelection.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntListControlClearSelection.GetCaption: WideString;
@@ -1359,7 +1374,7 @@
procedure TTntListControlMoveSelection.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntListControlMoveSelection.GetCaption: WideString;
Modified: trunk/TntUnicodeControls/TntExtCtrls.pas
===================================================================
--- trunk/TntUnicodeControls/TntExtCtrls.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntExtCtrls.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,8 +1,22 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntExtCtrls;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, Messages, Controls, ExtCtrls, TntControls;
+uses
+ Classes, Messages, Controls, ExtCtrls, TntClasses, TntControls, TntStdCtrls, TntGraphics;
type
{TNT-WARN TShape}
@@ -42,12 +56,17 @@
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
+ function GetPicture: TTntPicture;
+ procedure SetPicture(const Value: TTntPicture);
protected
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ property Picture: TTntPicture read GetPicture write SetPicture;
end;
{TNT-WARN TBevel}
@@ -114,9 +133,9 @@
property Font;
property Locked;
property ParentBiDiMode;
-{$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
property ParentBackground;
-{$ENDIF}
+ {$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
@@ -180,16 +199,16 @@
property BevelKind;
property BevelWidth;
property BorderWidth;
- property Color {$IFDEF VER150} nodefault {$ENDIF};
+ property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
-{$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
property ParentBackground default True;
-{$ENDIF}
+ {$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
@@ -230,17 +249,112 @@
property OnUnDock;
end;
+{TNT-WARN TCustomRadioGroup}
+ TTntCustomRadioGroup = class(TTntCustomGroupBox)
+ private
+ FButtons: TList;
+ FItems: TTntStrings;
+ FItemIndex: Integer;
+ FColumns: Integer;
+ FReading: Boolean;
+ FUpdating: Boolean;
+ function GetButtons(Index: Integer): TTntRadioButton;
+ procedure ArrangeButtons;
+ procedure ButtonClick(Sender: TObject);
+ procedure ItemsChange(Sender: TObject);
+ procedure SetButtonCount(Value: Integer);
+ procedure SetColumns(Value: Integer);
+ procedure SetItemIndex(Value: Integer);
+ procedure SetItems(Value: TTntStrings);
+ procedure UpdateButtons;
+ procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
+ procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
+ procedure WMSize(var Message: TWMSize); message WM_SIZE;
+ protected
+ procedure Loaded; override;
+ procedure ReadState(Reader: TReader); override;
+ function CanModify: Boolean; virtual;
+ procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+ property Columns: Integer read FColumns write SetColumns default 1;
+ property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
+ property Items: TTntStrings read FItems write SetItems;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure FlipChildren(AllLevels: Boolean); override;
+ property Buttons[Index: Integer]: TTntRadioButton read GetButtons;
+ end;
+
+{TNT-WARN TRadioGroup}
+ TTntRadioGroup = class(TTntCustomRadioGroup)
+ published
+ property Align;
+ property Anchors;
+ property BiDiMode;
+ property Caption;
+ property Color;
+ property Columns;
+ property Ctl3D;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property ItemIndex;
+ property Items;
+ property Constraints;
+ property ParentBiDiMode;
+ {$IFDEF COMPILER_7_UP}
+ property ParentBackground default True;
+ {$ENDIF}
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Visible;
+ property OnClick;
+ property OnContextPopup;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+{TNT-WARN TSplitter}
+ TTntSplitter = class(TSplitter{TNT-ALLOW TSplitter})
+ private
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
implementation
-uses Windows, TntWideStrPropHelper, TntClasses, Graphics, {$IFDEF VER150} Themes, {$ENDIF}
- TntGraphics, TntActnList;
+uses
+ Windows, Graphics, Forms, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
+ TntSysUtils, TntWindows, TntActnList;
{ TTntShape }
procedure TTntShape.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntShape.IsHintStored: Boolean;
@@ -280,7 +394,7 @@
procedure TTntPaintBox.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntPaintBox.IsHintStored: Boolean;
@@ -315,12 +429,60 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
+type
+{$IFDEF COMPILER_5}
+ THackImage = class(TGraphicControl)
+ protected
+ FPicture: TPicture{TNT-ALLOW TPicture};
+ end;
+{$ENDIF}
+{$IFDEF COMPILER_6}
+ THackImage = class(TGraphicControl)
+ protected
+ FPicture: TPicture{TNT-ALLOW TPicture};
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_7}
+ THackImage = class(TGraphicControl)
+ protected
+ FPicture: TPicture{TNT-ALLOW TPicture};
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_9}
+ THackImage = class(TGraphicControl)
+ private
+ FPicture: TPicture{TNT-ALLOW TPicture};
+ end;
+{$ENDIF}
+
{ TTntImage }
+constructor TTntImage.Create(AOwner: TComponent);
+var
+ OldPicture: TPicture{TNT-ALLOW TPicture};
+begin
+ inherited;
+ OldPicture := THackImage(Self).FPicture;
+ THackImage(Self).FPicture := TTntPicture.Create;
+ Picture.OnChange := OldPicture.OnChange;
+ Picture.OnProgress := OldPicture.OnProgress;
+ OldPicture.Free;
+end;
+
+function TTntImage.GetPicture: TTntPicture;
+begin
+ Result := inherited Picture as TTntPicture;
+end;
+
+procedure TTntImage.SetPicture(const Value: TTntPicture);
+begin
+ inherited Picture := Value;
+end;
+
procedure TTntImage.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntImage.IsHintStored: Boolean;
@@ -360,7 +522,7 @@
procedure TTntBevel.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntBevel.IsHintStored: Boolean;
@@ -405,7 +567,7 @@
procedure TTntCustomPanel.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomPanel.IsCaptionStored: Boolean;
@@ -450,8 +612,8 @@
AdjustColors(BevelOuter);
Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
end;
- {$IFDEF VER150}
- if ThemeServices.ThemesEnabled and ParentBackground then
+ {$IFDEF THEME_7_UP}
+ if ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} and ParentBackground {$ENDIF} then
InflateRect(Rect, -BorderWidth, -BorderWidth)
else
{$ENDIF}
@@ -465,8 +627,8 @@
end;
with Canvas do
begin
- {$IFDEF VER150}
- if not ThemeServices.ThemesEnabled or not ParentBackground then
+ {$IFDEF THEME_7_UP}
+ if not ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} or not ParentBackground {$ENDIF} then
{$ENDIF}
begin
Brush.Color := Color;
@@ -523,7 +685,7 @@
procedure TTntCustomControlBar.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomControlBar.IsHintStored: Boolean;
@@ -552,4 +714,304 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
+{ TTntGroupButton }
+
+type
+ TTntGroupButton = class(TTntRadioButton)
+ private
+ FInClick: Boolean;
+ procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
+ protected
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
+ public
+ constructor InternalCreate(RadioGroup: TTntCustomRadioGroup);
+ destructor Destroy; override;
+ end;
+
+constructor TTntGroupButton.InternalCreate(RadioGroup: TTntCustomRadioGroup);
+begin
+ inherited Create(RadioGroup);
+ RadioGroup.FButtons.Add(Self);
+ Visible := False;
+ Enabled := RadioGroup.Enabled;
+ ParentShowHint := False;
+ OnClick := RadioGroup.ButtonClick;
+ Parent := RadioGroup;
+end;
+
+destructor TTntGroupButton.Destroy;
+begin
+ TTntCustomRadioGroup(Owner).FButtons.Remove(Self);
+ inherited Destroy;
+end;
+
+procedure TTntGroupButton.CNCommand(var Message: TWMCommand);
+begin
+ if not FInClick then
+ begin
+ FInClick := True;
+ try
+ if ((Message.NotifyCode = BN_CLICKED) or
+ (Message.NotifyCode = BN_DOUBLECLICKED)) and
+ TTntCustomRadioGroup(Parent).CanModify then
+ inherited;
+ except
+ Application.HandleException(Self);
+ end;
+ FInClick := False;
+ end;
+end;
+
+procedure TTntGroupButton.KeyPress(var Key: Char{TNT-ALLOW Char});
+begin
+ inherited KeyPress(Key);
+ TTntCustomRadioGroup(Parent).KeyPress(Key);
+ if (Key = #8) or (Key = ' ') then
+ begin
+ if not TTntCustomRadioGroup(Parent).CanModify then Key := #0;
+ end;
+end;
+
+procedure TTntGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+ TTntCustomRadioGroup(Parent).KeyDown(Key, Shift);
+end;
+
+{ TTntCustomRadioGroup }
+
+constructor TTntCustomRadioGroup.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ControlStyle := [csSetCaption, csDoubleClicks {$IFDEF COMPILER_7_UP}, csParentBackground {$ENDIF}];
+ FButtons := TList.Create;
+ FItems := TTntStringList.Create;
+ TTntStringList(FItems).OnChange := ItemsChange;
+ FItemIndex := -1;
+ FColumns := 1;
+end;
+
+destructor TTntCustomRadioGroup.Destroy;
+begin
+ SetButtonCount(0);
+ TTntStringList(FItems).OnChange := nil;
+ FItems.Free;
+ FButtons.Free;
+ inherited Destroy;
+end;
+
+procedure TTntCustomRadioGroup.FlipChildren(AllLevels: Boolean);
+begin
+ { The radio buttons are flipped using BiDiMode }
+end;
+
+procedure TTntCustomRadioGroup.ArrangeButtons;
+var
+ ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
+ DC: HDC;
+ SaveFont: HFont;
+ Metrics: TTextMetric;
+ DeferHandle: THandle;
+ ALeft: Integer;
+begin
+ if (FButtons.Count <> 0) and not FReading then
+ begin
+ DC := GetDC(0);
+ SaveFont := SelectObject(DC, Font.Handle);
+ GetTextMetrics(DC, Metrics);
+ SelectObject(DC, SaveFont);
+ ReleaseDC(0, DC);
+ ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
+ ButtonWidth := (Width - 10) div FColumns;
+ I := Height - Metrics.tmHeight - 5;
+ ButtonHeight := I div ButtonsPerCol;
+ TopMargin := Metrics.tmHeight + 1 + (I mod ButtonsPerCol) div 2;
+ DeferHandle := BeginDeferWindowPos(FButtons.Count);
+ try
+ for I := 0 to FButtons.Count - 1 do
+ with TTntGroupButton(FButtons[I]) do
+ begin
+ BiDiMode := Self.BiDiMode;
+ ALeft := (I div ButtonsPerCol) * ButtonWidth + 8;
+ if UseRightToLeftAlignment then
+ ALeft := Self.ClientWidth - ALeft - ButtonWidth;
+ DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
+ ALeft,
+ (I mod ButtonsPerCol) * ButtonHeight + TopMargin,
+ ButtonWidth, ButtonHeight,
+ SWP_NOZORDER or SWP_NOACTIVATE);
+ Visible := True;
+ end;
+ finally
+ EndDeferWindowPos(DeferHandle);
+ end;
+ end;
+end;
+
+procedure TTntCustomRadioGroup.ButtonClick(Sender: TObject);
+begin
+ if not FUpdating then
+ begin
+ FItemIndex := FButtons.IndexOf(Sender);
+ Changed;
+ Click;
+ end;
+end;
+
+procedure TTntCustomRadioGroup.ItemsChange(Sender: TObject);
+begin
+ if not FReading then
+ begin
+ if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
+ UpdateButtons;
+ end;
+end;
+
+procedure TTntCustomRadioGroup.Loaded;
+begin
+ inherited Loaded;
+ ArrangeButtons;
+end;
+
+procedure TTntCustomRadioGroup.ReadState(Reader: TReader);
+begin
+ FReading := True;
+ inherited ReadState(Reader);
+ FReading := False;
+ UpdateButtons;
+end;
+
+procedure TTntCustomRadioGroup.SetButtonCount(Value: Integer);
+begin
+ while FButtons.Count < Value do TTntGroupButton.InternalCreate(Self);
+ while FButtons.Count > Value do TTntGroupButton(FButtons.Last).Free;
+end;
+
+procedure TTntCustomRadioGroup.SetColumns(Value: Integer);
+begin
+ if Value < 1 then Value := 1;
+ if Value > 16 then Value := 16;
+ if FColumns <> Value then
+ begin
+ FColumns := Value;
+ ArrangeButtons;
+ Invalidate;
+ end;
+end;
+
+procedure TTntCustomRadioGroup.SetItemIndex(Value: Integer);
+begin
+ if FReading then FItemIndex := Value else
+ begin
+ if Value < -1 then Value := -1;
+ if Value >= FButtons.Count then Value := FButtons.Count - 1;
+ if FItemIndex <> Value then
+ begin
+ if FItemIndex >= 0 then
+ TTntGroupButton(FButtons[FItemIndex]).Checked := False;
+ FItemIndex := Value;
+ if FItemIndex >= 0 then
+ TTntGroupButton(FButtons[FItemIndex]).Checked := True;
+ end;
+ end;
+end;
+
+procedure TTntCustomRadioGroup.SetItems(Value: TTntStrings);
+begin
+ FItems.Assign(Value);
+end;
+
+procedure TTntCustomRadioGroup.UpdateButtons;
+var
+ I: Integer;
+begin
+ SetButtonCount(FItems.Count);
+ for I := 0 to FButtons.Count - 1 do
+ TTntGroupButton(FButtons[I]).Caption := FItems[I];
+ if FItemIndex >= 0 then
+ begin
+ FUpdating := True;
+ TTntGroupButton(FButtons[FItemIndex]).Checked := True;
+ FUpdating := False;
+ end;
+ ArrangeButtons;
+ Invalidate;
+end;
+
+procedure TTntCustomRadioGroup.CMEnabledChanged(var Message: TMessage);
+var
+ I: Integer;
+begin
+ inherited;
+ for I := 0 to FButtons.Count - 1 do
+ TTntGroupButton(FButtons[I]).Enabled := Enabled;
+end;
+
+procedure TTntCustomRadioGroup.CMFontChanged(var Message: TMessage);
+begin
+ inherited;
+ ArrangeButtons;
+end;
+
+procedure TTntCustomRadioGroup.WMSize(var Message: TWMSize);
+begin
+ inherited;
+ ArrangeButtons;
+end;
+
+function TTntCustomRadioGroup.CanModify: Boolean;
+begin
+ Result := True;
+end;
+
+procedure TTntCustomRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
+begin
+end;
+
+function TTntCustomRadioGroup.GetButtons(Index: Integer): TTntRadioButton;
+begin
+ Result := TTntRadioButton(FButtons[Index]);
+end;
+
+{ TTntSplitter }
+
+procedure TTntSplitter.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntSplitter.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self)
+end;
+
+function TTntSplitter.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntSplitter.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntSplitter.CMHintShow(var Message: TMessage);
+begin
+ ProcessCMHintShowMsg(Message);
+ inherited;
+end;
+
+procedure TTntSplitter.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntSplitter.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
end.
Modified: trunk/TntUnicodeControls/TntForms.pas
===================================================================
--- trunk/TntUnicodeControls/TntForms.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntForms.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,21 +1,20 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntForms;
+{$INCLUDE TntCompilers.inc}
+
interface
-{$IFNDEF VER130}
-{$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! }
-{$ENDIF}
-
uses
Classes, TntClasses, Windows, Messages, Controls, Forms, TntControls;
@@ -23,9 +22,11 @@
{TNT-WARN TScrollBox}
TTntScrollBox = class(TScrollBox{TNT-ALLOW TScrollBox})
private
+ FWMSizeCallCount: Integer;
function IsHintStored: Boolean;
function GetHint: WideString;
procedure SetHint(const Value: WideString);
+ procedure WMSize(var Message: TWMSize); message WM_SIZE;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
@@ -67,7 +68,7 @@
property Color nodefault;
property Ctl3D;
property Font;
-{$IFDEF VER150}
+{$IFDEF COMPILER_7_UP}
property ParentBackground default True;
{$ENDIF}
property ParentBiDiMode;
@@ -115,8 +116,13 @@
procedure SetHint(const Value: WideString);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
+ procedure WMMenuSelect(var Message: TWMMenuSelect); message WM_MENUSELECT;
+ procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
+ procedure WMWindowPosChanging(var Message: TMessage); message WM_WINDOWPOSCHANGING;
protected
+ procedure UpdateActions; override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DestroyWindowHandle; override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
@@ -128,6 +134,34 @@
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
+ TTntApplication = class(TComponent)
+ private
+ FMainFormChecked: Boolean;
+ FHint: WideString;
+ FTntAppIdleEventControl: TControl;
+ FSettingChangeTime: Cardinal;
+ FTitle: WideString;
+ function GetHint: WideString;
+ procedure SetAnsiAppHint(const Value: AnsiString);
+ procedure SetHint(const Value: WideString);
+ function GetExeName: WideString;
+ function IsDlgMsg(var Msg: TMsg): Boolean;
+ procedure DoIdle;
+ function GetTitle: WideString;
+ procedure SetTitle(const Value: WideString);
+ procedure SetAnsiApplicationTitle(const Value: AnsiString);
+ protected
+ function WndProc(var Message: TMessage): Boolean;
+ function ProcessMessage(var Msg: TMsg): Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Hint: WideString read GetHint write SetHint;
+ property ExeName: WideString read GetExeName;
+ property SettingChangeTime: Cardinal read FSettingChangeTime;
+ property Title: WideString read GetTitle write SetTitle;
+ end;
+
{TNT-WARN IsAccel}
function IsWideCharAccel(CharCode: Word; const Caption: WideString): Boolean;
@@ -139,32 +173,23 @@
procedure ConstructBaseClassForm(Self: TTntForm{TNT-ALLOW TTntForm}; FormClass: TCustomFormClass; AOwner: TComponent);
+var
+ TntApplication: TTntApplication;
+
+procedure InitTntEnvironment;
+
implementation
-uses SysUtils, Consts, {$IFNDEF VER130} RTLConsts, {$ENDIF} TntMenus, TntWideStrPropHelper,
- {$IFDEF JCL} JclUnicode, {$ELSE} Unicode, {$ENDIF} TntActnList;
+uses
+ SysUtils, Consts, {$IFDEF COMPILER_6_UP} RTLConsts, {$ENDIF} Menus, FlatSB, StdActns,
+ Graphics, TntSystem, TntSysUtils, TntWindows, TntMenus, TntActnList, TntStdActns;
-{$IFDEF VER130}
-const
- WS_EX_LAYERED = $00080000;
-{$ENDIF}
-
function IsWideCharAccel(CharCode: Word; const Caption: WideString): Boolean;
var
W: WideChar;
- W1, W2: WideString;
begin
- if CharCode <= Word(High(AnsiChar)) then
- W := KeyUnicode(AnsiChar(CharCode))
- else
- W := WideChar(CharCode);
-
- W1 := W;
- W2 := WideGetHotKey(Caption);
- if Win32PlatformIsUnicode then
- Result := (2 = CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PWideChar(W1), Length(W1), PWideChar(W2), Length(W2)))
- else
- Result := (CompareText{TNT-ALLOW CompareText}(W1, W2) = 0);
+ W := KeyUnicode(CharCode);
+ Result := WideSameText(W, WideGetHotKey(Caption));
end;
procedure ConstructBaseClassForm(Self: TTntForm{TNT-ALLOW TTntForm}; FormClass: TCustomFormClass; AOwner: TComponent);
@@ -200,7 +225,7 @@
procedure TTntScrollBox.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntScrollBox.IsHintStored: Boolean;
@@ -229,6 +254,17 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
+procedure TTntScrollBox.WMSize(var Message: TWMSize);
+begin
+ Inc(FWMSizeCallCount);
+ try
+ if FWMSizeCallCount < 32 then { Infinite recursion was encountered on Win 9x. }
+ inherited;
+ finally
+ Dec(FWMSizeCallCount);
+ end;
+end;
+
{ TTntCustomFrame }
procedure TTntCustomFrame.CreateWindowHandle(const Params: TCreateParams);
@@ -239,7 +275,7 @@
procedure TTntCustomFrame.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomFrame.IsHintStored: Boolean;
@@ -291,7 +327,7 @@
DefWndProc := @DefMDIChildProcW;
WindowHandle := CreateMDIWindowW(PWideChar(WideWinClassName),
nil, Params.style, Params.X, Params.Y, Params.Width, Params.Height,
- Application.MainForm.ClientHandle, Params.WindowClass.hInstance, Longint(Params.Param));
+ Application.MainForm.ClientHandle, hInstance, Longint(Params.Param));
if WindowHandle = 0 then
RaiseLastOSError;
SubClassUnicodeControl(Self, Params.Caption);
@@ -303,19 +339,30 @@
CreateUnicodeHandle(Self, NewParams, '');
Exclude(FFormState, fsCreatedMDIChild);
end;
-{$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
if AlphaBlend then begin
// toggle AlphaBlend to force update
AlphaBlend := False;
AlphaBlend := True;
+ end else if TransparentColor then begin
+ // toggle TransparentColor to force update
+ TransparentColor := False;
+ TransparentColor := True;
end;
-{$ENDIF}
+ {$ENDIF}
end;
+procedure TTntForm{TNT-ALLOW TTntForm}.DestroyWindowHandle;
+begin
+ if Win32PlatformIsUnicode then
+ UninitializeFlatSB(Handle); { Bug in VCL: Without this there might be a resource leak. }
+ inherited;
+end;
+
procedure TTntForm{TNT-ALLOW TTntForm}.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntForm{TNT-ALLOW TTntForm}.DefaultHandler(var Message);
@@ -372,6 +419,285 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
+procedure TTntForm{TNT-ALLOW TTntForm}.WMMenuSelect(var Message: TWMMenuSelect);
+var
+ MenuItem: TMenuItem{TNT-ALLOW TMenuItem};
+ ID: Integer;
+ FindKind: TFindItemKind;
+begin
+ if Menu <> nil then
+ with Message do
+ begin
+ MenuItem := nil;
+ if (MenuFlag <> $FFFF) or (IDItem <> 0) then
+ begin
+ FindKind := fkCommand;
+ ID := IDItem;
+ if MenuFlag and MF_POPUP <> 0 then
+ begin
+ FindKind := fkHandle;
+ ID := Integer(GetSubMenu(Menu, ID));
+ end;
+ MenuItem := Self.Menu.FindItem(ID, FindKind);
+ end;
+ if MenuItem <> nil then
+ TntApplication.Hint := WideGetLongHint(WideGetMenuItemHint(MenuItem))
+ else
+ TntApplication.Hint := '';
+ end;
+end;
+
+procedure TTntForm{TNT-ALLOW TTntForm}.UpdateActions;
+begin
+ inherited;
+ TntApplication.DoIdle;
+end;
+
+procedure TTntForm{TNT-ALLOW TTntForm}.CMBiDiModeChanged(var Message: TMessage);
+var
+ Loop: Integer;
+begin
+ inherited;
+ for Loop := 0 to ComponentCount - 1 do
+ if Components[Loop] is TMenu then
+ FixMenuBiDiProblem(TMenu(Components[Loop]));
+end;
+
+procedure TTntForm{TNT-ALLOW TTntForm}.WMWindowPosChanging(var Message: TMessage);
+begin
+ inherited;
+ // This message *sometimes* means that the Menu.BiDiMode changed.
+ FixMenuBiDiProblem(Menu);
+end;
+
+{ TTntApplication }
+
+constructor TTntApplication.Create(AOwner: TComponent);
+begin
+ inherited;
+ Application.HookMainWindow(WndProc);
+ FSettingChangeTime := GetTickCount;
+ TntSysUtils._SettingChangeTime := GetTickCount;
+end;
+
+destructor TTntApplication.Destroy;
+begin
+ FreeAndNil(FTntAppIdleEventControl);
+ Application.UnhookMainWindow(WndProc);
+ inherited;
+end;
+
+function TTntApplication.GetHint: WideString;
+begin
+ Result := GetSyncedWideString(FHint, Application.Hint)
+end;
+
+procedure TTntApplication.SetAnsiAppHint(const Value: AnsiString);
+begin
+ Application.Hint := Value;
+end;
+
+procedure TTntApplication.SetHint(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FHint, Application.Hint, SetAnsiAppHint);
+end;
+
+function TTntApplication.GetExeName: WideString;
+begin
+ Result := WideParamStr(0);
+end;
+
+function TTntApplication.GetTitle: WideString;
+begin
+ if (Application.Handle <> 0) and Win32PlatformIsUnicode then begin
+ SetLength(Result, DefWindowProcW(Application.Handle, WM_GETTEXTLENGTH, 0, 0) + 1);
+ DefWindowProcW(Application.Handle, WM_GETTEXT, Length(Result), Integer(PWideChar(Result)));
+ SetLength(Result, Length(Result) - 1);
+ end else
+ Result := GetSyncedWideString(FTitle, Application.Title);
+end;
+
+procedure TTntApplication.SetAnsiApplicationTitle(const Value: AnsiString);
+begin
+ Application.Title := Value;
+end;
+
+procedure TTntApplication.SetTitle(const Value: WideString);
+begin
+ if (Application.Handle <> 0) and Win32PlatformIsUnicode then begin
+ if (GetTitle <> Value) or (FTitle <> '') then begin
+ DefWindowProcW(Application.Handle, WM_SETTEXT, 0, lParam(PWideChar(WideString(Value))));
+ FTitle := '';
+ end
+ end else
+ SetSyncedWideString(Value, FTitle, Application.Title, SetAnsiApplicationTitle);
+end;
+
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
+type
+ THackApplication = class(TComponent)
+ protected
+ FxxxxxxxxxHandle: HWnd;
+ FxxxxxxxxxBiDiMode: TBiDiMode;
+ FxxxxxxxxxBiDiKeyboard: AnsiString;
+ FxxxxxxxxxNonBiDiKeyboard: AnsiString;
+ FxxxxxxxxxObjectInstance: Pointer;
+ FxxxxxxxxxMainForm: TForm{TNT-ALLOW TForm};
+ FMouseControl: TControl;
+ end;
+{$ENDIF}
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+type
+ THackApplication = class(TComponent)
+ protected
+ FxxxxxxxxxHandle: HWnd;
+ FxxxxxxxxxBiDiMode: TBiDiMode;
+ FxxxxxxxxxBiDiKeyboard: AnsiString;
+ FxxxxxxxxxNonBiDiKeyboard: AnsiString;
+ FxxxxxxxxxObjectInstance: Pointer;
+ FxxxxxxxxxMainForm: TForm{TNT-ALLOW TForm};
+ FMouseControl: TControl;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_7}
+type
+ THackApplication = class(TComponent)
+ protected
+ FxxxxxxxxxHandle: HWnd;
+ FxxxxxxxxxBiDiMode: TBiDiMode;
+ FxxxxxxxxxBiDiKeyboard: AnsiString;
+ FxxxxxxxxxNonBiDiKeyboard: AnsiString;
+ FxxxxxxxxxObjectInstance: Pointer;
+ FxxxxxxxxxMainForm: TForm{TNT-ALLOW TForm};
+ FMouseControl: TControl;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_9}
+type
+ THackApplication = class(TComponent)
+ protected
+ FxxxxxxxxxHandle: HWnd;
+ FxxxxxxxxxBiDiMode: TBiDiMode;
+ FxxxxxxxxxBiDiKeyboard: AnsiString;
+ FxxxxxxxxxNonBiDiKeyboard: AnsiString;
+ FxxxxxxxxxObjectInstance: Pointer;
+ FxxxxxxxxxMainForm: TForm{TNT-ALLOW TForm};
+ FMouseControl: TControl;
+ end;
+{$ENDIF}
+
+procedure TTntApplication.DoIdle;
+var
+ MouseControl: TControl;
+begin
+ MouseControl := THackApplication(Application).FMouseControl;
+ Hint := WideGetLongHint(WideGetHint(MouseControl));
+end;
+
+function TTntApplication.IsDlgMsg(var Msg: TMsg): Boolean;
+begin
+ Result := (Application.DialogHandle <> 0)
+ and (IsDialogMessage(Application.DialogHandle, Msg))
+end;
+
+type
+ TTntAppIdleEventControl = class(TControl)
+ protected
+ procedure OnIdle(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+constructor TTntAppIdleEventControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ ParentFont := False; { This allows Parent (Application) to be in another module. }
+ Parent := Application.MainForm;
+ Visible := True;
+ Action := TTntAction.Create(Self);
+ Action.OnExecute := OnIdle;
+ Action.OnUpdate := OnIdle;
+ TntApplication.FTntAppIdleEventControl := Self;
+end;
+
+destructor TTntAppIdleEventControl.Destroy;
+begin
+ if TntApplication <> nil then
+ TntApplication.FTntAppIdleEventControl := nil;
+ inherited;
+end;
+
+procedure TTntAppIdleEventControl.OnIdle(Sender: TObject);
+begin
+ TntApplication.DoIdle;
+end;
+
+function TTntApplication.ProcessMessage(var Msg: TMsg): Boolean;
+var
+ Handled: Boolean;
+begin
+ Result := False;
+ // Check Main Form
+ if (not FMainFormChecked) and (Application.MainForm <> nil) then begin
+ if not (Application.MainForm is TTntForm{TNT-ALLOW TTntForm}) then begin
+ // This control will help ensure that DoIdle is called
+ TTntAppIdleEventControl.Create(Application.MainForm);
+ end;
+ FMainFormChecked := True;
+ end;
+ // Check for Unicode char messages
+ if (Msg.message = WM_CHAR)
+ and (Msg.wParam > Integer(High(AnsiChar)))
+ and IsWindowUnicode(Msg.hwnd)
+ and ((not IsDlgMsg(Msg)) or IsWindowUnicode(Application.DialogHandle))
+ then begin
+ Result := True;
+ // more than 8-bit WM_CHAR destined for Unicode window
+ Handled := False;
+ if Assigned(Application.OnMessage) then
+ Application.OnMessage(Msg, Handled);
+ Application.CancelHint;
+ // dispatch msg if not a dialog message
+ if (not Handled) and (not IsDlgMsg(Msg)) then
+ DispatchMessageW(Msg);
+ end;
+end;
+
+function TTntApplication.WndProc(var Message: TMessage): Boolean;
+var
+ BasicAction: TBasicAction;
+begin
+ Result := False; { not handled }
+ if (Message.Msg = WM_SETTINGCHANGE) then begin
+ FSettingChangeTime := GetTickCount;
+ TntSysUtils._SettingChangeTime := FSettingChangeTime;
+ end;
+ if (Message.Msg = WM_CREATE)
+ and (FTitle <> '') then begin
+ SetTitle(FTitle);
+ FTitle := '';
+ end;
+ if (Message.Msg = CM_ACTIONEXECUTE) then begin
+ BasicAction := TBasicAction(Message.LParam);
+ if (BasicAction.ClassType = THintAction{TNT-ALLOW THintAction})
+ and (THintAction{TNT-ALLOW THintAction}(BasicAction).Hint = AnsiString(Hint))
+ then begin
+ Result := True;
+ Message.Result := 1;
+ with TTntHintAction.Create(Self) do
+ begin
+ Hint := Self.Hint;
+ try
+ Execute;
+ finally
+ Free;
+ end;
+ end;
+ end;
+ end;
+end;
+
//===========================================================================
// The NT GetMessage Hook is needed to support entering Unicode
// characters directly from the keyboard (bypassing the IME).
@@ -384,47 +710,39 @@
// 4. In an EDIT, enter single quote (US Keyboard). (You should see an upturned "e".)
//
var
- NTGetMessageHook: HHOOK = 0;
+ ManualPeekMessageWithRemove: Integer = 0;
-function IsDlgMsg(var Msg: TMsg): Boolean;
+procedure EnableManualPeekMessageWithRemove;
begin
- Result := (Application.DialogHandle <> 0)
- and (IsDialogMessage(Application.DialogHandle, Msg))
+ Inc(ManualPeekMessageWithRemove);
end;
+procedure DisableManualPeekMessageWithRemove;
+begin
+ if (ManualPeekMessageWithRemove > 0) then
+ Dec(ManualPeekMessageWithRemove);
+end;
+
var
- ManualPeekMessageWithRemove: Integer = 0;
+ NTGetMessageHook: HHOOK;
function GetMessageForNT(Code: Integer; wParam: Integer; lParam: Integer): LRESULT; stdcall;
var
ThisMsg: PMSG;
- Handled: Boolean;
begin
if (Code >= 0)
and (wParam = PM_REMOVE)
and (ManualPeekMessageWithRemove = 0) then
begin
ThisMsg := PMSG(lParam);
- if (ThisMsg.message = WM_CHAR)
- and (ThisMsg.wParam > Integer(High(AnsiChar)))
- and IsWindowUnicode(ThisMsg.hwnd) then
- begin
- // more than 8-bit WM_CHAR destined for Unicode window
- Handled := False;
- if Assigned(Application.OnMessage) then
- Application.OnMessage(ThisMsg^, Handled);
- Application.CancelHint;
- // dispatch msg if not a dialog message
- if (not Handled) and (not IsDlgMsg(ThisMsg^)) then
- DispatchMessageW(ThisMsg^);
- // clear for further processing
- ThisMsg.message := WM_NULL;
- end;
+ if (TntApplication <> nil)
+ and TntApplication.ProcessMessage(ThisMsg^) then
+ ThisMsg.message := WM_NULL; { clear for further processing }
end;
Result := CallNextHookEx(NTGetMessageHook, Code, wParam, lParam);
end;
-procedure CreateMessageHookForNT;
+procedure CreateGetMessageHookForNT;
begin
Assert(Win32Platform = VER_PLATFORM_WIN32_NT);
NTGetMessageHook := SetWindowsHookExW(WH_GETMESSAGE, GetMessageForNT, 0, GetCurrentThreadID);
@@ -432,23 +750,97 @@
RaiseLastOSError;
end;
-procedure EnableManualPeekMessageWithRemove;
+function UnhookIsKnownToFail: Boolean;
begin
- Inc(ManualPeekMessageWithRemove);
+ Result := (Pos('W3WP.', Tnt_WideUpperCase(WideExtractFileName(WideParamStr(0)))) = 1) // for IIS 6.0
+ or (Pos('DLLHOST.', Tnt_WideUpperCase(WideExtractFileName(WideParamStr(0)))) = 1) // for IIS 5.0
end;
-procedure DisableManualPeekMessageWithRemove;
+//---------------------------------------------------------------------------------------------
+// Tnt Environment Setup
+//---------------------------------------------------------------------------------------------
+
+procedure InitTntEnvironment;
+
+ function GetDefaultFont: WideString;
+
+ function RunningUnderIDE: Boolean;
+ begin
+ Result := ModuleIsPackage and
+ ( WideSameText(WideExtractFileName(WideGetModuleFileName(0)), 'delphi32.exe')
+ or WideSameText(WideExtractFileName(WideGetModuleFileName(0)), 'bcb.exe'));
+ end;
+
+ function GetProfileStr(const Section, Key, Default: AnsiString; MaxLen: Integer): AnsiString;
+ var
+ Len: Integer;
+ begin
+ SetLength(Result, MaxLen + 1);
+ Len := GetProfileString(PAnsiChar(Section), PAnsiChar(Key), PAnsiChar(Default),
+ PAnsiChar(Result), Length(Result));
+ SetLength(Result, Len);
+ end;
+
+ procedure SetProfileStr(const Section, Key, Value: AnsiString);
+ var
+ DummyResult: Cardinal;
+ begin
+ try
+ Win32Check(WriteProfileString(PAnsiChar(Section), PAnsiChar(Key), PAnsiChar(Value)));
+ if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
+ WriteProfileString(nil, nil, nil); {this flushes the WIN.INI cache}
+ SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, Integer(PAnsiChar(Section)),
+ SMTO_NORMAL, 250, DummyResult);
+ except
+ on E: Exception do begin
+ E.Message := 'Couldn''t create font substitutes.' + CRLF + E.Message;
+ Application.ShowException(E);
+ end;
+ end;
+ end;
+
+ var
+ ShellDlgFontName_1: WideString;
+ ShellDlgFontName_2: WideString;
+ begin
+ ShellDlgFontName_1 := GetProfileStr('FontSubstitutes', 'MS Shell Dlg', '', LF_FACESIZE);
+ if ShellDlgFontName_1 = '' then begin
+ ShellDlgFontName_1 := 'MS Sans Serif';
+ SetProfileStr('FontSubstitutes', 'MS Shell Dlg', ShellDlgFontName_1);
+ end;
+ ShellDlgFontName_2 := GetProfileStr('FontSubstitutes', 'MS Shell Dlg 2', '', LF_FACESIZE);
+ if ShellDlgFontName_2 = '' then begin
+ if Screen.Fonts.IndexOf('Tahoma') <> -1 then
+ ShellDlgFontName_2 := 'Tahoma'
+ else
+ ShellDlgFontName_2 := ShellDlgFontName_1;
+ SetProfileStr('FontSubstitutes', 'MS Shell Dlg 2', ShellDlgFontName_2);
+ end;
+ if RunningUnderIDE then begin
+ Result := 'MS Shell Dlg 2' {Delphi is running}
+ end else
+ Result := ShellDlgFontName_2;
+ end;
+
begin
- if (ManualPeekMessageWithRemove > 0) then
- Dec(ManualPeekMessageWithRemove);
+ // Tnt Environment Setup
+ InstallTntSystemUpdates;
+ DefFontData.Name := GetDefaultFont;
+ Forms.HintWindowClass := TntControls.TTntHintWindow;
end;
initialization
+ TntApplication := TTntApplication.Create(nil);
if Win32Platform = VER_PLATFORM_WIN32_NT then
- CreateMessageHookForNT;
+ CreateGetMessageHookForNT;
finalization
- if NTGetMessageHook <> 0 then
- Win32Check(UnhookWindowsHookEx(NTGetMessageHook));
+ if NTGetMessageHook <> 0 then begin
+ if UnhookIsKnownToFail then
+ UnhookWindowsHookEx(NTGetMessageHook) // no Win32Check!
+ else
+ Win32Check(UnhookWindowsHookEx(NTGetMessageHook));
+ end;
+ FreeAndNil(TntApplication);
end.
Modified: trunk/TntUnicodeControls/TntGraphics.pas
===================================================================
--- trunk/TntUnicodeControls/TntGraphics.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntGraphics.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,18 +1,22 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntGraphics;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Graphics, Windows;
+uses
+ Classes, Graphics, Windows;
{TNT-WARN TextRect}
procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
@@ -26,8 +30,19 @@
{TNT-WARN TextHeight}
function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;
+type
+{TNT-WARN TPicture}
+ TTntPicture = class(TPicture{TNT-ALLOW TPicture})
+ public
+ procedure LoadFromFile(const Filename: WideString);
+ procedure SaveToFile(const Filename: WideString);
+ end;
+
implementation
+uses
+ SysUtils, TntClasses, TntSysUtils;
+
type
TAccessCanvas = class(TCanvas);
@@ -87,4 +102,37 @@
Result := WideCanvasTextExtent(Canvas, Text).cY;
end;
+{ TTntPicture }
+
+procedure TTntPicture.LoadFromFile(const Filename: WideString);
+begin
+ if WideSameText(WideExtractFileExt(FileName), '.jpeg') then
+ inherited LoadFromFile(FileName) // the short name ends with ".JPE"!
+ else
+ inherited LoadFromFile(WideExtractShortPathName(Filename));
+end;
+
+procedure TTntPicture.SaveToFile(const Filename: WideString);
+var
+ TempFile: WideString;
+begin
+ if Graphic <> nil then begin
+ // create to temp file (ansi safe file name)
+ repeat
+ TempFile := WideExtractFilePath(Filename) + IntToStr(Random(MaxInt)) + WideExtractFileExt(Filename);
+ until not WideFileExists(TempFile);
+ CloseHandle(WideFileCreate(TempFile)); // make it a real file so that it has a temp
+ try
+ // save
+ Graphic.SaveToFile(WideExtractShortPathName(TempFile));
+ // rename
+ WideDeleteFile(Filename);
+ if not WideRenameFile(TempFile, FileName) then
+ RaiseLastOSError;
+ finally
+ WideDeleteFile(TempFile);
+ end;
+ end;
+end;
+
end.
Modified: trunk/TntUnicodeControls/TntGrids.pas
===================================================================
--- trunk/TntUnicodeControls/TntGrids.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntGrids.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,18 +1,22 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntGrids;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, TntClasses, Grids, Windows, Controls, Messages;
+uses
+ Classes, TntClasses, Grids, Windows, Controls, Messages;
type
{TNT-WARN TInplaceEdit}
@@ -31,10 +35,10 @@
TTntSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: WideString) of object;
{TNT-WARN TCustomDrawGrid}
-{$IFDEF VER130}
+{$IFDEF COMPILER_6_UP}
+ _TTntInternalCustomDrawGrid = class(TCustomDrawGrid{TNT-ALLOW TCustomDrawGrid})
+{$ELSE}
_TTntInternalCustomDrawGrid = class(TDrawGrid{TNT-ALLOW TDrawGrid})
-{$ELSE}
- _TTntInternalCustomDrawGrid = class(TCustomDrawGrid{TNT-ALLOW TCustomDrawGrid})
{$ENDIF}
private
FSettingEditText: Boolean;
@@ -137,12 +141,12 @@
TTntStringGrid = class;
{TNT-WARN TStringGridStrings}
- TTntStringGridStrings = class(TTntWideStrings)
+ TTntStringGridStrings = class(TTntStrings)
private
FIsCol: Boolean;
FColRowIndex: Integer;
FGrid: TTntStringGrid;
- function GetAnsiStrings: TStrings{TNT-ALLOW TStrings};
+ function GridAnsiStrings: TStrings{TNT-ALLOW TStrings};
protected
function Get(Index: Integer): WideString; override;
procedure Put(Index: Integer; const S: WideString); override;
@@ -180,11 +184,11 @@
procedure WMChar(var Msg: TWMChar); message WM_CHAR;
function GetCells(ACol, ARow: Integer): WideString;
procedure SetCells(ACol, ARow: Integer; const Value: WideString);
- function FindGridStrings(IsCol: Boolean; ListIndex: Integer): TTntWideStrings;
- function GetCols(Index: Integer): TTntWideStrings;
- function GetRows(Index: Integer): TTntWideStrings;
- procedure SetCols(Index: Integer; const Value: TTntWideStrings);
- procedure SetRows(Index: Integer; const Value: TTntWideStrings);
+ function FindGridStrings(const IsCol: Boolean; const ListIndex: Integer): TTntStrings;
+ function GetCols(Index: Integer): TTntStrings;
+ function GetRows(Index: Integer): TTntStrings;
+ procedure SetCols(Index: Integer; const Value: TTntStrings);
+ procedure SetRows(Index: Integer; const Value: TTntStrings);
protected
function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
@@ -201,8 +205,8 @@
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Cells[ACol, ARow: Integer]: WideString read GetCells write SetCells;
- property Cols[Index: Integer]: TTntWideStrings read GetCols write SetCols;
- property Rows[Index: Integer]: TTntWideStrings read GetRows write SetRows;
+ property Cols[Index: Integer]: TTntStrings read GetCols write SetCols;
+ property Rows[Index: Integer]: TTntStrings read GetRows write SetRows;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
property OnGetEditText: TTntGetEditEvent read FOnGetEditText write FOnGetEditText;
@@ -211,9 +215,31 @@
implementation
-uses SysUtils, TntGraphics, TntControls, TntStdCtrls, TntWideStrPropHelper,
- {$IFDEF JCL} JclUnicode, {$ELSE} Unicode, {$ENDIF} TntActnList;
+uses
+ SysUtils, TntSystem, TntGraphics, TntControls, TntStdCtrls, TntActnList, TntSysUtils;
+{ TBinaryCompareAnsiStringList }
+type
+ TBinaryCompareAnsiStringList = class(TStringList{TNT-ALLOW TStringList})
+ protected
+ {$IFDEF COMPILER_6_UP}
+ function CompareStrings(const S1, S2: string{TNT-ALLOW string}): Integer; override;
+ {$ENDIF}
+ end;
+
+{$IFDEF COMPILER_6_UP}
+function TBinaryCompareAnsiStringList.CompareStrings(const S1, S2: string{TNT-ALLOW string}): Integer;
+begin
+ // must compare strings via binary for speed
+ if S1 = S2 then
+ result := 0
+ else if S1 < S2 then
+ result := -1
+ else
+ result := 1;
+end;
+{$ENDIF}
+
{ TTntInplaceEdit }
procedure TTntInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
@@ -223,12 +249,18 @@
function TTntInplaceEdit.GetText: WideString;
begin
- Result := TntControl_GetText(Self);
+ if IsMasked then
+ Result := inherited Text
+ else
+ Result := TntControl_GetText(Self);
end;
procedure TTntInplaceEdit.SetText(const Value: WideString);
begin
- TntControl_SetText(Self, Value);
+ if IsMasked then
+ inherited Text := Value
+ else
+ TntControl_SetText(Self, Value);
end;
type TAccessCustomGrid = class(TCustomGrid);
@@ -277,7 +309,7 @@
procedure TTntCustomDrawGrid.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomDrawGrid.IsHintStored: Boolean;
@@ -357,20 +389,20 @@
for i := 0 to TStrings{TNT-ALLOW TStrings}(Source).Count - 1 do
UTF8Strings.AddObject(WideStringToUTF8(WideString(TStrings{TNT-ALLOW TStrings}(Source).Strings[i])),
TStrings{TNT-ALLOW TStrings}(Source).Objects[i]);
- GetAnsiStrings.Assign(UTF8Strings);
- end else if Source is TWideStrings then begin
- for i := 0 to TWideStrings(Source).Count - 1 do
- UTF8Strings.AddObject(WideStringToUTF8(TWideStrings(Source).Strings[i]),
- TWideStrings(Source).Objects[i]);
- GetAnsiStrings.Assign(UTF8Strings);
+ GridAnsiStrings.Assign(UTF8Strings);
+ end else if Source is TTntStrings then begin
+ for i := 0 to TTntStrings(Source).Count - 1 do
+ UTF8Strings.AddObject(WideStringToUTF8(TTntStrings(Source).Strings[i]),
+ TTntStrings(Source).Objects[i]);
+ GridAnsiStrings.Assign(UTF8Strings);
end else
- GetAnsiStrings.Assign(Source);
+ GridAnsiStrings.Assign(Source);
finally
UTF8Strings.Free;
end;
end;
-function TTntStringGridStrings.GetAnsiStrings: TStrings{TNT-ALLOW TStrings};
+function TTntStringGridStrings.GridAnsiStrings: TStrings{TNT-ALLOW TStrings};
begin
Assert(Assigned(FGrid));
if FIsCol then
@@ -381,54 +413,54 @@
procedure TTntStringGridStrings.Clear;
begin
- GetAnsiStrings.Clear;
+ GridAnsiStrings.Clear;
end;
procedure TTntStringGridStrings.Delete(Index: Integer);
begin
- GetAnsiStrings.Delete(Index);
+ GridAnsiStrings.Delete(Index);
end;
function TTntStringGridStrings.GetCount: Integer;
begin
- Result := GetAnsiStrings.Count;
+ Result := GridAnsiStrings.Count;
end;
function TTntStringGridStrings.Get(Index: Integer): WideString;
begin
- Result := UTF8ToWideString(GetAnsiStrings[Index]);
+ Result := UTF8ToWideString(GridAnsiStrings[Index]);
end;
procedure TTntStringGridStrings.Put(Index: Integer; const S: WideString);
begin
- GetAnsiStrings[Index] := WideStringToUTF8(S);
+ GridAnsiStrings[Index] := WideStringToUTF8(S);
end;
procedure TTntStringGridStrings.Insert(Index: Integer; const S: WideString);
begin
- GetAnsiStrings.Insert(Index, WideStringToUTF8(S));
+ GridAnsiStrings.Insert(Index, WideStringToUTF8(S));
end;
function TTntStringGridStrings.Add(const S: WideString): Integer;
begin
- Result := GetAnsiStrings.Add(WideStringToUTF8(S));
+ Result := GridAnsiStrings.Add(WideStringToUTF8(S));
end;
function TTntStringGridStrings.GetObject(Index: Integer): TObject;
begin
- Result := GetAnsiStrings.Objects[Index];
+ Result := GridAnsiStrings.Objects[Index];
end;
procedure TTntStringGridStrings.PutObject(Index: Integer; AObject: TObject);
begin
- GetAnsiStrings.Objects[Index] := AObject;
+ GridAnsiStrings.Objects[Index] := AObject;
end;
type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
procedure TTntStringGridStrings.SetUpdateState(Updating: Boolean);
begin
- TAccessStrings(GetAnsiStrings).SetUpdateState(Updating);
+ TAccessStrings(GridAnsiStrings).SetUpdateState(Updating);
end;
constructor TTntStringGridStrings.Create(AGrid: TTntStringGrid; AIndex: Integer);
@@ -459,10 +491,10 @@
constructor TTntStringGrid.Create(AOwner: TComponent);
begin
inherited;
- FCreatedRowStrings := TStringList{TNT-ALLOW TStringList}.Create;
+ FCreatedRowStrings := TBinaryCompareAnsiStringList.Create;
FCreatedRowStrings.Sorted := True;
FCreatedRowStrings.Duplicates := dupError;
- FCreatedColStrings := TStringList{TNT-ALLOW TStringList}.Create;
+ FCreatedColStrings := TBinaryCompareAnsiStringList.Create;
FCreatedColStrings.Sorted := True;
FCreatedColStrings.Duplicates := dupError;
end;
@@ -493,7 +525,7 @@
procedure TTntStringGrid.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntStringGrid.IsHintStored: Boolean;
@@ -517,11 +549,15 @@
end;
procedure TTntStringGrid.SetCells(ACol, ARow: Integer; const Value: WideString);
+var
+ UTF8Str: AnsiString;
begin
- inherited Cells[ACol, ARow] := WideStringToUTF8(Value);
+ UTF8Str := WideStringToUTF8(Value);
+ if inherited Cells[ACol, ARow] <> UTF8Str then
+ inherited Cells[ACol, ARow] := UTF8Str;
end;
-function TTntStringGrid.FindGridStrings(IsCol: Boolean; ListIndex: Integer): TTntWideStrings;
+function TTntStringGrid.FindGridStrings(const IsCol: Boolean; const ListIndex: Integer): TTntStrings;
var
idx: integer;
SrcStrings: TStrings{TNT-ALLOW TStrings};
@@ -534,7 +570,7 @@
Assert(Assigned(SrcStrings));
idx := SrcStrings.IndexOf(IntToStr(ListIndex));
if idx <> -1 then
- Result := SrcStrings.Objects[idx] as TTntWideStrings
+ Result := SrcStrings.Objects[idx] as TTntStrings
else begin
if IsCol then RCIndex := -ListIndex - 1 else RCIndex := ListIndex + 1;
Result := TTntStringGridStrings.Create(Self, RCIndex);
@@ -542,22 +578,22 @@
end;
end;
-function TTntStringGrid.GetCols(Index: Integer): TTntWideStrings;
+function TTntStringGrid.GetCols(Index: Integer): TTntStrings;
begin
Result := FindGridStrings(True, Index);
end;
-function TTntStringGrid.GetRows(Index: Integer): TTntWideStrings;
+function TTntStringGrid.GetRows(Index: Integer): TTntStrings;
begin
Result := FindGridStrings(False, Index);
end;
-procedure TTntStringGrid.SetCols(Index: Integer; const Value: TTntWideStrings);
+procedure TTntStringGrid.SetCols(Index: Integer; const Value: TTntStrings);
begin
FindGridStrings(True, Index).Assign(Value);
end;
-procedure TTntStringGrid.SetRows(Index: Integer; const Value: TTntWideStrings);
+procedure TTntStringGrid.SetRows(Index: Integer; const Value: TTntStrings);
begin
FindGridStrings(False, Index).Assign(Value);
end;
Modified: trunk/TntUnicodeControls/TntListActns.pas
===================================================================
--- trunk/TntUnicodeControls/TntListActns.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntListActns.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,8 +1,22 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntListActns;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, ActnList, TntActnList, ListActns;
+uses
+ Classes, ActnList, TntActnList, ListActns;
type
{TNT-WARN TCustomListAction}
@@ -55,7 +69,8 @@
implementation
-uses TntWideStrPropHelper;
+uses
+ TntClasses;
{TNT-IGNORE-UNIT}
@@ -98,7 +113,7 @@
procedure TTntCustomListAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomListAction.GetCaption: WideString;
@@ -132,7 +147,7 @@
procedure TTntStaticListAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntStaticListAction.GetCaption: WideString;
@@ -166,7 +181,7 @@
procedure TTntVirtualListAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntVirtualListAction.GetCaption: WideString;
Modified: trunk/TntUnicodeControls/TntMenus.pas
===================================================================
--- trunk/TntUnicodeControls/TntMenus.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntMenus.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,41 +1,47 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntMenus;
+{$INCLUDE TntCompilers.inc}
+
interface
-{$IFNDEF VER130}
-{$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! }
-{$ENDIF}
+uses
+ Windows, Classes, Menus, Graphics, Messages;
-uses Windows, Classes, TntClasses, Menus, Graphics, Messages;
-
type
{TNT-WARN TMenuItem}
TTntMenuItem = class(TMenuItem{TNT-ALLOW TMenuItem})
private
+ FIgnoreMenuChanged: Boolean;
FCaption: WideString;
- {$IFDEF VER130}
+ FHint: WideString;
+ {$IFNDEF COMPILER_6_UP}
FOnMeasureItem: TMenuMeasureItemEvent;
{$ENDIF}
function GetCaption: WideString;
+ procedure SetInheritedCaption(const Value: AnsiString);
procedure SetCaption(const Value: WideString);
- procedure SetInheritedCaption(const Value: AnsiString);
+ function IsCaptionStored: Boolean;
procedure UpdateMenuString(ParentMenu: TMenu);
- function IsCaptionStored: Boolean;
function GetAlignmentDrawStyle: Word;
function MeasureItemTextWidth(ACanvas: TCanvas; const Text: WideString): Integer;
- {$IFDEF VER130}
+ {$IFNDEF COMPILER_6_UP}
procedure DoMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
{$ENDIF}
+ function GetHint: WideString;
+ procedure SetInheritedHint(const Value: AnsiString);
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
protected
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TMenuActionLinkClass; override;
@@ -45,14 +51,15 @@
State: TOwnerDrawState; TopLevel: Boolean); override;
procedure DoDrawText(ACanvas: TCanvas; const ACaption: WideString;
var Rect: TRect; Selected: Boolean; Flags: Integer);
- procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer); {$IFNDEF VER130} override; {$ENDIF}
+ procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer); {$IFDEF COMPILER_6_UP} override; {$ENDIF}
public
constructor Create(AOwner: TComponent); override;
procedure Loaded; override;
function Find(ACaption: WideString): TMenuItem{TNT-ALLOW TMenuItem};
published
property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
- {$IFDEF VER130}
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ {$IFNDEF COMPILER_6_UP}
property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
{$ENDIF}
end;
@@ -61,12 +68,23 @@
TTntMainMenu = class(TMainMenu{TNT-ALLOW TMainMenu})
protected
procedure DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean); override;
+ public
+ {$IFDEF COMPILER_9_UP}
+ function CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem}; override;
+ {$ENDIF}
end;
{TNT-WARN TPopupMenu}
TTntPopupMenu = class(TPopupMenu{TNT-ALLOW TPopupMenu})
protected
procedure DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ {$IFDEF COMPILER_9_UP}
+ function CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem}; override;
+ {$ENDIF}
+ destructor Destroy; override;
+ procedure Popup(X, Y: Integer); override;
end;
{TNT-WARN NewSubMenu}
@@ -81,7 +99,7 @@
function MessageToShortCut(Msg: TWMKeyDown): TShortCut;
{TNT-WARN ShortCutToText}
-function WideShortCutToText(ShortCut: TShortCut): WideString;
+function WideShortCutToText(WordShortCut: Word): WideString;
{TNT-WARN TextToShortCut}
function WideTextToShortCut(Text: WideString): TShortCut;
{TNT-WARN GetHotKey}
@@ -92,16 +110,30 @@
function WideSameCaption(const Text1, Text2: WideString): Boolean;
function WideGetMenuItemCaption(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString;
-procedure WideSetMenuItemCaption(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}; const Value: WideString);
+function WideGetMenuItemHint(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString;
procedure NoOwnerDrawTopLevelItems(Menu: TMainMenu{TNT-ALLOW TMainMenu});
+procedure FixMenuBiDiProblem(Menu: TMenu);
+
function MenuItemHasBitmap(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): Boolean;
+type
+ TTntPopupList = class(TPopupList)
+ private
+ SavedPopupList: TPopupList;
+ protected
+ procedure WndProc(var Message: TMessage); override;
+ end;
+
+var
+ TntPopupList: TTntPopupList;
+
implementation
-uses SysUtils, TntWideStrPropHelper, ActnList, Consts, TntControls, ImgList, TntGraphics, Forms,
- TntActnList;
+uses
+ Controls, Forms, SysUtils, Consts, ActnList, ImgList, TntControls,
+ TntGraphics, TntActnList, TntClasses, TntForms, TntSysUtils, TntWindows;
function WideNewSubMenu(const ACaption: WideString; hCtx: THelpContext;
const AName: TComponentName; const Items: array of TTntMenuItem;
@@ -143,14 +175,14 @@
Result := Menus.ShortCut(TWMKeyDown(Msg).CharCode, ShiftState);
end;
-function WideGetSpecialName(ShortCut: TShortCut): WideString;
+function WideGetSpecialName(WordShortCut: Word): WideString;
var
ScanCode: Integer;
KeyName: array[0..255] of WideChar;
begin
Assert(Win32PlatformIsUnicode);
Result := '';
- ScanCode := MapVirtualKeyW(WordRec(ShortCut).Lo, 0) shl 16;
+ ScanCode := MapVirtualKeyW(WordRec(WordShortCut).Lo, 0) shl 16;
if ScanCode <> 0 then
begin
GetKeyNameTextW(ScanCode, KeyName, SizeOf(KeyName));
@@ -164,29 +196,29 @@
Result := WideChar(MapVirtualKeyW(Key, 2));
end;
-function WideShortCutToText(ShortCut: TShortCut): WideString;
+function WideShortCutToText(WordShortCut: Word): WideString;
var
Name: WideString;
begin
if (not Win32PlatformIsUnicode)
- or (WordRec(ShortCut).Lo in [$08..$09 {BKSP, TAB}, $0D {ENTER}, $1B {ESC}, $20..$28 {Misc Nav},
+ or (WordRec(WordShortCut).Lo in [$08..$09 {BKSP, TAB}, $0D {ENTER}, $1B {ESC}, $20..$28 {Misc Nav},
$2D..$2E {INS, DEL}, $70..$87 {F1 - F24}])
then
- Result := ShortCutToText{TNT-ALLOW ShortCutToText}(ShortCut)
+ Result := ShortCutToText{TNT-ALLOW ShortCutToText}(WordShortCut)
else begin
- case WordRec(ShortCut).Lo of
- $30..$39: Name := WideGetKeyboardChar(WordRec(ShortCut).Lo); {1-9,0}
- $41..$5A: Name := WideGetKeyboardChar(WordRec(ShortCut).Lo); {A-Z}
- $60..$69: Name := WideGetKeyboardChar(WordRec(ShortCut).Lo); {numpad 1-9,0}
+ case WordRec(WordShortCut).Lo of
+ $30..$39: Name := WideGetKeyboardChar(WordRec(WordShortCut).Lo); {1-9,0}
+ $41..$5A: Name := WideGetKeyboardChar(WordRec(WordShortCut).Lo); {A-Z}
+ $60..$69: Name := WideGetKeyboardChar(WordRec(WordShortCut).Lo); {numpad 1-9,0}
else
- Name := WideGetSpecialName(ShortCut);
+ Name := WideGetSpecialName(WordShortCut);
end;
if Name <> '' then
begin
Result := '';
- if ShortCut and scShift <> 0 then Result := Result + SmkcShift;
- if ShortCut and scCtrl <> 0 then Result := Result + SmkcCtrl;
- if ShortCut and scAlt <> 0 then Result := Result + SmkcAlt;
+ if WordShortCut and scShift <> 0 then Result := Result + SmkcShift;
+ if WordShortCut and scCtrl <> 0 then Result := Result + SmkcCtrl;
+ if WordShortCut and scAlt <> 0 then Result := Result + SmkcAlt;
Result := Result + Name;
end
else Result := '';
@@ -224,7 +256,7 @@
end;
if Text = '' then Exit;
for Key := $08 to $255 do { Copy range from table in ShortCutToText }
- if WideCompareText(Text, WideShortCutToText(Key)) = 0 then
+ if WideSameText(Text, WideShortCutToText(Key)) then
begin
Result := Key or Shift;
Exit;
@@ -271,10 +303,11 @@
begin
if Result[I] = cHotkeyPrefix then
if SysLocale.FarEast
- and ((I > 1) and (Length(Result)-I >= 2)
- and (Result[I-1] = '(') and (Result[I+2] = ')')) then
- Delete(Result, I-1, 4)
- else
+ and ((I > 1) and (Length(Result) - I >= 2)
+ and (Result[I - 1] = '(') and (Result[I + 2] = ')')) then begin
+ Delete(Result, I - 1, 4);
+ Dec(I, 2);
+ end else
Delete(Result, I, 1);
Inc(I);
end;
@@ -285,6 +318,11 @@
Result := WideSameText(WideStripHotkey(Text1), WideStripHotkey(Text2));
end;
+function WideSameCaptionStr(const Text1, Text2: WideString): Boolean;
+begin
+ Result := WideSameStr(WideStripHotkey(Text1), WideStripHotkey(Text2));
+end;
+
function WideGetMenuItemCaption(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString;
begin
if MenuItem is TTntMenuItem then
@@ -293,12 +331,12 @@
Result := MenuItem.Caption;
end;
-procedure WideSetMenuItemCaption(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}; const Value: WideString);
+function WideGetMenuItemHint(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString;
begin
if MenuItem is TTntMenuItem then
- TTntMenuItem(MenuItem).Caption := Value
+ Result := TTntMenuItem(MenuItem).Hint
else
- MenuItem.Caption := Value;
+ Result := MenuItem.Hint;
end;
procedure NoOwnerDrawTopLevelItems(Menu: TMainMenu{TNT-ALLOW TMainMenu});
@@ -363,45 +401,36 @@
{ TTntMenuItem's utility procs }
procedure SyncHotKeyPosition(const Source: WideString; var Dest: WideString);
-
- function SafeIndex(const S: WideString; Idx: Integer): Boolean;
- begin
- Result := (Idx <= Length(S)) and (Idx >= 1);
- end;
-
- function SafeGetChar(const S: WideString; Idx: Integer): WideChar;
- begin
- if SafeIndex(S, Idx) then
- Result := S[Idx]
- else
- Result := #0;
- end;
-
var
- HotKey: WideChar;
- HotKeyPrefixIndex: Integer;
- FarEastHotKey_UseParen: Boolean;
+ I: Integer;
+ FarEastHotString: WideString;
begin
- // determine pattern
- HotKeyPrefixIndex := WideGetHotkeyPos(Source) - 1;
- FarEastHotKey_UseParen := False;
- HotKey := #0;
- if (SysLocale.FarEast)
- and (SafeGetChar(Source, HotKeyPrefixIndex - 1) = '(')
- and (SafeGetChar(Source, HotKeyPrefixIndex + 2) = ')') then begin
- HotKey := SafeGetChar(Source, HotKeyPrefixIndex + 1);
- Dec(HotKeyPrefixIndex, 2);
- FarEastHotKey_UseParen := True;
- end;
- // copy pattern
- Dest := WideStripHotkey(Dest);
- if SafeIndex(Dest, HotKeyPrefixIndex) then begin
- if (not FarEastHotKey_UseParen) then
- System.Insert(cHotkeyPrefix, Dest, HotKeyPrefixIndex)
- else begin
- System.Insert('(' + cHotkeyPrefix, Dest, HotKeyPrefixIndex + 1);
- System.Insert(WideString(HotKey) + ')', Dest, HotKeyPrefixIndex + 3); // '(&A'
+ if (AnsiString(Source) <> AnsiString(Dest))
+ and WideSameCaptionStr(AnsiString(Source), AnsiString(Dest)) then begin
+ // when reduced to ansi, the only difference is hot key positions
+ Dest := WideStripHotkey(Dest);
+ I := 1;
+ while I <= Length(Source) do
+ begin
+ if Source[I] = cHotkeyPrefix then begin
+ if SysLocale.FarEast
+ and ((I > 1) and (Length(Source) - I >= 2)
+ and (Source[I - 1] = '(') and (Source[I + 2] = ')')) then begin
+ FarEastHotString := Copy(Source, I - 1, 4);
+ Dec(I);
+ Insert(FarEastHotString, Dest, I);
+ Inc(I, 3);
+ end else begin
+ Insert(cHotkeyPrefix, Dest, I);
+ Inc(I);
+ end;
+ end;
+ Inc(I);
end;
+ // test work
+ if AnsiString(Source) <> AnsiString(Dest) then
+ raise ETntInternalError.CreateFmt('Internal Error: SyncHotKeyPosition Failed ("%s" <> "%s").',
+ [AnsiString(Source), AnsiString(Dest)]);
end;
end;
@@ -417,7 +446,20 @@
end;
end;
-{$IFDEF VER130} // Delphi 5
+procedure FixMenuBiDiProblem(Menu: TMenu);
+begin
+ // TMenu sometimes sets bidi on item[0] which can convert caption to ansi
+ if (SysLocale.MiddleEast) then begin
+ if (Menu <> nil)
+ and (Menu.Items.Count > 0)
+ and (Menu.Items[0] is TTntMenuItem) then
+ begin
+ (Menu.Items[0] as TTntMenuItem).UpdateMenuString(Menu);
+ end;
+ end;
+end;
+
+{$IFDEF COMPILER_5} // verified against VCL source in Delphi 5 and BCB 5
type
THackMenuItem = class(TComponent)
protected
@@ -437,7 +479,7 @@
FBitmap: TBitmap;
end;
{$ENDIF}
-{$IFDEF VER140} // Delphi 6
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
type
THackMenuItem = class(TComponent)
protected
@@ -457,7 +499,7 @@
FBitmap: TBitmap;
end;
{$ENDIF}
-{$IFDEF VER150} // Delphi 7
+{$IFDEF DELPHI_7}
type
THackMenuItem = class(TComponent)
protected
@@ -476,7 +518,27 @@
FxxxxBreak: TMenuBreak;
FBitmap: TBitmap;
end;
-{$ENDIF}
+{$ENDIF}
+{$IFDEF DELPHI_9}
+type
+ THackMenuItem = class(TComponent)
+ protected
+ FxxxxCaption: AnsiString;
+ FxxxxHandle: HMENU;
+ FxxxxChecked: Boolean;
+ FxxxxEnabled: Boolean;
+ FxxxxDefault: Boolean;
+ FxxxxAutoHotkeys: TMenuItemAutoFlag;
+ FxxxxAutoLineReduction: TMenuItemAutoFlag;
+ FxxxxRadioItem: Boolean;
+ FxxxxVisible: Boolean;
+ FxxxxGroupIndex: Byte;
+ FxxxxImageIndex: TImageIndex;
+ FxxxxActionLink: TMenuActionLink{TNT-ALLOW TMenuActionLink};
+ FxxxxBreak: TMenuBreak;
+ FBitmap: TBitmap;
+ end;
+{$ENDIF}
function MenuItemHasBitmap(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): Boolean;
begin
@@ -488,7 +550,7 @@
constructor TTntMenuItem.Create(AOwner: TComponent);
begin
inherited;
- {$IFDEF VER130}
+ {$IFNDEF COMPILER_6_UP}
inherited OnMeasureItem := DoMeasureItem;
{$ENDIF}
end;
@@ -496,7 +558,7 @@
procedure TTntMenuItem.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
type TAccessActionlink = class(TActionLink);
@@ -514,7 +576,7 @@
function TTntMenuItem.GetCaption: WideString;
begin
if (AnsiString(FCaption) <> inherited Caption)
- and WideSameCaption(AnsiString(FCaption), inherited Caption) then
+ and WideSameCaptionStr(AnsiString(FCaption), inherited Caption) then
begin
// only difference is hotkey position, update caption with new hotkey position
SyncHotKeyPosition(inherited Caption, FCaption);
@@ -528,6 +590,26 @@
SetSyncedWideString(Value, FCaption, (inherited Caption), SetInheritedCaption);
end;
+function TTntMenuItem.GetHint: WideString;
+begin
+ Result := GetSyncedWideString(FHint, inherited Hint);
+end;
+
+procedure TTntMenuItem.SetInheritedHint(const Value: AnsiString);
+begin
+ inherited Hint := Value;
+end;
+
+procedure TTntMenuItem.SetHint(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FHint, inherited Hint, SetInheritedHint);
+end;
+
+function TTntMenuItem.IsHintStored: Boolean;
+begin
+ Result := (ActionLink = nil) or not TAccessActionlink(ActionLink).IsHintLinked;
+end;
+
procedure TTntMenuItem.Loaded;
begin
inherited;
@@ -535,21 +617,11 @@
end;
procedure TTntMenuItem.MenuChanged(Rebuild: Boolean);
-var
- ParentMenu: TMenu;
begin
- inherited;
- UpdateMenuItems(Self, GetParentMenu);
- // TMenu sometimes sets bidi on item[0] which can convert caption to ansi
- if (SysLocale.MiddleEast) then begin
- ParentMenu := GetParentMenu;
- if (ParentMenu <> nil)
- and (not ParentMenu.ParentBiDiMode)
- and (ParentMenu.Items.Count > 0)
- and (ParentMenu.Items[0] is TTntMenuItem) then
- begin
- (ParentMenu.Items[0] as TTntMenuItem).UpdateMenuString(ParentMenu);
- end;
+ if (not FIgnoreMenuChanged) then begin
+ inherited;
+ UpdateMenuItems(Self, GetParentMenu);
+ FixMenuBiDiProblem(GetParentMenu);
end;
end;
@@ -609,7 +681,7 @@
var
MenuCaption: WideString;
begin
- {$IFDEF VER130}
+ {$IFNDEF COMPILER_6_UP}
if not SameEvent(inherited OnMeasureItem, DoMeasureItem) then begin
if not SameEvent(inherited OnMeasureItem, nil) then
OnMeasureItem := inherited OnMeasureItem; {sync}
@@ -724,7 +796,11 @@
if not (Win98Plus and TopLevel) then
Brush.Color := clHighlight;
end;
- if TopLevel and Win98Plus and (not Selected) then
+ if TopLevel and Win98Plus and (not Selected)
+ {$IFDEF COMPILER_7_UP}
+ and (not Win32PlatformIsXP)
+ {$ENDIF}
+ then
OffsetRect(ARect, 0, -1);
if not (Selected and DrawGlyph) then begin
if BiDi then
@@ -748,7 +824,11 @@
ARect.Right := SaveRect.Right;
end;
OffsetRect(ARect, 0, ((SaveRect.Bottom - SaveRect.Top) - (ARect.Bottom - ARect.Top)) div 2);
- if TopLevel and Selected and Win98Plus then
+ if TopLevel and Selected and Win98Plus
+ {$IFDEF COMPILER_7_UP}
+ and (not Win32PlatformIsXP)
+ {$ENDIF}
+ then
OffsetRect(ARect, 1, 0);
DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle);
if (ShortCut <> scNone) and not TopLevel then
@@ -766,8 +846,9 @@
end;
var
- SaveFontColor: TColor;
ParentMenu: TMenu;
+ SaveCaption: WideString;
+ SaveShortCut: TShortCut;
begin
ParentMenu := GetParentMenu;
if (not Win32PlatformIsUnicode)
@@ -776,12 +857,25 @@
and (Assigned(OnAdvancedDrawItem) or Assigned(OnDrawItem)) ) then
inherited
else begin
- SaveFontColor := ACanvas.Font.Color;
+ SaveCaption := Caption;
+ SaveShortCut := ShortCut;
try
- ACanvas.Font.Color := ACanvas.Brush.Color;
+ FIgnoreMenuChanged := True;
+ try
+ Caption := '';
+ ShortCut := scNone;
+ finally
+ FIgnoreMenuChanged := False;
+ end;
inherited;
finally
- ACanvas.Font.Color := SaveFontColor;
+ FIgnoreMenuChanged := True;
+ try
+ Caption := SaveCaption;
+ ShortCut := SaveShortcut;
+ finally
+ FIgnoreMenuChanged := False;
+ end;
end;
DrawMenuText((ParentMenu <> nil) and (ParentMenu.IsRightToLeft))
end;
@@ -820,14 +914,14 @@
begin
OffsetRect(Rect, 1, 1);
Font.Color := clBtnHighlight;
- DrawTextW(Handle, PWideChar(Text), Length(Text), Rect, Flags);
+ Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), Rect, Flags);
OffsetRect(Rect, -1, -1);
end;
if Selected and (ColorToRGB(clHighlight) = ColorToRGB(clBtnShadow)) then
Font.Color := clBtnHighlight else
Font.Color := clBtnShadow;
end;
- DrawTextW(Handle, PWideChar(Text), Length(Text), Rect, Flags);
+ Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), Rect, Flags);
end;
end;
end;
@@ -842,7 +936,7 @@
Result := R.Right - R.Left;
end;
-{$IFDEF VER130}
+{$IFNDEF COMPILER_6_UP}
procedure TTntMenuItem.DoMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
if (not Win32PlatformIsUnicode)
@@ -902,15 +996,6 @@
Result := TTntMenuActionLink;
end;
-{$IFDEF VER130}
-function Supports(const Instance: TObject; const IID: TGUID): Boolean;
-var
- Temp: IUnknown;
-begin
- Result := Instance.GetInterface(IID, Temp);
-end;
-{$ENDIF}
-
procedure TTntMenuItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
if (Sender is TCustomAction{TNT-ALLOW TCustomAction}) and Supports(Sender, ITntAction) then begin
@@ -924,6 +1009,13 @@
{ TTntMainMenu }
+{$IFDEF COMPILER_9_UP}
+function TTntMainMenu.CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
+begin
+ Result := TTntMenuItem.Create(Self);
+end;
+{$ENDIF}
+
procedure TTntMainMenu.DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean);
begin
inherited;
@@ -932,13 +1024,91 @@
{ TTntPopupMenu }
+constructor TTntPopupMenu.Create(AOwner: TComponent);
+begin
+ inherited;
+ PopupList.Remove(Self);
+ TntPopupList.Add(Self);
+end;
+
+{$IFDEF COMPILER_9_UP}
+function TTntPopupMenu.CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
+begin
+ Result := TTntMenuItem.Create(Self);
+end;
+{$ENDIF}
+
+destructor TTntPopupMenu.Destroy;
+begin
+ TntPopupList.Remove(Self);
+ PopupList.Add(Self);
+ inherited;
+end;
+
procedure TTntPopupMenu.DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean);
begin
inherited;
UpdateMenuItems(Items, Self);
end;
+procedure TTntPopupMenu.Popup(X, Y: Integer);
+begin
+ Menus.PopupList := TntPopupList;
+ try
+ inherited;
+ finally
+ Menus.PopupList := TntPopupList.SavedPopupList;
+ end;
+end;
+
+{ TTntPopupList }
+
+procedure TTntPopupList.WndProc(var Message: TMessage);
+var
+ I, Item: Integer;
+ MenuItem: TMenuItem{TNT-ALLOW TMenuItem};
+ FindKind: TFindItemKind;
+begin
+ case Message.Msg of
+ WM_ENTERMENULOOP:
+ begin
+ Menus.PopupList := SavedPopupList;
+ for i := 0 to Count - 1 do
+ FixMenuBiDiProblem(Items[i]);
+ end;
+ WM_MENUSELECT:
+ with TWMMenuSelect(Message) do
+ begin
+ FindKind := fkCommand;
+ if MenuFlag and MF_POPUP <> 0 then FindKind := fkHandle;
+ for I := 0 to Count - 1 do
+ begin
+ if FindKind = fkHandle then
+ begin
+ if Menu <> 0 then
+ Item := Integer(GetSubMenu(Menu, IDItem)) else
+ Item := -1;
+ end
+ else
+ Item := IDItem;
+ MenuItem := TPopupMenu{TNT-ALLOW TPopupMenu}(Items[I]).FindItem(Item, FindKind);
+ if MenuItem <> nil then
+ begin
+ TntApplication.Hint := WideGetLongHint(WideGetMenuItemHint(MenuItem));
+ Exit;
+ end;
+ end;
+ TntApplication.Hint := '';
+ end;
+ end;
+ inherited;
+end;
+
initialization
- Classes.RegisterClass(TTntMenuItem);
+ TntPopupList := TTntPopupList.Create;
+ TntPopupList.SavedPopupList := Menus.PopupList;
+finalization
+ TntPopupList.Free;
+
end.
Modified: trunk/TntUnicodeControls/TntStdActns.pas
===================================================================
--- trunk/TntUnicodeControls/TntStdActns.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntStdActns.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,8 +1,22 @@
+
+{*****************************************************************************}
+{ }
+{ 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 TntStdActns;
+{$INCLUDE TntCompilers.inc}
+
interface
-uses Classes, ActnList, TntActnList, StdActns;
+uses
+ Classes, ActnList, TntActnList, StdActns, TntDialogs;
type
{TNT-WARN THintAction}
@@ -129,6 +143,8 @@
procedure DefineProperties(Filer: TFiler); override;
public
procedure Assign(Source: TPersistent); override;
+ procedure UpdateTarget(Target: TObject); override;
+ procedure ExecuteTarget(Target: TObject); override;
published
property Caption: WideString read GetCaption write SetCaption;
property Hint: WideString read GetHint write SetHint;
@@ -310,7 +326,7 @@
property Hint: WideString read GetHint write SetHint;
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
{TNT-WARN THelpContextAction}
TTntHelpContextAction = class(THelpContextAction{TNT-ALLOW THelpContextAction}, ITntAction)
@@ -367,12 +383,15 @@
procedure SetCaption(const Value: WideString);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
+ function GetDialog: TTntOpenDialog;
protected
procedure DefineProperties(Filer: TFiler); override;
+ function GetDialogClass: TCommonDialogClass; override;
public
procedure Assign(Source: TPersistent); override;
published
property Caption: WideString read GetCaption write SetCaption;
+ property Dialog: TTntOpenDialog read GetDialog;
property Hint: WideString read GetHint write SetHint;
end;
@@ -383,12 +402,15 @@
procedure SetCaption(const Value: WideString);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
+ function GetDialog: TTntOpenDialog;
protected
procedure DefineProperties(Filer: TFiler); override;
+ function GetDialogClass: TCommonDialogClass; override;
public
procedure Assign(Source: TPersistent); override;
published
property Caption: WideString read GetCaption write SetCaption;
+ property Dialog: TTntOpenDialog read GetDialog;
property Hint: WideString read GetHint write SetHint;
end;
@@ -399,12 +421,15 @@
procedure SetCaption(const Value: WideString);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
+ function GetDialog: TTntSaveDialog;
protected
procedure DefineProperties(Filer: TFiler); override;
+ function GetDialogClass: TCommonDialogClass; override;
public
procedure Assign(Source: TPersistent); override;
published
property Caption: WideString read GetCaption write SetCaption;
+ property Dialog: TTntSaveDialog read GetDialog;
property Hint: WideString read GetHint write SetHint;
end;
@@ -424,7 +449,7 @@
property Hint: WideString read GetHint write SetHint;
end;
- {$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
{TNT-WARN TFilePageSetup}
TTntFilePageSetup = class(TFilePageSetup{TNT-ALLOW TFilePageSetup}, ITntAction)
private
@@ -591,14 +616,15 @@
implementation
-uses TntWideStrPropHelper;
+uses
+ Dialogs, TntClasses;
{TNT-IGNORE-UNIT}
procedure TntStdActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
begin
TntAction_AfterInherited_Assign(Action, Source);
-{$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
// TCommonDialogAction
if (Action is TCommonDialogAction) and (Source is TCommonDialogAction) then begin
TCommonDialogAction(Action).BeforeExecute := TCommonDialogAction(Source).BeforeExecute;
@@ -607,14 +633,14 @@
end;
// TFileOpen
if (Action is TFileOpen) and (Source is TFileOpen) then begin
- {$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
TFileOpen(Action).UseDefaultApp := TFileOpen(Source).UseDefaultApp;
{$ENDIF}
end;
// TFileOpenWith
if (Action is TFileOpenWith) and (Source is TFileOpenWith) then begin
TFileOpenWith(Action).FileName := TFileOpenWith(Source).FileName;
- {$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
TFileOpenWith(Action).AfterOpen := TFileOpenWith(Source).AfterOpen;
{$ENDIF}
end;
@@ -622,7 +648,7 @@
if (Action is TSearchFindNext) and (Source is TSearchFindNext) then begin
TSearchFindNext(Action).SearchFind := TSearchFindNext(Source).SearchFind;
end;
-{$ENDIF}
+ {$ENDIF}
end;
//-------------------------
@@ -640,7 +666,7 @@
procedure TTntHintAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntHintAction.GetCaption: WideString;
@@ -674,7 +700,7 @@
procedure TTntEditAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntEditAction.GetCaption: WideString;
@@ -708,7 +734,7 @@
procedure TTntEditCut.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntEditCut.GetCaption: WideString;
@@ -742,7 +768,7 @@
procedure TTntEditCopy.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntEditCopy.GetCaption: WideString;
@@ -776,7 +802,7 @@
procedure TTntEditPaste.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntEditPaste.GetCaption: WideString;
@@ -810,7 +836,7 @@
procedure TTntEditSelectAll.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntEditSelectAll.GetCaption: WideString;
@@ -844,7 +870,7 @@
procedure TTntEditUndo.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntEditUndo.GetCaption: WideString;
@@ -878,7 +904,7 @@
procedure TTntEditDelete.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntEditDelete.GetCaption: WideString;
@@ -901,6 +927,18 @@
TntAction_SetHint(Self, Value);
end;
+procedure TTntEditDelete.UpdateTarget(Target: TObject);
+begin
+ Enabled := True;
+end;
+
+procedure TTntEditDelete.ExecuteTarget(Target: TObject);
+begin
+ if GetControl(Target).SelLength = 0 then
+ GetControl(Target).SelLength := 1;
+ GetControl(Target).ClearSelection
+end;
+
{ TTntWindowAction }
procedure TTntWindowAction.Assign(Source: TPersistent);
@@ -912,7 +950,7 @@
procedure TTntWindowAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntWindowAction.GetCaption: WideString;
@@ -946,7 +984,7 @@
procedure TTntWindowClose.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntWindowClose.GetCaption: WideString;
@@ -980,7 +1018,7 @@
procedure TTntWindowCascade.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntWindowCascade.GetCaption: WideString;
@@ -1014,7 +1052,7 @@
procedure TTntWindowTileHorizontal.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntWindowTileHorizontal.GetCaption: WideString;
@@ -1048,7 +1086,7 @@
procedure TTntWindowTileVertical.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntWindowTileVertical.GetCaption: WideString;
@@ -1082,7 +1120,7 @@
procedure TTntWindowMinimizeAll.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntWindowMinimizeAll.GetCaption: WideString;
@@ -1116,7 +1154,7 @@
procedure TTntWindowArrange.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntWindowArrange.GetCaption: WideString;
@@ -1150,7 +1188,7 @@
procedure TTntHelpAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntHelpAction.GetCaption: WideString;
@@ -1184,7 +1222,7 @@
procedure TTntHelpContents.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntHelpContents.GetCaption: WideString;
@@ -1218,7 +1256,7 @@
procedure TTntHelpTopicSearch.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntHelpTopicSearch.GetCaption: WideString;
@@ -1252,7 +1290,7 @@
procedure TTntHelpOnHelp.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntHelpOnHelp.GetCaption: WideString;
@@ -1275,7 +1313,7 @@
TntAction_SetHint(Self, Value);
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
{ TTntHelpContextAction }
@@ -1288,7 +1326,7 @@
procedure TTntHelpContextAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntHelpContextAction.GetCaption: WideString;
@@ -1322,7 +1360,7 @@
procedure TTntCommonDialogAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCommonDialogAction.GetCaption: WideString;
@@ -1356,7 +1394,7 @@
procedure TTntFileAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFileAction.GetCaption: WideString;
@@ -1390,7 +1428,7 @@
procedure TTntFileOpen.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFileOpen.GetCaption: WideString;
@@ -1413,6 +1451,16 @@
TntAction_SetHint(Self, Value);
end;
+function TTntFileOpen.GetDialog: TTntOpenDialog;
+begin
+ Result := inherited Dialog as TTntOpenDialog;
+end;
+
+function TTntFileOpen.GetDialogClass: TCommonDialogClass;
+begin
+ Result := TTntOpenDialog;
+end;
+
{ TTntFileOpenWith }
procedure TTntFileOpenWith.Assign(Source: TPersistent);
@@ -1424,7 +1472,7 @@
procedure TTntFileOpenWith.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFileOpenWith.GetCaption: WideString;
@@ -1447,6 +1495,16 @@
TntAction_SetHint(Self, Value);
end;
+function TTntFileOpenWith.GetDialog: TTntOpenDialog;
+begin
+ Result := inherited Dialog as TTntOpenDialog;
+end;
+
+function TTntFileOpenWith.GetDialogClass: TCommonDialogClass;
+begin
+ Result := TTntOpenDialog;
+end;
+
{ TTntFileSaveAs }
procedure TTntFileSaveAs.Assign(Source: TPersistent);
@@ -1458,7 +1516,7 @@
procedure TTntFileSaveAs.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFileSaveAs.GetCaption: WideString;
@@ -1481,6 +1539,16 @@
TntAction_SetHint(Self, Value);
end;
+function TTntFileSaveAs.GetDialog: TTntSaveDialog;
+begin
+ Result := TOpenDialog(inherited Dialog) as TTntSaveDialog;
+end;
+
+function TTntFileSaveAs.GetDialogClass: TCommonDialogClass;
+begin
+ Result := TTntSaveDialog;
+end;
+
{ TTntFilePrintSetup }
procedure TTntFilePrintSetup.Assign(Source: TPersistent);
@@ -1492,7 +1560,7 @@
procedure TTntFilePrintSetup.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFilePrintSetup.GetCaption: WideString;
@@ -1515,7 +1583,7 @@
TntAction_SetHint(Self, Value);
end;
- {$IFDEF VER150}
+ {$IFDEF COMPILER_7_UP}
{ TTntFilePageSetup }
@@ -1528,7 +1596,7 @@
procedure TTntFilePageSetup.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFilePageSetup.GetCaption: WideString;
@@ -1563,7 +1631,7 @@
procedure TTntFileExit.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFileExit.GetCaption: WideString;
@@ -1597,7 +1665,7 @@
procedure TTntSearchAction.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSearchAction.GetCaption: WideString;
@@ -1631,7 +1699,7 @@
procedure TTntSearchFind.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSearchFind.GetCaption: WideString;
@@ -1665,7 +1733,7 @@
procedure TTntSearchReplace.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSearchReplace.GetCaption: WideString;
@@ -1699,7 +1767,7 @@
procedure TTntSearchFindFirst.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSearchFindFirst.GetCaption: WideString;
@@ -1733,7 +1801,7 @@
procedure TTntSearchFindNext.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntSearchFindNext.GetCaption: WideString;
@@ -1767,7 +1835,7 @@
procedure TTntFontEdit.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntFontEdit.GetCaption: WideString;
@@ -1801,7 +1869,7 @@
procedure TTntColorSelect.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntColorSelect.GetCaption: WideString;
@@ -1835,7 +1903,7 @@
procedure TTntPrintDlg.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntPrintDlg.GetCaption: WideString;
Modified: trunk/TntUnicodeControls/TntStdCtrls.pas
===================================================================
--- trunk/TntUnicodeControls/TntStdCtrls.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntStdCtrls.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,38 +1,53 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntStdCtrls;
+{$INCLUDE TntCompilers.inc}
+
interface
-
+
uses
- Windows, Messages, Classes, Controls, TntControls, StdCtrls, CheckLst, TntClasses;
+ Windows, Messages, Classes, Controls, TntControls, StdCtrls, CheckLst, Graphics,
+ TntClasses, TntSysUtils;
{TNT-WARN TCustomEdit}
type
TTntCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit})
private
- function GetSelText: WideString; reintroduce;
+ FPasswordChar: WideChar;
procedure SetSelText(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
+ function GetPasswordChar: WideChar;
+ procedure SetPasswordChar(const Value: WideChar);
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;
+ 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; virtual;
+ property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
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;
@@ -44,7 +59,7 @@
property Anchors;
property AutoSelect;
property AutoSize;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
@@ -102,7 +117,7 @@
type
TTntCustomMemo = class;
- TTntMemoStrings = class(TTntWideStrings)
+ TTntMemoStrings = class(TTntStrings)
protected
Memo: TCustomMemo{TNT-ALLOW TCustomMemo};
FRichEditMode: Boolean;
@@ -110,11 +125,11 @@
function Get(Index: Integer): WideString; override;
function GetCount: Integer; override;
function GetTextStr: WideString; override;
- procedure SetTextStr(const Value: WideString); override;
procedure Put(Index: Integer; const S: WideString); override;
procedure SetUpdateState(Updating: Boolean); override;
public
constructor Create;
+ procedure SetTextStr(const Value: WideString); override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: WideString); override;
@@ -123,9 +138,8 @@
{TNT-WARN TCustomMemo}
TTntCustomMemo = class(TCustomMemo{TNT-ALLOW TCustomMemo})
private
- FLines: TTntWideStrings;
- procedure SetLines(const Value: TTntWideStrings);
- function GetSelText: WideString; reintroduce;
+ FLines: TTntStrings;
+ procedure SetLines(const Value: TTntStrings);
procedure SetSelText(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
@@ -137,12 +151,19 @@
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ 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;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; 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;
- property Lines: TTntWideStrings read FLines write SetLines;
+ property Lines: TTntStrings read FLines write SetLines;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
@@ -153,7 +174,7 @@
property Align;
property Alignment;
property Anchors;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
@@ -210,7 +231,7 @@
property OnStartDrag;
end;
- TTntComboBoxStrings = class(TTntWideStrings)
+ TTntComboBoxStrings = class(TTntStrings)
protected
function Get(Index: Integer): WideString; override;
function GetCount: Integer; override;
@@ -227,35 +248,9 @@
end;
type
- ITntComboBox = interface
- ['{95B1B13F-96C4-4D36-98AF-2DF563D4B4A6}']
- procedure DoEditCharMsg(var Message: TWMChar);
- function GetItems: TTntWideStrings;
- procedure SetItems(const Value: TTntWideStrings);
- function GetSelLength: Integer;
- function GetSelStart: Integer;
- function GetSelText: WideString;
- procedure SetSelLength(Value: Integer);
- procedure SetSelStart(Value: Integer);
- procedure SetSelText(const Value: WideString);
- function GetText: WideString;
- procedure SetText(const Value: WideString);
- function GetItemIndex: Integer;
- procedure SetItemIndex(const Value: Integer);
- function GetAutoComplete_UniqueMatchOnly: Boolean;
- function GetAutoComplete_PreserveDataEntryCase: Boolean;
- //--
- property SelLength: Integer read GetSelLength write SetSelLength;
- property SelStart: Integer read GetSelStart write SetSelStart;
- property SelText: WideString read GetSelText write SetSelText;
- property Text: WideString read GetText write SetText;
- property Items: TTntWideStrings read GetItems write SetItems;
- property ItemIndex: Integer read GetItemIndex write SetItemIndex;
- property AutoComplete_UniqueMatchOnly: Boolean read GetAutoComplete_UniqueMatchOnly;
- property AutoComplete_PreserveDataEntryCase: Boolean read GetAutoComplete_PreserveDataEntryCase;
- end;
+ TWMCharMsgHandler = procedure(var Message: TWMChar) of object;
-{$IFDEF VER150}
+{$IFDEF DELPHI_7}
{ TD7PatchedComboBoxStrings }
type
TD7PatchedComboBoxStrings = class(TCustomComboBoxStrings)
@@ -267,29 +262,33 @@
end;
{$ENDIF}
+type
+ ITntComboFindString = interface
+ ['{63BEBEF4-B1A2-495A-B558-7487B66F6827}']
+ function FindString(const Value: WideString; StartPos: Integer): Integer;
+ end;
+
{TNT-WARN TCustomComboBox}
type
TTntCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox},
- ITntComboBox, IWideCustomListControl)
+ IWideCustomListControl)
private
- FItems: TTntWideStrings;
- FSaveItems: TTntWideStrings;
- {$IFNDEF VER130}
+ FItems: TTntStrings;
+ FSaveItems: TTntStrings;
+ FSaveItemIndex: Integer;
+ {$IFDEF COMPILER_6_UP}
FFilter: WideString;
FLastTime: Cardinal;
{$ENDIF}
- function GetItems: TTntWideStrings;
- procedure SetItems(const Value: TTntWideStrings); reintroduce;
+ function GetItems: TTntStrings;
+ function GetSelStart: Integer;
+ procedure SetSelStart(const Value: Integer);
function GetSelLength: Integer;
- procedure SetSelLength(Value: Integer);
- function GetSelStart: Integer;
- procedure SetSelStart(Value: Integer);
+ procedure SetSelLength(const Value: Integer);
function GetSelText: WideString;
procedure SetSelText(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
- function GetItemIndex: Integer; reintroduce;
- procedure SetItemIndex(const Value: Integer); reintroduce;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
function GetHint: WideString;
procedure SetHint(const Value: WideString);
@@ -308,20 +307,23 @@
procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure KeyPress(var Key: AnsiChar); override;
- {$IFDEF VER150}
+ {$IFDEF DELPHI_7}
function GetItemsClass: TCustomComboBoxStringsClass; override;
{$ENDIF}
+ procedure SetItems(const Value: TTntStrings); reintroduce; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
-{$IFNDEF VER130}
+{$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;
- property Items: TTntWideStrings read GetItems write SetItems;
+ property Items: TTntStrings read GetItems write SetItems;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
@@ -329,10 +331,10 @@
{TNT-WARN TComboBox}
TTntComboBox = class(TTntCustomComboBox)
published
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property AutoComplete default True;
property AutoDropDown default False;
-{$IFDEF VER150}
+{$IFDEF COMPILER_7_UP}
property AutoCloseUp default False;
{$ENDIF}
property BevelEdges;
@@ -343,7 +345,7 @@
property Style; {Must be published before Items}
property Anchors;
property BiDiMode;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property CharCase;
{$ENDIF}
property Color;
@@ -358,7 +360,7 @@
property ImeMode;
property ImeName;
property ItemHeight;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property ItemIndex default -1;
{$ENDIF}
property MaxLength;
@@ -376,7 +378,7 @@
property Visible;
property OnChange;
property OnClick;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property OnCloseUp;
{$ENDIF}
property OnContextPopup;
@@ -393,7 +395,7 @@
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property OnSelect;
{$ENDIF}
property OnStartDock;
@@ -401,9 +403,14 @@
property Items; { Must be published after OnMeasureItem }
end;
+ {$IFDEF COMPILER_6_UP}
+ TLBGetWideDataEvent = procedure(Control: TWinControl; Index: Integer;
+ var Data: WideString) of object;
+ {$ENDIF}
+
TAccessCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox});
- TTntListBoxStrings = class(TTntWideStrings)
+ TTntListBoxStrings = class(TTntStrings)
private
FListBox: TAccessCustomListBox;
function GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
@@ -430,14 +437,21 @@
type
TTntCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox}, IWideCustomListControl)
private
- FItems: TTntWideStrings;
- FSaveItems: TTntWideStrings;
+ FItems: TTntStrings;
+ FSaveItems: TTntStrings;
FSaveTopIndex: Integer;
FSaveItemIndex: Integer;
- procedure SetItems(const Value: TTntWideStrings);
+ {$IFDEF COMPILER_6_UP}
+ FOnData: TLBGetWideDataEvent;
+ {$ENDIF}
+ procedure SetItems(const Value: TTntStrings);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
+ {$IFDEF COMPILER_6_UP}
+ procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
+ procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
+ {$ENDIF}
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
@@ -446,14 +460,17 @@
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
+ {$IFDEF COMPILER_6_UP}
+ property OnData: TLBGetWideDataEvent read FOnData write FOnData;
+ {$ENDIF}
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure CopySelection(Destination: TCustomListControl); override;
{$ENDIF}
procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
- property Items: TTntWideStrings read FItems write SetItems;
+ property Items: TTntStrings read FItems write SetItems;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
@@ -461,13 +478,13 @@
{TNT-WARN TListBox}
TTntListBox = class(TTntCustomListBox)
published
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property Style;
property AutoComplete;
{$ENDIF}
property Align;
property Anchors;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
@@ -497,12 +514,12 @@
property ParentFont;
property ParentShowHint;
property PopupMenu;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property ScrollWidth;
{$ENDIF}
property ShowHint;
property Sorted;
-{$IFDEF VER130}
+{$IFNDEF COMPILER_6_UP}
property Style;
{$ENDIF}
property TabOrder;
@@ -511,7 +528,7 @@
property Visible;
property OnClick;
property OnContextPopup;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property OnData;
property OnDataFind;
property OnDataObject;
@@ -566,7 +583,7 @@
property AutoSize;
property BiDiMode;
property Caption;
- property Color {$IFDEF VER150} nodefault {$ENDIF};
+ property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
property Constraints;
property DragCursor;
property DragKind;
@@ -595,7 +612,7 @@
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
property OnMouseEnter;
property OnMouseLeave;
{$ENDIF}
@@ -654,7 +671,7 @@
property BiDiMode;
property Caption;
property Checked;
- property Color {$IFDEF VER150} nodefault {$ENDIF};
+ property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
property Constraints;
property Ctl3D;
property DragCursor;
@@ -673,7 +690,7 @@
property TabOrder;
property TabStop;
property Visible;
-{$IFDEF VER150}
+{$IFDEF COMPILER_7_UP}
property WordWrap;
{$ENDIF}
property OnClick;
@@ -766,7 +783,7 @@
property DragMode;
property Enabled;
property Font;
-{$IFDEF VER150}
+{$IFDEF COMPILER_7_UP}
property ParentBackground default True;
{$ENDIF}
property ParentBiDiMode;
@@ -833,7 +850,7 @@
property BiDiMode;
property BorderStyle;
property Caption;
- property Color {$IFDEF VER150} nodefault {$ENDIF};
+ property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
property Constraints;
property DragCursor;
property DragKind;
@@ -850,7 +867,7 @@
property ShowHint;
property TabOrder;
property TabStop;
-{$IFDEF VER150}
+{$IFDEF COMPILER_7_UP}
property Transparent;
{$ENDIF}
property Visible;
@@ -868,49 +885,74 @@
property OnStartDrag;
end;
-procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var FSaveItems: TTntWideStrings);
-procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var FSaveItems: TTntWideStrings);
+procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
+procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer);
function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer): Boolean;
-function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var Message: TWMCommand): Boolean;
+ var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
+function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
+function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
+procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
+function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
+procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
-procedure TntComboBox_AddItem(Items: TTntWideStrings; const Item: WideString; AObject: TObject);
-{$IFNDEF VER130}
-procedure TntComboBox_CopySelection(Items: TTntWideStrings; ItemIndex: Integer;
+procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
+{$IFDEF COMPILER_6_UP}
+procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
Destination: TCustomListControl);
-procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
-procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var Message: TWMChar);
+procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
+procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var Message: TWMChar;
+ AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
{$ENDIF}
+procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
+ State: TOwnerDrawState; Items: TTntStrings);
procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
+procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
+function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
+procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
+function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
+procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
+function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
+procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
+
function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
-function TntMemo_LineLength(Handle: THandle; Index: Integer): Integer;
+function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- var FSaveItems: TTntWideStrings; FItems: TTntWideStrings; FSaveTopIndex, FSaveItemIndex: Integer);
+ var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- var FSaveItems: TTntWideStrings; const FItems: TTntWideStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
-procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntWideStrings; Index: Integer; Rect: TRect);
-procedure TntListBox_AddItem(Items: TTntWideStrings; const Item: WideString; AObject: TObject);
-{$IFNDEF VER130}
+ var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
+procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
+procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
+{$IFDEF COMPILER_6_UP}
procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
- Items: TTntWideStrings; Destination: TCustomListControl);
+ Items: TTntStrings; Destination: TCustomListControl);
+function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
+function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
{$ENDIF}
+function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
+procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
+
procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
implementation
-uses Forms, SysUtils, Consts, RichEdit, Graphics, ComStrs, Dialogs,
- {$IFNDEF VER130} RTLConsts, {$ENDIF} {$IFDEF VER150} Themes, {$ENDIF}
- TntForms, TntGraphics, TntWideStrPropHelper, TntActnList;
+uses
+ Forms, SysUtils, Consts, RichEdit, ComStrs, Dialogs,
+ {$IFDEF COMPILER_6_UP} RTLConsts, {$ENDIF} {$IFDEF THEME_7_UP} Themes, {$ENDIF}
+ TntForms, TntGraphics, TntActnList, TntWindows;
{ TTntCustomEdit }
@@ -931,33 +973,148 @@
CreateUnicodeHandle(Edit, Params, 'EDIT');
end;
+procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
+var
+ PasswordChar: WideChar;
+begin
+ PasswordChar := TntCustomEdit_GetPasswordChar(Edit, FPasswordChar);
+ if Win32PlatformIsUnicode then
+ SendMessageW(Edit.Handle, EM_SETPASSWORDCHAR, Ord(PasswordChar), 0);
+end;
+
+function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := Edit.SelStart
+ else
+ Result := Length(WideString(Copy(Edit.Text, 1, Edit.SelStart)));
+end;
+
+procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
+begin
+ if Win32PlatformIsUnicode then
+ Edit.SelStart := Value
+ else
+ Edit.SelStart := Length(AnsiString(Copy(TntControl_GetText(Edit), 1, Value)));
+end;
+
+function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := Edit.SelLength
+ else
+ Result := Length(TntCustomEdit_GetSelText(Edit));
+end;
+
+procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
+var
+ StartPos: Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Edit.SelLength := Value
+ else begin
+ StartPos := TntCustomEdit_GetSelStart(Edit);
+ Edit.SelLength := Length(AnsiString(Copy(TntControl_GetText(Edit), StartPos + 1, Value)));
+ end;
+end;
+
function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
begin
- if (not IsWindowUnicode(Edit.Handle)) then
+ if Win32PlatformIsUnicode then
+ Result := Copy(TntControl_GetText(Edit), Edit.SelStart + 1, Edit.SelLength)
+ else
Result := Edit.SelText
- else
- Result := Copy(TntControl_GetText(Edit), Edit.SelStart + 1, Edit.SelLength);
end;
procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
begin
- if (not IsWindowUnicode(Edit.Handle)) then
- Edit.SelText := Value
+ if Win32PlatformIsUnicode then
+ SendMessageW(Edit.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value)))
else
- SendMessageW(Edit.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value)));
+ Edit.SelText := Value;
end;
+function WideCharToAnsiChar(const C: WideChar): AnsiChar;
+begin
+ if C <= High(AnsiChar) then
+ Result := AnsiChar(C)
+ else
+ Result := '*';
+end;
+
+type TAccessCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit});
+
+function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
+begin
+ if TAccessCustomEdit(Edit).PasswordChar <> WideCharToAnsiChar(FPasswordChar) then
+ FPasswordChar := WideChar(TAccessCustomEdit(Edit).PasswordChar);
+ Result := FPasswordChar;
+end;
+
+procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
+var
+ SaveWindowHandle: Integer;
+ PasswordCharSetHere: Boolean;
+begin
+ if TntCustomEdit_GetPasswordChar(Edit, FPasswordChar) <> Value then
+ begin
+ FPasswordChar := Value;
+ PasswordCharSetHere := Win32PlatformIsUnicode and Edit.HandleAllocated;
+ SaveWindowHandle := TAccessCustomEdit(Edit).WindowHandle;
+ try
+ if PasswordCharSetHere then
+ TAccessCustomEdit(Edit).WindowHandle := 0; // this prevents TCustomEdit from actually changing it
+ TAccessCustomEdit(Edit).PasswordChar := WideCharToAnsiChar(FPasswordChar);
+ finally
+ TAccessCustomEdit(Edit).WindowHandle := SaveWindowHandle;
+ end;
+ if PasswordCharSetHere then
+ begin
+ Assert(Win32PlatformIsUnicode);
+ Assert(Edit.HandleAllocated);
+ SendMessageW(Edit.Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
+ Edit.Invalidate;
+ end;
+ end;
+end;
+
procedure TTntCustomEdit.CreateWindowHandle(const Params: TCreateParams);
begin
TntCustomEdit_CreateWindowHandle(Self, Params);
end;
+procedure TTntCustomEdit.CreateWnd;
+begin
+ inherited;
+ TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
+end;
+
procedure TTntCustomEdit.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
+function TTntCustomEdit.GetSelStart: Integer;
+begin
+ Result := TntCustomEdit_GetSelStart(Self);
+end;
+
+procedure TTntCustomEdit.SetSelStart(const Value: Integer);
+begin
+ TntCustomEdit_SetSelStart(Self, Value);
+end;
+
+function TTntCustomEdit.GetSelLength: Integer;
+begin
+ Result := TntCustomEdit_GetSelLength(Self);
+end;
+
+procedure TTntCustomEdit.SetSelLength(const Value: Integer);
+begin
+ TntCustomEdit_SetSelLength(Self, Value);
+end;
+
function TTntCustomEdit.GetSelText: WideString;
begin
Result := TntCustomEdit_GetSelText(Self);
@@ -968,6 +1125,16 @@
TntCustomEdit_SetSelText(Self, Value);
end;
+function TTntCustomEdit.GetPasswordChar: WideChar;
+begin
+ Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar);
+end;
+
+procedure TTntCustomEdit.SetPasswordChar(const Value: WideChar);
+begin
+ TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
+end;
+
function TTntCustomEdit.GetText: WideString;
begin
Result := TntControl_GetText(Self);
@@ -1023,16 +1190,15 @@
Result := SendMessageW(Handle, EM_LINEINDEX, Index, 0);
end;
-function TntMemo_LineLength(Handle: THandle; Index: Integer): Integer;
-var
- SelStart: Integer;
+function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
begin
Assert(Win32PlatformIsUnicode);
- SelStart := TntMemo_LineStart(Handle, Index);
- if SelStart < 0 then
+ if StartPos = -1 then
+ StartPos := TntMemo_LineStart(Handle, Index);
+ if StartPos < 0 then
Result := 0
else
- Result := SendMessageW(Handle, EM_LINELENGTH, SelStart, 0);
+ Result := SendMessageW(Handle, EM_LINELENGTH, StartPos, 0);
end;
function TTntMemoStrings.Get(Index: Integer): WideString;
@@ -1044,6 +1210,8 @@
else begin
SetLength(Result, TntMemo_LineLength(Memo.Handle, Index));
if Length(Result) > 0 then begin
+ if Length(Result) > High(Word) then
+ raise EOutOfResources.Create(SOutlineLongLine);
Word((PWideChar(Result))^) := Length(Result);
Len := SendMessageW(Memo.Handle, EM_GETLINE, Index, Longint(PWideChar(Result)));
SetLength(Result, Len);
@@ -1053,15 +1221,15 @@
procedure TTntMemoStrings.Put(Index: Integer; const S: WideString);
var
- SelStart: Integer;
+ StartPos: Integer;
begin
if (not IsWindowUnicode(Memo.Handle)) then
Memo.Lines[Index] := S
else begin
- SelStart := TntMemo_LineStart(Memo.Handle, Index);
- if SelStart >= 0 then
+ StartPos := TntMemo_LineStart(Memo.Handle, Index);
+ if StartPos >= 0 then
begin
- SendMessageW(Memo.Handle, EM_SETSEL, SelStart, SelStart + TntMemo_LineLength(Memo.Handle, Index));
+ SendMessageW(Memo.Handle, EM_SETSEL, StartPos, StartPos + TntMemo_LineLength(Memo.Handle, Index));
SendMessageW(Memo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(S)));
end;
end;
@@ -1069,16 +1237,16 @@
procedure TTntMemoStrings.Insert(Index: Integer; const S: Widestring);
- function RichEditSelStart: Integer;
+ function RichEditSelStartW: Integer;
var
CharRange: TCharRange;
begin
- SendMessage(Memo.Handle, EM_EXGETSEL, 0, Longint(@CharRange));
+ SendMessageW(Memo.Handle, EM_EXGETSEL, 0, Longint(@CharRange));
Result := CharRange.cpMin;
end;
var
- SelStart, LineLen: Integer;
+ StartPos, LineLen: Integer;
Line: WideString;
begin
if (not IsWindowUnicode(Memo.Handle)) then
@@ -1086,24 +1254,32 @@
else begin
if Index >= 0 then
begin
- SelStart := TntMemo_LineStart(Memo.Handle, Index);
- if SelStart >= 0 then
+ StartPos := TntMemo_LineStart(Memo.Handle, Index);
+ if StartPos >= 0 then
Line := S + CRLF
else begin
- SelStart := TntMemo_LineStart(Memo.Handle, Index - 1);
+ StartPos := TntMemo_LineStart(Memo.Handle, Index - 1);
LineLen := TntMemo_LineLength(Memo.Handle, Index - 1);
if LineLen = 0 then
Exit;
- Inc(SelStart, LineLen);
+ Inc(StartPos, LineLen);
Line := CRLF + s;
end;
+ SendMessageW(Memo.Handle, EM_SETSEL, StartPos, StartPos);
+
if (FRichEditMode)
- and (LineBreakStyle <> tlbsCRLF) then
+ and (LineBreakStyle <> tlbsCRLF) then begin
Line := TntAdjustLineBreaks(Line, LineBreakStyle);
- SendMessageW(Memo.Handle, EM_SETSEL, SelStart, SelStart);
- SendMessageW(Memo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
+ if Line = CR then
+ Line := CRLF; { This helps a ReadOnly RichEdit 4.1 control to insert a blank line. }
+ SendMessageW(Memo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
+ if Line = CRLF then
+ Line := CR;
+ end else
+ SendMessageW(Memo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
+
if (FRichEditMode)
- and (RichEditSelStart <> (SelStart + Length(Line))) then
+ and (RichEditSelStartW <> (StartPos + Length(Line))) then
raise EOutOfResources.Create(sRichEditInsertError);
end;
end;
@@ -1135,8 +1311,14 @@
end;
procedure TTntMemoStrings.SetTextStr(const Value: WideString);
+var
+ NewText: WideString;
begin
- TntControl_SetText(Memo, TntAdjustLineBreaks(Value, LineBreakStyle));
+ NewText := TntAdjustLineBreaks(Value, LineBreakStyle);
+ if NewText <> GetTextStr then begin
+ Memo.HandleNeeded;
+ TntControl_SetText(Memo, NewText);
+ end;
end;
{ TTntCustomMemo }
@@ -1154,7 +1336,7 @@
inherited;
end;
-procedure TTntCustomMemo.SetLines(const Value: TTntWideStrings);
+procedure TTntCustomMemo.SetLines(const Value: TTntStrings);
begin
FLines.Assign(Value);
end;
@@ -1167,9 +1349,29 @@
procedure TTntCustomMemo.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
+function TTntCustomMemo.GetSelStart: Integer;
+begin
+ Result := TntCustomEdit_GetSelStart(Self);
+end;
+
+procedure TTntCustomMemo.SetSelStart(const Value: Integer);
+begin
+ TntCustomEdit_SetSelStart(Self, Value);
+end;
+
+function TTntCustomMemo.GetSelLength: Integer;
+begin
+ Result := TntCustomEdit_GetSelLength(Self);
+end;
+
+procedure TTntCustomMemo.SetSelLength(const Value: Integer);
+begin
+ TntCustomEdit_SetSelLength(Self, Value);
+end;
+
function TTntCustomMemo.GetSelText: WideString;
begin
Result := TntCustomEdit_GetSelText(Self);
@@ -1216,7 +1418,7 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
-{$IFDEF VER150}
+{$IFDEF DELPHI_7}
function TD7PatchedComboBoxStrings.Get(Index: Integer): string{TNT-ALLOW string};
var
Len: Integer;
@@ -1337,51 +1539,71 @@
type TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
-procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var FSaveItems: TTntWideStrings);
-var
- FSaveItemIndex: Integer;
- TntCombo: ITntComboBox;
+{$IFDEF COMPILER_5}
+ THackCustomComboBox = class(TWinControl)
+ protected
+ F_xxxxxxxx_Items: TStrings{TNT-ALLOW TStrings};
+ F_xxxxxxxx_Canvas: TCanvas;
+ F_xxxxxxxx_CharCase: TEditCharCase;
+ F_xxxxxxxx_Sorted: Boolean;
+ F_xxxxxxxx_Style: TComboBoxStyle;
+ F_xxxxxxxx_ItemHeight: Integer;
+ F_xxxxxxxx_MaxLength: Integer;
+ F_xxxxxxxx_DropDownCount: Integer;
+ F_xxxxxxxx_EditHandle: HWnd;
+ F_xxxxxxxx_ListHandle: HWnd;
+ F_xxxxxxxx_EditInstance: Pointer;
+ FListInstance: Pointer;
+ F_xxxxxxxx_DefEditProc: Pointer;
+ FDefListProc: Pointer;
+ end;
+{$ENDIF}
+
+procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- if Win32PlatformIsUnicode then begin
- if ListHandle <> 0 then
- SetWindowLongW(ListHandle, GWL_WNDPROC, GetWindowLong(ListHandle, GWL_WNDPROC));
+ if (not Win32PlatformIsUnicode) then begin
+ TAccessCustomComboBox(Combo).Text := PreInheritedAnsiText;
+ end else begin
+ with TAccessCustomComboBox(Combo) {$IFNDEF COMPILER_6_UP}, THackCustomComboBox(Combo) {$ENDIF} do
+ begin
+ if ListHandle <> 0 then begin
+ // re-extract FDefListProc as a Unicode proc
+ SetWindowLongA(ListHandle, GWL_WNDPROC, Integer(FDefListProc));
+ FDefListProc := Pointer(GetWindowLongW(ListHandle, GWL_WNDPROC));
+ // override with FListInstance as a Unicode proc
+ SetWindowLongW(ListHandle, GWL_WNDPROC, Integer(FListInstance));
+ end;
SetWindowLongW(EditHandle, GWL_WNDPROC, GetWindowLong(EditHandle, GWL_WNDPROC));
- if FSaveItems <> nil then
+ end;
+ if FSaveItems <> nil then
+ begin
+ Items.Assign(FSaveItems);
+ FreeAndNil(FSaveItems);
+ if FSaveItemIndex <> -1 then
begin
- FSaveItemIndex := ItemIndex;
- Items.Assign(FSaveItems);
- FreeAndNil(FSaveItems);
- TntControl_SetText(Combo, TntControl_GetStoredText(Combo, TAccessCustomComboBox(Combo).Text));
- if FSaveItemIndex <> -1 then
- begin
- if Items.Count < FSaveItemIndex then FSaveItemIndex := Items.Count;
- SendMessage(Handle, CB_SETCURSEL, FSaveItemIndex, 0);
- end;
+ if Items.Count < FSaveItemIndex then FSaveItemIndex := Items.Count;
+ SendMessage(Combo.Handle, CB_SETCURSEL, FSaveItemIndex, 0);
end;
+ TntControl_SetText(Combo, TntControl_GetStoredText(Combo, TAccessCustomComboBox(Combo).Text));
end;
end;
end;
-procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var FSaveItems: TTntWideStrings);
-var
- TntCombo: ITntComboBox;
+procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer);
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- if (Win32PlatformIsUnicode) and (Items.Count > 0) and (not (csDestroying in ComponentState))
- then begin
- FSaveItems := TTntWideStringList.Create;
- FSaveItems.Assign(Items);
- end;
+ if (Win32PlatformIsUnicode) and (Items.Count > 0) then
+ begin
+ FSaveItems := TTntStringList.Create;
+ FSaveItems.Assign(Items);
+ FSaveItemIndex:= ItemIndex;
+ Items.Clear; { This keeps TCustomComboBox from creating its own FSaveItems. (this kills the original ItemIndex) }
end;
end;
function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer): Boolean;
+ var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
procedure CallDefaultWindowProc;
begin
@@ -1393,52 +1615,48 @@
end;
end;
-var
- TntCombo: ITntComboBox;
-
function DoWideKeyPress(Message: TWMChar): Boolean;
begin
- TntCombo.DoEditCharMsg(Message);
+ DoEditCharMsg(Message);
Result := (Message.CharCode = 0);
end;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
Result := False;
try
- with TAccessCustomComboBox(Combo), TntCombo do begin
- if (Message.Msg = WM_CHAR) then begin
- // WM_CHAR
- Result := True;
+ if (Message.Msg = WM_CHAR) then begin
+ // WM_CHAR
+ Result := True;
+ if IsWindowUnicode(ComboWnd) then
+ MakeWMCharMsgSafeForAnsi(Message);
+ try
+ if TAccessCustomComboBox(Combo).DoKeyPress(TWMKey(Message)) then Exit;
+ if DoWideKeyPress(TWMKey(Message)) then Exit;
+ finally
if IsWindowUnicode(ComboWnd) then
- MakeWMCharMsgSafeForAnsi(Message);
- try
- if DoKeyPress(TWMKey(Message)) then Exit;
- if DoWideKeyPress(TWMKey(Message)) then Exit;
- finally
- if IsWindowUnicode(ComboWnd) then
- RestoreWMCharMsg(Message);
+ RestoreWMCharMsg(Message);
+ end;
+ with TWMKey(Message) do begin
+ if ((CharCode = VK_RETURN) or (CharCode = VK_ESCAPE)) and Combo.DroppedDown then begin
+ Combo.DroppedDown := False;
+ Exit;
end;
- with TWMKey(Message) do begin
- if ((CharCode = VK_RETURN) or (CharCode = VK_ESCAPE)) and DroppedDown then begin
- DroppedDown := False;
- Exit;
- end;
- end;
+ end;
+ CallDefaultWindowProc;
+ end else if (IsWindowUnicode(ComboWnd)) then begin
+ // UNICODE
+ if IsTextMessage(Message.Msg)
+ or (Message.Msg = EM_REPLACESEL)
+ or (Message.Msg = WM_IME_COMPOSITION)
+ then begin
+ // message w/ text parameter
+ Result := True;
CallDefaultWindowProc;
- end else if (IsWindowUnicode(ComboWnd)) then begin
- // UNICODE
- if IsTextMessage(Message.Msg) then begin
- // WM_*TEXT*
- Result := True;
- CallDefaultWindowProc;
- end else if (Message.Msg = WM_IME_CHAR) then begin
- // WM_IME_CHAR
- Result := True;
- with Message do { convert to WM_CHAR }
- Result := SendMessageW(ComboWnd, WM_CHAR, WParam, LParam);
- end;
+ end else if (Message.Msg = WM_IME_CHAR) then begin
+ // WM_IME_CHAR
+ Result := True;
+ with Message do { convert to WM_CHAR }
+ Result := SendMessageW(ComboWnd, WM_CHAR, WParam, LParam);
end;
end;
except
@@ -1446,66 +1664,82 @@
end;
end;
-function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var Message: TWMCommand): Boolean;
+function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
+begin
+ Result := False;
+ if Message.NotifyCode = CBN_SELCHANGE then begin
+ Result := True;
+ TntControl_SetText(Combo, Items[Combo.ItemIndex]);
+ TAccessCustomComboBox(Combo).Click;
+ {$IFDEF COMPILER_6_UP}
+ TAccessCustomComboBox(Combo).Select;
+ {$ELSE}
+ TAccessCustomComboBox(Combo).Change;
+ {$ENDIF}
+ end;
+end;
+
+function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := Combo.SelStart
+ else
+ Result := Length(WideString(Copy(TAccessCustomComboBox(Combo).Text, 1, Combo.SelStart)));
+end;
+
+procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
+begin
+ if Win32PlatformIsUnicode then
+ Combo.SelStart := Value
+ else
+ Combo.SelStart := Length(AnsiString(Copy(TntControl_GetText(Combo), 1, Value)));
+end;
+
+function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
+begin
+ if Win32PlatformIsUnicode then
+ Result := Combo.SelLength
+ else
+ Result := Length(TntCombo_GetSelText(Combo));
+end;
+
+procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
var
- TntCombo: ITntComboBox;
+ StartPos: Integer;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- Result := False;
- if Message.NotifyCode = CBN_SELCHANGE then begin
- Result := True;
- Text := Items[ItemIndex];
- Click;
- {$IFDEF VER130}
- Change;
- {$ELSE}
- Select;
- {$ENDIF}
- end;
+ if Win32PlatformIsUnicode then
+ Combo.SelLength := Value
+ else begin
+ StartPos := TntCombo_GetSelStart(Combo);
+ Combo.SelLength := Length(AnsiString(Copy(TntControl_GetText(Combo), StartPos + 1, Value)));
end;
end;
function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
-var
- TntCombo: ITntComboBox;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- if (not IsWindowUnicode(Handle)) then
- Result := Combo.SelText
- else begin
- Result := '';
- if Style < csDropDownList then
- Result := Copy(Text, SelStart + 1, SelLength);
- end;
- end;
+ if Win32PlatformIsUnicode then begin
+ Result := '';
+ if TAccessCustomComboBox(Combo).Style < csDropDownList then
+ Result := Copy(TntControl_GetText(Combo), Combo.SelStart + 1, Combo.SelLength);
+ end else
+ Result := Combo.SelText
end;
procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
-var
- TntCombo: ITntComboBox;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- if (not IsWindowUnicode(Handle)) then
- Combo.SelText := Value
- else begin
- if Style < csDropDownList then
- begin
- HandleNeeded;
- SendMessageW(EditHandle, EM_REPLACESEL, 0, Longint(PWideChar(Value)));
- end;
+ if Win32PlatformIsUnicode then begin
+ if TAccessCustomComboBox(Combo).Style < csDropDownList then
+ begin
+ Combo.HandleNeeded;
+ SendMessageW(TAccessCustomComboBox(Combo).EditHandle, EM_REPLACESEL, 0, Longint(PWideChar(Value)));
end;
- end;
+ end else
+ Combo.SelText := Value
end;
procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
begin
- {$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
SaveAutoComplete := TAccessCustomComboBox(Combo).AutoComplete;
TAccessCustomComboBox(Combo).AutoComplete := False;
{$ENDIF}
@@ -1513,184 +1747,177 @@
procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
begin
- {$IFNDEF VER130}
+ {$IFDEF COMPILER_6_UP}
TAccessCustomComboBox(Combo).AutoComplete := SaveAutoComplete;
{$ENDIF}
end;
procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
var
- TntCombo: ITntComboBox;
OldSelStart, OldSelLength: Integer;
OldText: WideString;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- OldText := Text;
- OldSelStart := SelStart;
- OldSelLength := SelLength;
- DroppedDown := True;
- Text := OldText;
- SelStart := OldSelStart;
- SelLength := OldSelLength;
- end;
+ OldText := TntControl_GetText(Combo);
+ OldSelStart := TntCombo_GetSelStart(Combo);
+ OldSelLength := TntCombo_GetSelLength(Combo);
+ Combo.DroppedDown := True;
+ TntControl_SetText(Combo, OldText);
+ TntCombo_SetSelStart(Combo, OldSelStart);
+ TntCombo_SetSelLength(Combo ,OldSelLength);
end;
-procedure TntComboBox_AddItem(Items: TTntWideStrings; const Item: WideString; AObject: TObject);
+procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
begin
Items.AddObject(Item, AObject);
end;
-{$IFNDEF VER130}
-procedure TntComboBox_CopySelection(Items: TTntWideStrings; ItemIndex: Integer;
+{$IFDEF COMPILER_6_UP}
+procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
Destination: TCustomListControl);
begin
if ItemIndex <> -1 then
WideListControl_AddItem(Destination, Items[ItemIndex], Items.Objects[ItemIndex]);
end;
-function TntCombo_FindString(hWnd: THandle; StartPos: Integer; const Text: WideString): Integer;
+function TntCombo_FindString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ StartPos: Integer; const Text: WideString): Integer;
+var
+ ComboFindString: ITntComboFindString;
begin
- if IsWindowUnicode(hWnd) then
- Result := SendMessageW(hWnd, CB_FINDSTRING, StartPos, Integer(PWideChar(Text)))
+ if Combo.GetInterface(ITntComboFindString, ComboFindString) then
+ Result := ComboFindString.FindString(Text, StartPos)
+ else if IsWindowUnicode(Combo.Handle) then
+ Result := SendMessageW(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PWideChar(Text)))
else
- Result := SendMessageA(hWnd, CB_FINDSTRING, StartPos, Integer(PAnsiChar(AnsiString(Text))))
+ Result := SendMessageA(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PAnsiChar(AnsiString(Text))))
end;
-function TntCombo_FindUniqueString(hWnd: THandle; StartPos: Integer; const Text: WideString): Integer;
+function TntCombo_FindUniqueString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ StartPos: Integer; const Text: WideString): Integer;
var
Match_1, Match_2: Integer;
begin
Result := CB_ERR;
- Match_1 := TntCombo_FindString(hWnd, -1, Text);
+ Match_1 := TntCombo_FindString(Combo, -1, Text);
if Match_1 <> CB_ERR then begin
- Match_2 := TntCombo_FindString(hWnd, Match_1, Text);
+ Match_2 := TntCombo_FindString(Combo, Match_1, Text);
if Match_2 = Match_1 then
Result := Match_1;
end;
end;
-function TntCombo_AutoSelect(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const SearchText: WideString;
- UniqueMatchOnly: Boolean; UseDataEntryCase: Boolean): Boolean;
+function TntCombo_AutoSelect(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings;
+ const SearchText: WideString; UniqueMatchOnly: Boolean; UseDataEntryCase: Boolean): Boolean;
var
Idx: Integer;
ValueChange: Boolean;
- TntCombo: ITntComboBox;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- if UniqueMatchOnly then
- Idx := TntCombo_FindUniqueString(Handle, -1, SearchText)
- else
- Idx := TntCombo_FindString(Handle, -1, SearchText);
- Result := (Idx <> CB_ERR);
- if Result then begin
- ValueChange := Idx <> ItemIndex;
- {$IFDEF VER150}
- // auto-closeup
- if AutoCloseUp and (Items.IndexOf(SearchText) <> -1) then
- DroppedDown := False;
- {$ENDIF}
- // select item
- ItemIndex := Idx;
- // update edit
- if (Style in [csDropDown, csSimple]) then begin
- if UseDataEntryCase then begin
- // preserve case of characters as they are entered
- Text := SearchText + Copy(Items[ItemIndex], Length(SearchText) + 1, MaxInt);
- end;
- // select the rest of the string
- SelStart := Length(SearchText);
- SelLength := Length(Text) - SelStart;
+ if UniqueMatchOnly then
+ Idx := TntCombo_FindUniqueString(Combo, -1, SearchText)
+ else
+ Idx := TntCombo_FindString(Combo, -1, SearchText);
+ Result := (Idx <> CB_ERR);
+ if Result then begin
+ ValueChange := Idx <> Combo.ItemIndex;
+ {$IFDEF COMPILER_7_UP}
+ // auto-closeup
+ if Combo.AutoCloseUp and (Items.IndexOf(SearchText) <> -1) then
+ Combo.DroppedDown := False;
+ {$ENDIF}
+ // select item
+ Combo.ItemIndex := Idx;
+ // update edit
+ if (TAccessCustomComboBox(Combo).Style in [csDropDown, csSimple]) then begin
+ if UseDataEntryCase then begin
+ // preserve case of characters as they are entered
+ TntControl_SetText(Combo, SearchText + Copy(Items[Combo.ItemIndex], Length(SearchText) + 1, MaxInt));
end;
- // notify events
- if ValueChange then begin
- Click;
- Select;
- end;
+ // select the rest of the string
+ TntCombo_SetSelStart(Combo, Length(SearchText));
+ TntCombo_SetSelLength(Combo, Length(TntControl_GetText(Combo)) - TntCombo_GetSelStart(Combo));
end;
+ // notify events
+ if ValueChange then begin
+ TAccessCustomComboBox(Combo).Click;
+ TAccessCustomComboBox(Combo).Select;
+ end;
end;
end;
-procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var Message: TWMChar;
- var FFilter: WideString; var FLastTime: Cardinal);
+procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
var
- TntCombo: ITntComboBox;
Key: WideChar;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- Assert(not (Style in [csSimple, csDropDown]), 'Internal Error: TntCombo_AutoSearchKeyPress is not for csSimple and csDropDown style combo boxes.');
- if not AutoComplete then exit;
- Key := GetWideCharFromWMCharMsg(Message);
- try
- case Ord(Key) of
- VK_ESCAPE:
- exit;
- VK_TAB:
- if AutoDropDown and DroppedDown then
- DroppedDown := False;
- VK_BACK:
- Delete(FFilter, Length(FFilter), 1);
- else begin
- if AutoDropDown and (not DroppedDown) then
- Combo.DroppedDown := True;
- // reset FFilter if it's been too long (0.5 sec)
- if GetTickCount - FLastTime >= 500 then
- FFilter := '';
- FLastTime := GetTickCount;
- // if AutoSelect works, remember new FFilter
- if TntCombo_AutoSelect(Combo, FFilter + Key, False, True) then begin
- FFilter := FFilter + Key;
- Key := #0;
- end;
+ if TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown] then
+ exit;
+ if not Combo.AutoComplete then
+ exit;
+ Key := GetWideCharFromWMCharMsg(Message);
+ try
+ case Ord(Key) of
+ VK_ESCAPE:
+ exit;
+ VK_TAB:
+ if Combo.AutoDropDown and Combo.DroppedDown then
+ Combo.DroppedDown := False;
+ VK_BACK:
+ Delete(FFilter, Length(FFilter), 1);
+ else begin
+ if Combo.AutoDropDown and (not Combo.DroppedDown) then
+ Combo.DroppedDown := True;
+ // reset FFilter if it's been too long (1.25 sec) { Windows XP is actually 2 seconds! }
+ if GetTickCount - FLastTime >= 1250 then
+ FFilter := '';
+ FLastTime := GetTickCount;
+ // if AutoSelect works, remember new FFilter
+ if TntCombo_AutoSelect(Combo, Items, FFilter + Key, False, True) then begin
+ FFilter := FFilter + Key;
+ Key := #0;
end;
end;
- finally
- SetWideCharForWMCharMsg(Message, Key);
end;
+ finally
+ SetWideCharForWMCharMsg(Message, Key);
end;
end;
-procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var Message: TWMChar);
+procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
+ Items: TTntStrings; var Message: TWMChar;
+ AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
var
- TntCombo: ITntComboBox;
Key: WideChar;
+ FindText: WideString;
begin
- Combo.GetInterface(ITntComboBox, TntCombo);
- Assert(TntCombo <> nil);
- with TAccessCustomComboBox(Combo), TntCombo do begin
- Assert(Style in [csSimple, csDropDown], 'Internal Error: TntCombo_AutoCompleteKeyPress is only for csSimple and csDropDown style combo boxes.');
- if not AutoComplete then exit;
- Key := GetWideCharFromWMCharMsg(Message);
- try
- case Ord(Key) of
- VK_ESCAPE:
- exit;
- VK_TAB:
- if AutoDropDown and DroppedDown then
- DroppedDown := False;
- VK_BACK:
- exit;
- else begin
- if AutoDropDown and (not DroppedDown) then
- TntCombo_DropDown_PreserveSelection(Combo);
- // AutoComplete only if the selection is at the very end
- if ((SelStart + SelLength) = Length(Text)) then begin
- Text := Copy(Text, 1, SelStart) + Key;
- Change;
- SelStart := Length(Text);
- TntCombo_AutoSelect(Combo, Text, AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase);
+ Assert(TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown], 'Internal Error: TntCombo_AutoCompleteKeyPress is only for csSimple and csDropDown style combo boxes.');
+ if not Combo.AutoComplete then exit;
+ Key := GetWideCharFromWMCharMsg(Message);
+ try
+ case Ord(Key) of
+ VK_ESCAPE:
+ exit;
+ VK_TAB:
+ if Combo.AutoDropDown and Combo.DroppedDown then
+ Combo.DroppedDown := False;
+ VK_BACK:
+ exit;
+ else begin
+ if Combo.AutoDropDown and (not Combo.DroppedDown) then
+ TntCombo_DropDown_PreserveSelection(Combo);
+ // AutoComplete only if the selection is at the very end
+ if ((TntCombo_GetSelStart(Combo) + TntCombo_GetSelLength(Combo))
+ = Length(TntControl_GetText(Combo))) then
+ begin
+ FindText := Copy(TntControl_GetText(Combo), 1, TntCombo_GetSelStart(Combo)) + Key;
+ if TntCombo_AutoSelect(Combo, Items, FindText, AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase) then
+ begin
Key := #0;
end;
end;
end;
- finally
- SetWideCharForWMCharMsg(Message, Key);
end;
+ finally
+ SetWideCharForWMCharMsg(Message, Key);
end;
end;
{$ENDIF}
@@ -1718,24 +1945,27 @@
procedure TTntCustomComboBox.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomComboBox.CreateWnd;
+var
+ PreInheritedAnsiText: AnsiString;
begin
+ PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
inherited;
- TntCombo_AfterInherited_CreateWnd(Self, FSaveItems);
+ TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
end;
procedure TTntCustomComboBox.DestroyWnd;
begin
- TntCombo_BeforeInherited_DestroyWnd(Self, FSaveItems);
+ TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex);
inherited;
end;
procedure TTntCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
begin
- if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc) then
+ if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
inherited;
end;
@@ -1753,97 +1983,94 @@
procedure TTntCustomComboBox.DoEditCharMsg(var Message: TWMChar);
begin
- {$IFNDEF VER130}
- TntCombo_AutoCompleteKeyPress(Self, Message);
+ {$IFDEF COMPILER_6_UP}
+ TntCombo_AutoCompleteKeyPress(Self, Items, Message,
+ GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
{$ENDIF}
end;
procedure TTntCustomComboBox.WMChar(var Message: TWMChar);
begin
- {$IFNDEF VER130}
- TntCombo_AutoSearchKeyPress(Self, Message, FFilter, FLastTime);
+ {$IFDEF COMPILER_6_UP}
+ TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
{$ENDIF}
- inherited;
+ if Message.CharCode <> 0 then
+ inherited;
end;
+procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
+ State: TOwnerDrawState; Items: TTntStrings);
+begin
+ Canvas.FillRect(Rect);
+ if Index >= 0 then
+ WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Items[Index]);
+end;
+
procedure TTntCustomComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
TControlCanvas(Canvas).UpdateTextFlags;
if Assigned(OnDrawItem) then
OnDrawItem(Self, Index, Rect, State)
- else begin
- Canvas.FillRect(Rect);
- if Index >= 0 then
- WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Items[Index]);
- end;
+ else
+ TntCombo_DefaultDrawItem(Canvas, Index, Rect, State, Items);
end;
-function TTntCustomComboBox.GetItems: TTntWideStrings;
+function TTntCustomComboBox.GetItems: TTntStrings;
begin
Result := FItems;
end;
-procedure TTntCustomComboBox.SetItems(const Value: TTntWideStrings);
+procedure TTntCustomComboBox.SetItems(const Value: TTntStrings);
begin
FItems.Assign(Value);
end;
-function TTntCustomComboBox.GetSelText: WideString;
+function TTntCustomComboBox.GetSelStart: Integer;
begin
- Result := TntCombo_GetSelText(Self);
+ Result := TntCombo_GetSelStart(Self);
end;
-procedure TTntCustomComboBox.SetSelText(const Value: WideString);
+procedure TTntCustomComboBox.SetSelStart(const Value: Integer);
begin
- TntCombo_SetSelText(Self, Value);
+ TntCombo_SetSelStart(Self, Value);
end;
-function TTntCustomComboBox.GetText: WideString;
+function TTntCustomComboBox.GetSelLength: Integer;
begin
- Result := TntControl_GetText(Self);
+ Result := TntCombo_GetSelLength(Self);
end;
-procedure TTntCustomComboBox.SetText(const Value: WideString);
+procedure TTntCustomComboBox.SetSelLength(const Value: Integer);
begin
- TntControl_SetText(Self, Value);
+ TntCombo_SetSelLength(Self, Value);
end;
-procedure TTntCustomComboBox.CNCommand(var Message: TWMCommand);
+function TTntCustomComboBox.GetSelText: WideString;
begin
- if not TntCombo_CNCommand(Self, Message) then
- inherited;
+ Result := TntCombo_GetSelText(Self);
end;
-function TTntCustomComboBox.GetSelLength: Integer;
+procedure TTntCustomComboBox.SetSelText(const Value: WideString);
begin
- Result := SelLength;
+ TntCombo_SetSelText(Self, Value);
end;
-procedure TTntCustomComboBox.SetSelLength(Value: Integer);
+function TTntCustomComboBox.GetText: WideString;
begin
- SelLength := Value;
+ Result := TntControl_GetText(Self);
end;
-function TTntCustomComboBox.GetSelStart: Integer;
+procedure TTntCustomComboBox.SetText(const Value: WideString);
begin
- Result := SelStart;
+ TntControl_SetText(Self, Value);
end;
-procedure TTntCustomComboBox.SetSelStart(Value: Integer);
+procedure TTntCustomComboBox.CNCommand(var Message: TWMCommand);
begin
- SelStart := Value;
+ if not TntCombo_CNCommand(Self, Items, Message) then
+ inherited;
end;
-function TTntCustomComboBox.GetItemIndex: Integer;
-begin
- Result := ItemIndex;
-end;
-
-procedure TTntCustomComboBox.SetItemIndex(const Value: Integer);
-begin
- ItemIndex := Value;
-end;
-
function TTntCustomComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
begin
Result := True;
@@ -1874,7 +2101,7 @@
TntComboBox_AddItem(Items, Item, AObject);
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure TTntCustomComboBox.CopySelection(Destination: TCustomListControl);
begin
TntComboBox_CopySelection(Items, ItemIndex, Destination);
@@ -1892,7 +2119,7 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
-{$IFDEF VER150}
+{$IFDEF DELPHI_7}
function TTntCustomComboBox.GetItemsClass: TCustomComboBoxStringsClass;
begin
Result := TD7PatchedComboBoxStrings;
@@ -2054,7 +2281,7 @@
//-- list box helper procs
procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- var FSaveItems: TTntWideStrings; FItems: TTntWideStrings; FSaveTopIndex, FSaveItemIndex: Integer);
+ var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
begin
if FSaveItems <> nil then
begin
@@ -2066,21 +2293,22 @@
end;
procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- var FSaveItems: TTntWideStrings; const FItems: TTntWideStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
+ var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
begin
if (FItems.Count > 0)
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
and (not (TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw]))
{$ENDIF}
then begin
- FSaveItems := TTntWideStringList.Create;
+ FSaveItems := TTntStringList.Create;
FSaveItems.Assign(FItems);
FSaveTopIndex := ListBox.TopIndex;
FSaveItemIndex := ListBox.ItemIndex;
+ ListBox.Items.Clear; { This keeps TCustomListBox from creating its own FSaveItems. (this kills the original ItemIndex) }
end;
end;
-procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntWideStrings; Index: Integer; Rect: TRect);
+procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
var
Flags: Integer;
Canvas: TCanvas;
@@ -2098,14 +2326,14 @@
end;
end;
-procedure TntListBox_AddItem(Items: TTntWideStrings; const Item: WideString; AObject: TObject);
+procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
begin
Items.AddObject(PWideChar(Item), AObject);
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
- Items: TTntWideStrings; Destination: TCustomListControl);
+ Items: TTntStrings; Destination: TCustomListControl);
var
I: Integer;
begin
@@ -2119,6 +2347,70 @@
if Listbox.ItemIndex <> -1 then
WideListControl_AddItem(Destination, PWideChar(Items[ListBox.ItemIndex]), Items.Objects[ListBox.ItemIndex]);
end;
+
+function TntCustomListBox_GetOwnerData(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; Index: Integer; out Data: WideString): Boolean;
+var
+ AnsiData: AnsiString;
+begin
+ Result := False;
+ Data := '';
+ if (Index > -1) and (Index < ListBox.Count) then begin
+ if Assigned(OnData) then begin
+ OnData(ListBox, Index, Data);
+ Result := True;
+ end else if Assigned(TAccessCustomListBox(ListBox).OnData) then begin
+ AnsiData := '';
+ TAccessCustomListBox(ListBox).OnData(ListBox, Index, AnsiData);
+ Data := AnsiData;
+ Result := True;
+ end;
+ end;
+end;
+
+function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
+var
+ S: WideString;
+ AnsiS: AnsiString;
+begin
+ if TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw] then
+ begin
+ Result := True;
+ if TntCustomListBox_GetOwnerData(ListBox, OnData, Message.WParam, S) then begin
+ if Win32PlatformIsUnicode then begin
+ StrCopyW(PWideChar(Message.LParam), PWideChar(S));
+ Message.Result := Length(S);
+ end else begin
+ AnsiS := S;
+ StrCopy{TNT-ALLOW StrCopy}(PAnsiChar(Message.LParam), PAnsiChar(AnsiS));
+ Message.Result := Length(AnsiS);
+ end;
+ end
+ else
+ Message.Result := LB_ERR;
+ end
+ else
+ Result := False;
+end;
+
+function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
+var
+ S: WideString;
+begin
+ if TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw] then
+ begin
+ Result := True;
+ if TntCustomListBox_GetOwnerData(ListBox, OnData, Message.WParam, S) then begin
+ if Win32PlatformIsUnicode then
+ Message.Result := Length(S)
+ else
+ Message.Result := Length(AnsiString(S));
+ end else
+ Message.Result := LB_ERR;
+ end
+ else
+ Result := False;
+end;
+
{$ENDIF}
{ TTntCustomListBox }
@@ -2145,7 +2437,7 @@
procedure TTntCustomListBox.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomListBox.CreateWnd;
@@ -2160,7 +2452,7 @@
inherited;
end;
-procedure TTntCustomListBox.SetItems(const Value: TTntWideStrings);
+procedure TTntCustomListBox.SetItems(const Value: TTntStrings);
begin
FItems.Assign(Value);
end;
@@ -2193,7 +2485,7 @@
TntListBox_AddItem(Items, Item, AObject);
end;
-{$IFNDEF VER130}
+{$IFDEF COMPILER_6_UP}
procedure TTntCustomListBox.CopySelection(Destination: TCustomListControl);
begin
TntListBox_CopySelection(Self, Items, Destination);
@@ -2211,11 +2503,63 @@
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
-{ TTntCustomLabel }
+{$IFDEF COMPILER_6_UP}
+procedure TTntCustomListBox.LBGetText(var Message: TMessage);
+begin
+ if not TntCustomListBox_LBGetText(Self, OnData, Message) then
+ inherited;
+end;
-procedure TTntCustomLabel.CMDialogChar(var Message: TCMDialogChar);
+procedure TTntCustomListBox.LBGetTextLen(var Message: TMessage);
begin
- if (FocusControl <> nil) and Enabled and ShowAccelChar and
+ if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
+ inherited;
+end;
+{$ENDIF}
+
+// --- label helper procs
+
+type TAccessCustomLabel = class(TCustomLabel{TNT-ALLOW TCustomLabel});
+
+function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
+var
+ Text: WideString;
+ ShowAccelChar: Boolean;
+ Canvas: TCanvas;
+begin
+ Result := False;
+ if Win32PlatformIsUnicode then begin
+ Result := True;
+ Text := GetLabelText;
+ ShowAccelChar := TAccessCustomLabel(Control).ShowAccelChar;
+ Canvas := Control.Canvas;
+ if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
+ (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
+ if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
+ Flags := Control.DrawTextBiDiModeFlags(Flags);
+ Canvas.Font := TAccessCustomLabel(Control).Font;
+ if not Control.Enabled then
+ begin
+ OffsetRect(Rect, 1, 1);
+ Canvas.Font.Color := clBtnHighlight;
+ Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
+ OffsetRect(Rect, -1, -1);
+ Canvas.Font.Color := clBtnShadow;
+ Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
+ end
+ else
+ Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
+ end;
+end;
+
+procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
+var
+ FocusControl: TWinControl;
+ ShowAccelChar: Boolean;
+begin
+ FocusControl := TAccessCustomLabel(Control).FocusControl;
+ ShowAccelChar := TAccessCustomLabel(Control).ShowAccelChar;
+ if (FocusControl <> nil) and Control.Enabled and ShowAccelChar and
IsWideCharAccel(Message.CharCode, Caption) then
with FocusControl do
if CanFocus then
@@ -2225,6 +2569,13 @@
end;
end;
+{ TTntCustomLabel }
+
+procedure TTntCustomLabel.CMDialogChar(var Message: TCMDialogChar);
+begin
+ TntLabel_CMDialogChar(Self, Message, Caption);
+end;
+
function TTntCustomLabel.IsCaptionStored: Boolean;
begin
Result := TntControl_IsCaptionStored(Self)
@@ -2243,7 +2594,7 @@
procedure TTntCustomLabel.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomLabel.GetLabelText: WideString;
@@ -2252,30 +2603,9 @@
end;
procedure TTntCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
-var
- Text: WideString;
begin
- if not Win32PlatformIsUnicode then
- inherited
- else begin
- Text := GetLabelText;
- if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
- (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
- if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
- Flags := DrawTextBiDiModeFlags(Flags);
- Canvas.Font := Font;
- if not Enabled then
- begin
- OffsetRect(Rect, 1, 1);
- Canvas.Font.Color := clBtnHighlight;
- DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
- OffsetRect(Rect, -1, -1);
- Canvas.Font.Color := clBtnShadow;
- DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
- end
- else
- DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
- end;
+ if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
+ inherited;
end;
function TTntCustomLabel.IsHintStored: Boolean;
@@ -2332,7 +2662,7 @@
procedure TTntButton.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntButton.CMDialogChar(var Message: TCMDialogChar);
@@ -2391,7 +2721,7 @@
procedure TTntCustomCheckBox.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
@@ -2458,7 +2788,7 @@
procedure TTntRadioButton.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntRadioButton.CMDialogChar(var Message: TCMDialogChar);
@@ -2524,7 +2854,7 @@
procedure TTntScrollBar.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntScrollBar.IsHintStored: Boolean;
@@ -2563,7 +2893,7 @@
procedure TTntCustomGroupBox.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
@@ -2595,7 +2925,7 @@
procedure TTntCustomGroupBox.Paint;
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
procedure PaintThemedGroupBox;
var
CaptionRect: TRect;
@@ -2662,9 +2992,9 @@
else
R := Rect(R.Right - WideCanvasTextWidth(Canvas, Caption) - 8, 0, 0, H);
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
- DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags or DT_CALCRECT);
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags or DT_CALCRECT);
Brush.Color := Color;
- DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags);
+ Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags);
end;
end;
end;
@@ -2675,7 +3005,7 @@
else
begin
Canvas.Font := Self.Font;
- {$IFDEF VER150}
+ {$IFDEF THEME_7_UP}
if ThemeServices.ThemesEnabled then
PaintThemedGroupBox
else
@@ -2722,19 +3052,19 @@
procedure TTntCustomStaticText.DefineProperties(Filer: TFiler);
begin
inherited;
- DefineWideProperties(Filer, Self);
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomStaticText.CMDialogChar(var Message: TCMDialogChar);
begin
- with Message do
- if IsWideCharAccel(Message.CharCode, Caption)
- and CanFocus then
+ if (FocusControl <> nil) and Enabled and ShowAccelChar and
+ IsWideCharAccel(Message.CharCode, Caption) then
+ with FocusControl do
+ if CanFocus then
begin
- Click;
- Result := 1;
- end else
- Broadcast(Message);
+ SetFocus;
+ Message.Result := 1;
+ end;
end;
function TTntCustomStaticText.IsCaptionStored: Boolean;
Modified: trunk/TntUnicodeControls/TntThemeMgr.pas
===================================================================
--- trunk/TntUnicodeControls/TntThemeMgr.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/TntThemeMgr.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -1,15 +1,18 @@
-{*******************************************************}
-{ The Delphi Unicode Controls Project }
-{ }
-{ http://home.ccci.org/wolbrink }
-{ }
-{ Copyright (c) 2002, Troy Wolbrink (wolbrink at ccci.org) }
-{ }
-{*******************************************************}
+{*****************************************************************************}
+{ }
+{ 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 TntThemeMgr;
+{$INCLUDE TntCompilers.inc}
+
//---------------------------------------------------------------------------------------------
// TTntThemeManager is a TThemeManager descendant that knows about Tnt Unicode controls.
// Most of the code is a complete copy from the Mike Lischke's original with only a
@@ -25,8 +28,6 @@
interface
-{$I Compilers.inc}
-
uses
Windows, Sysutils, Messages, Classes, Controls, Graphics, Buttons, ComCtrls, ThemeMgr, ThemeSrv;
@@ -69,7 +70,7 @@
uses
TntClasses, TntControls, StdCtrls, TntStdCtrls, TntButtons, TntCheckLst, ExtCtrls,
- TntExtCtrls, TntGraphics;
+ TntExtCtrls, TntGraphics, TntWindows;
procedure Register;
begin
@@ -313,7 +314,7 @@
{$endif COMPILER_6_UP}
Data := Items[Index];
- DrawTextW(Canvas.Handle, PWideChar(Data), Length(Data), Rect, Flags);
+ Tnt_DrawTextW(Canvas.Handle, PWideChar(Data), Length(Data), Rect, Flags);
end;
end;
end;
@@ -427,7 +428,7 @@
OldFont := SelectObject(DC, Font.Handle);
SetBKMode(DC, TRANSPARENT);
SetTextColor(DC, ColorToRGB(Font.Color));
- DrawTextW(DC, PWideChar(Caption), -1, Rect, Flags);
+ Tnt_DrawTextW(DC, PWideChar(Caption), -1, Rect, Flags);
SelectObject(DC, OldFont);
finally
Canvas.Handle := 0;
@@ -674,11 +675,11 @@
SetBkMode(DC, TRANSPARENT);
if Control is TTntBitBtn then begin
with TTntBitBtn(Control) do
- DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER)
+ Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER)
end else begin
Assert(Control is TTntSpeedButton, 'TNT Internal Error: Wrong button type in TTntThemeManagerHelper.DrawButton');
with TTntSpeedButton(Control) do
- DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER)
+ Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER)
end;
with Glyph do
if not Empty then
Modified: trunk/TntUnicodeControls/Unicode.pas
===================================================================
--- trunk/TntUnicodeControls/Unicode.pas 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/TntUnicodeControls/Unicode.pas 2006-07-31 00:29:57 UTC (rev 434)
@@ -103,7 +103,7 @@
FormFeed = WideChar($C);
CR = WideChar($D);
CarriageReturn = WideChar($D);
- CRLF: WideString = #$D#$A;
+// CRLF: WideString = #$D#$A;
LineSeparator = WideChar($2028);
ParagraphSeparator = WideChar($2029);
Modified: trunk/mainfrm.cpp
===================================================================
--- trunk/mainfrm.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/mainfrm.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -3,6 +3,7 @@
#include <vcl/clipbrd.hpp>
#pragma hdrstop
+#include "TntSystem.hpp"
#include "mainfrm.h"
#include "swdisprtfchap.h"
#include "searchfrm.h"
@@ -40,6 +41,7 @@
#pragma link "TntComCtrls"
#pragma link "TntExtCtrls"
#pragma link "TntMenus"
+#pragma link "Unicode"
#pragma resource "*.dfm"
static const char *rtfclasses[] = {"RTFDisp", "SWDisplay", "SWObject", 0};
@@ -117,7 +119,8 @@
verStr2 = 0;
}
- freeHandLookup->Text = UTF8ToWideString(verse);
+
+ freeHandLookup->Text = UTF8Decode(verse);
// freeHandLookup->Text = verse;
freeHandLookupKeyPress(0, '\r');
@@ -1898,9 +1901,13 @@
ListKey tmpVerseList = DefaultVSKey->ParseVerseList(WideStringToUTF8(freeHandLookup->Text).c_str(), *DefaultVSKey);
if (tmpVerseList.Count()) {
+ // see if we already have an entry
int index = freeHandLookup->Items->IndexOf(freeHandLookup->Text);
+
+ // insert out entry at the top
freeHandLookup->Items->Insert(0, freeHandLookup->Text);
+ // if we had an entry, let's get rid of it.
if (index >= 0)
freeHandLookup->Items->Delete(index+1);
Modified: trunk/mainfrm.h
===================================================================
--- trunk/mainfrm.h 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/mainfrm.h 2006-07-31 00:29:57 UTC (rev 434)
@@ -54,7 +54,7 @@
#include <list>
#include <vector>
-#define _tr(text) UTF8ToWideString(LocaleMgr::getSystemLocaleMgr()->translate(text))
+#define _tr(text) UTF8Decode(LocaleMgr::getSystemLocaleMgr()->translate(text))
//#define _tr(text) LocaleMgr::getSystemLocaleMgr()->translate(text)
#define MONITOR_CENTER 0x0001 // center rect to monitor
#define MONITOR_CLIP 0x0000 // clip rect to monitor
Modified: trunk/searchfrm.cpp
===================================================================
--- trunk/searchfrm.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/searchfrm.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -2,6 +2,7 @@
#include <vcl\vcl.h>
#pragma hdrstop
+#include "TntSystem.hpp"
#include "searchfrm.h"
#include <listkey.h>
#include "mainfrm.h"
@@ -70,7 +71,7 @@
if (target) {
AnsiString cap = _tr("Searching");
cap += (AnsiString)" [ " + (AnsiString)target->Description() + (AnsiString)" (" + (AnsiString)target->Name() + (AnsiString)") ]...";
- Caption = UTF8ToWideString(cap);
+ Caption = UTF8Decode(cap);
resultsLV->Items->Clear();
int searchType;
switch (searchTypeGroup->ItemIndex) {
@@ -97,7 +98,7 @@
searchBtn->Caption = _tr("Halt");
searchBtn->OnClick = TerminateSearch;
- searchThread = new TSearchThread(this, WideStringToUTF8(SearchText->Text).c_str(), searchType, searchOptions, scope);
+ searchThread = new TSearchThread(this, UTF8Encode(SearchText->Text).c_str(), searchType, searchOptions, scope);
}
else Caption = "Error finding target module";
}
@@ -117,10 +118,10 @@
if (focused) {
int row = focused->Index;
SWKey *key = (SWKey *)*target;
- (*key) = WideStringToUTF8(resultsLV->Items->Item[row]->Caption).c_str();
+ (*key) = UTF8Encode(resultsLV->Items->Item[row]->Caption).c_str();
if (targetpc == Form1->LexDictPageControl) {
-// Form1->DictKeyEdit->Text = UTF8ToWideString(resultsLV->Items->Item[row]->Caption.c_str());
- Form1->DictKeyEdit->Text = WideStringToUTF8(resultsLV->Items->Item[row]->Caption).c_str();
+// Form1->DictKeyEdit->Text = UTF8Decode(resultsLV->Items->Item[row]->Caption.c_str());
+ Form1->DictKeyEdit->Text = UTF8Encode(resultsLV->Items->Item[row]->Caption).c_str();
}
else {
Form1->TextKeyChanged();
@@ -138,7 +139,7 @@
int row = focused->Index;
ListKey verse;
SWKey *key = target->CreateKey();
- *key = WideStringToUTF8(resultsLV->Items->Item[row]->Caption).c_str();
+ *key = UTF8Encode(resultsLV->Items->Item[row]->Caption).c_str();
verse << *key;
delete key;
pvrtf->fillWithVerses(target, &verse, 0, true, false, "Search");
@@ -192,7 +193,7 @@
for (results = TOP; !results.Error(); results++) {
parent->target->setKey(results);
pItem = parent->resultsLV->Items->Add();
- pItem->Caption = UTF8ToWideString((const char *)results);
+ pItem->Caption = UTF8Decode((const char *)results);
pItem->SubItems->Add("");
// pItem->SubItems->Add((*parent->target).second->StripText());
// pItem = resultsLV->Items->Add(
@@ -203,7 +204,7 @@
// ListBox1->Items->Pack(); // so Count is set correctly (per helpfile)
AnsiString cap = ((AnsiString)parent->resultsLV->Items->Count + (AnsiString)" " + (AnsiString)((parent->resultsLV->Items->Count == 1) ? _tr("match") : _tr("matches"))) + (AnsiString)" from [ " + (AnsiString)parent->target->Description() + (AnsiString)" (" + (AnsiString)parent->target->Name() + (AnsiString)") ]";
- parent->Caption = UTF8ToWideString(cap);
+ parent->Caption = UTF8Decode(cap);
parent->searchBtn->Caption = _tr("Search");
parent->searchBtn->OnClick = parent->searchBtnClick;
parent->progressBar->Position = 0;
@@ -256,7 +257,7 @@
end = config.Sections["CustomRanges"].end();
while (loop != end) {
TCustomRange *rs = new TCustomRange(loop->first.c_str(), loop->second.c_str());
- ComboBox1->Items->AddObject(UTF8ToWideString(rs->name.c_str()), rs);
+ ComboBox1->Items->AddObject(UTF8Decode(rs->name.c_str()), rs);
loop++;
}
}
@@ -284,7 +285,7 @@
TRect rect = Item->DisplayRect(drSelectBounds);
static UnicodeRTF filter;
SWBuf buf;
- buf = WideStringToUTF8(Item->Caption).c_str();
+ buf = UTF8Encode(Item->Caption).c_str();
SWKey *key = *target;
// if (!SWDYNAMIC_CAST(VerseKey, key))
@@ -375,7 +376,7 @@
bool diffTarget = target != itarget;
target = itarget;
AnsiString cap = target->Description() + (AnsiString) " (" + target->Name() + ")";
- moduleName->Caption = UTF8ToWideString(cap);
+ moduleName->Caption = UTF8Decode(cap);
RTFHintForm->searchListDrawer->fillWithRTFString(target, "yoyo");
SearchText->Font->Name = RTFHintForm->searchListDrawer->dispAttribs.fontName;
// SearchText->Font->Size = RTFHintForm->searchListDrawer->dispAttribs.fontSize;
@@ -500,7 +501,7 @@
if (resultsLV->Items->Count > 0) {
ListKey tmpVerseList;
for (int i = 0; i < resultsLV->Items->Count; i++) {
- tmpVerseList << WideStringToUTF8(resultsLV->Items->Item[i]->Caption).c_str();
+ tmpVerseList << UTF8Encode(resultsLV->Items->Item[i]->Caption).c_str();
}
TVerseListForm *tmpForm = new TVerseListForm(this, tmpVerseList);
tmpForm->Caption = _tr("Search Verse List");
Modified: trunk/stage/layout.conf
===================================================================
--- trunk/stage/layout.conf 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/stage/layout.conf 2006-07-31 00:29:57 UTC (rev 434)
@@ -7,19 +7,19 @@
[History]
LastComModule=JFB
-LastLDKey=CREATION
+LastLDKey=ë§ˆíƒœë³µìŒ 19:5
LastLDModule=CBC
LastParaMod01=
LastParaMod02=
LastParaMod03=
-LastTextModule=NASB
-LastVerse=Matthew 19:1
+LastTextModule=ESV
+LastVerse=ë§ˆíƒœë³µìŒ 19:11
LookupSaveCount=5
+LookupText=ë§ˆíƒœë³µìŒ 19:9
+LookupText=ë§ˆíƒœë³µìŒ 19:5
+LookupText=Matthäus 19:3
LookupText=Matthew 19:1
LookupText=Matthew 19:27
-LookupText=Matthew 19:28
-LookupText=Genesis 1:1
-LookupText=I Corinthians 16:1
SearchSaveCount=5
SearchText=God love +world
SearchText=God love world
@@ -37,7 +37,7 @@
StrongsHebrew=
[ModuleOptions]
-Cross-references=On
+Cross-references=Off
Footnotes=Off
Headings=On
Hebrew Cantillation=Off
Modified: trunk/stage/options.conf
===================================================================
--- trunk/stage/options.conf 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/stage/options.conf 2006-07-31 00:29:57 UTC (rev 434)
@@ -89,7 +89,7 @@
UIFontSize=14
VSNumberColor=16711680
VerseNewLine=0
-locale=en_us
+locale=ko
[Bookmarks]
AutoSaveOther=0
Modified: trunk/sword.bpr
===================================================================
--- trunk/sword.bpr 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/sword.bpr 2006-07-31 00:29:57 UTC (rev 434)
@@ -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"/>
+ <USERDEFINES value="_ICU_;_ICUSWORD_;USBINARY;U_HAVE_PLACEMENT_NEW=0;USELUCENE;_CL_DISABLE_MULTITHREADING;_DEBUG"/>
<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="-O2 -Vx -X- -a8 -4 -b- -k- -vi -c -tW -tWM"/>
- <PFLAGS value="-N2obj -N0obj -$Y- -$L- -$D- -v -M -JPHNE"/>
+ <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"/>
<RFLAGS value=""/>
- <AFLAGS value="/mx /w2 /zn"/>
- <LFLAGS value="-Iobj -D"" -aa -Tpe -GD -s -Gn"/>
+ <AFLAGS value="/mx /w2 /zi"/>
+ <LFLAGS value="-Iobj -D"" -aa -Tpe -GD -s -Gn -v"/>
</OPTIONS>
<LINKER>
<ALLOBJ value="c0w32.obj $(OBJFILES)"/>
@@ -75,7 +75,7 @@
MajorVer=1
MinorVer=5
Release=8
-Build=10
+Build=11
Debug=0
PreRelease=0
Special=0
@@ -87,13 +87,13 @@
[Version Info Keys]
CompanyName=CrossWire Software & Bible Society
FileDescription=Windows 32bit User Interface to The SWORD Project
-FileVersion=1.5.8.10
+FileVersion=1.5.8.11
InternalName=biblecs
LegalCopyright=(c) 1990-2005 CrossWire Bible Society under the terms of the GNU General Public License
LegalTrademarks=
OriginalFilename=
ProductName=The SWORD Project
-ProductVersion=1.5.8rc5
+ProductVersion=1.5.8rc6
Comments=Seek Him and you will find Him
[HistoryLists\hlIncludePath]
@@ -141,8 +141,8 @@
[HistoryLists\hlConditionals]
Count=16
-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
+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
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)
Modified: trunk/vrslstfrm.cpp
===================================================================
--- trunk/vrslstfrm.cpp 2006-07-25 18:17:11 UTC (rev 433)
+++ trunk/vrslstfrm.cpp 2006-07-31 00:29:57 UTC (rev 434)
@@ -2,6 +2,7 @@
#include <vcl.h>
#pragma hdrstop
+#include "TntSystem.hpp"
#include "vrslstfrm.h"
#include "rtfhintfrm.h"
#include "PrintFrm.h"
More information about the sword-cvs
mailing list