diff options
| author | Vadim Dashevskiy <watcherhd@gmail.com> | 2012-10-08 09:10:06 +0000 |
|---|---|---|
| committer | Vadim Dashevskiy <watcherhd@gmail.com> | 2012-10-08 09:10:06 +0000 |
| commit | 194923c172167eb3fc33807ec8009b255f86337e (patch) | |
| tree | 1effc97a1bd872cc3a5eac7a361250cf283e0efd /plugins/Chess4Net/lib/TntUnicodeControls | |
| parent | b2943645fed61d0c0cfee1225654e5ff44fd96f8 (diff) | |
Plugin is not adapted until someone can compile it and tell others how to do the same
git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c
Diffstat (limited to 'plugins/Chess4Net/lib/TntUnicodeControls')
39 files changed, 0 insertions, 37081 deletions
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/ActiveIMM_TLB.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/ActiveIMM_TLB.pas deleted file mode 100644 index c515cf9a36..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/ActiveIMM_TLB.pas +++ /dev/null @@ -1,1374 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit ActiveIMM_TLB;
-
-{$INCLUDE TntCompilers.inc}
-
-{TNT-IGNORE-UNIT}
-
-// ************************************************************************ //
-// WARNING
-// -------
-// The types declared in this file were generated from data read from a
-// Type Library. If this type library is explicitly or indirectly (via
-// another type library referring to this type library) re-imported, or the
-// 'Refresh' command of the Type Library Editor activated while editing the
-// Type Library, the contents of this file will be regenerated and all
-// manual modifications will be lost.
-// ************************************************************************ //
-
-// PASTLWTR : $Revision: 1.1 $
-// File generated on 04/03/2001 11:32:13 PM from Type Library described below.
-
-// *************************************************************************//
-// NOTE:
-// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
-// which return objects that may need to be explicitly created via a function
-// call prior to any access via the property. These items have been disabled
-// in order to prevent accidental use from within the object inspector. You
-// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
-// removing them from the $IFDEF blocks. However, such items must still be
-// programmatically created via a method of the appropriate CoClass before
-// they can be used.
-// ************************************************************************ //
-// Type Lib: C:\Program Files\Microsoft Platform SDK\Include\dimm.tlb (1)
-// IID\LCID: {4955DD30-B159-11D0-8FCF-00AA006BCC59}\0
-// Helpfile:
-// DepndLst:
-// (1) v2.0 stdole, (C:\WINNT\System32\Stdole2.tlb)
-// (2) v4.0 StdVCL, (C:\WINNT\System32\STDVCL40.DLL)
-// Errors:
-// Hint: Member 'End' of 'IActiveIMMMessagePumpOwner' changed to 'End_'
-// Error creating palette bitmap of (TCActiveIMM) : Server D:\D5Addons\Dimm\dimm.dll contains no icons
-// ************************************************************************ //
-{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
-interface
-
-uses
- Windows, ActiveX, Classes, OleServer;
-
-// *********************************************************************//
-// GUIDS declared in the TypeLibrary. Following prefixes are used:
-// Type Libraries : LIBID_xxxx
-// CoClasses : CLASS_xxxx
-// DISPInterfaces : DIID_xxxx
-// Non-DISP interfaces: IID_xxxx
-// *********************************************************************//
-const
- // TypeLibrary Major and minor versions
- ActiveIMMMajorVersion = 0;
- ActiveIMMMinorVersion = 1;
-
- LIBID_ActiveIMM: TGUID = '{4955DD30-B159-11D0-8FCF-00AA006BCC59}';
-
- IID_IEnumRegisterWordA: TGUID = '{08C03412-F96B-11D0-A475-00AA006BCC59}';
- IID_IEnumRegisterWordW: TGUID = '{4955DD31-B159-11D0-8FCF-00AA006BCC59}';
- IID_IEnumInputContext: TGUID = '{09B5EAB0-F997-11D1-93D4-0060B067B86E}';
- IID_IActiveIMMRegistrar: TGUID = '{B3458082-BD00-11D1-939B-0060B067B86E}';
- IID_IActiveIMMMessagePumpOwner: TGUID = '{B5CF2CFA-8AEB-11D1-9364-0060B067B86E}';
- IID_IActiveIMMApp: TGUID = '{08C0E040-62D1-11D1-9326-0060B067B86E}';
- IID_IActiveIMMIME: TGUID = '{08C03411-F96B-11D0-A475-00AA006BCC59}';
- IID_IActiveIME: TGUID = '{6FE20962-D077-11D0-8FE7-00AA006BCC59}';
- IID_IActiveIME2: TGUID = '{E1C4BF0E-2D53-11D2-93E1-0060B067B86E}';
- CLASS_CActiveIMM: TGUID = '{4955DD33-B159-11D0-8FCF-00AA006BCC59}';
-type
-
-// *********************************************************************//
-// Forward declaration of types defined in TypeLibrary
-// *********************************************************************//
- IEnumRegisterWordA = interface;
- IEnumRegisterWordW = interface;
- IEnumInputContext = interface;
- IActiveIMMRegistrar = interface;
- IActiveIMMMessagePumpOwner = interface;
- IActiveIMMApp = interface;
- IActiveIMMIME = interface;
- IActiveIME = interface;
- IActiveIME2 = interface;
-
-// *********************************************************************//
-// Declaration of CoClasses defined in Type Library
-// (NOTE: Here we map each CoClass to its Default Interface)
-// *********************************************************************//
- CActiveIMM = IActiveIMMApp;
-
-
-// *********************************************************************//
-// Declaration of structures, unions and aliases.
-// *********************************************************************//
- wireHBITMAP = ^_userHBITMAP;
- wireHWND = ^_RemotableHandle;
- PUserType1 = ^TGUID; {*}
- PUserType2 = ^tagMSG; {*}
- PUserType3 = ^REGISTERWORDA; {*}
- PUserType4 = ^REGISTERWORDW; {*}
- PUserType5 = ^CANDIDATEFORM; {*}
- PUserType6 = ^LOGFONTA; {*}
- PUserType7 = ^LOGFONTW; {*}
- PUserType8 = ^COMPOSITIONFORM; {*}
- PUserType9 = ^tagPOINT; {*}
- PWord1 = ^Word; {*}
- PUserType10 = ^IMEMENUITEMINFOA; {*}
- PUserType11 = ^IMEMENUITEMINFOW; {*}
- PUserType12 = ^INPUTCONTEXT; {*}
- PByte1 = ^Byte; {*}
-
- __MIDL___MIDL_itf_dimm_0000_0001 = packed record
- lpReading: PAnsiChar;
- lpWord: PAnsiChar;
- end;
-
- REGISTERWORDA = __MIDL___MIDL_itf_dimm_0000_0001;
-
- __MIDL___MIDL_itf_dimm_0000_0002 = packed record
- lpReading: PWideChar;
- lpWord: PWideChar;
- end;
-
- REGISTERWORDW = __MIDL___MIDL_itf_dimm_0000_0002;
-
- __MIDL___MIDL_itf_dimm_0000_0003 = packed record
- lfHeight: Integer;
- lfWidth: Integer;
- lfEscapement: Integer;
- lfOrientation: Integer;
- lfWeight: Integer;
- lfItalic: Byte;
- lfUnderline: Byte;
- lfStrikeOut: Byte;
- lfCharSet: Byte;
- lfOutPrecision: Byte;
- lfClipPrecision: Byte;
- lfQuality: Byte;
- lfPitchAndFamily: Byte;
- lfFaceName: array[0..31] of Shortint;
- end;
-
- LOGFONTA = __MIDL___MIDL_itf_dimm_0000_0003;
-
- __MIDL___MIDL_itf_dimm_0000_0004 = packed record
- lfHeight: Integer;
- lfWidth: Integer;
- lfEscapement: Integer;
- lfOrientation: Integer;
- lfWeight: Integer;
- lfItalic: Byte;
- lfUnderline: Byte;
- lfStrikeOut: Byte;
- lfCharSet: Byte;
- lfOutPrecision: Byte;
- lfClipPrecision: Byte;
- lfQuality: Byte;
- lfPitchAndFamily: Byte;
- lfFaceName: array[0..31] of Word;
- end;
-
- LOGFONTW = __MIDL___MIDL_itf_dimm_0000_0004;
-
- tagPOINT = packed record
- x: Integer;
- y: Integer;
- end;
-
- tagRECT = packed record
- left: Integer;
- top: Integer;
- right: Integer;
- bottom: Integer;
- end;
-
- __MIDL___MIDL_itf_dimm_0000_0005 = packed record
- dwIndex: LongWord;
- dwStyle: LongWord;
- ptCurrentPos: tagPOINT;
- rcArea: tagRECT;
- end;
-
- CANDIDATEFORM = __MIDL___MIDL_itf_dimm_0000_0005;
-
- __MIDL___MIDL_itf_dimm_0000_0006 = packed record
- dwStyle: LongWord;
- ptCurrentPos: tagPOINT;
- rcArea: tagRECT;
- end;
-
- COMPOSITIONFORM = __MIDL___MIDL_itf_dimm_0000_0006;
-
- __MIDL___MIDL_itf_dimm_0000_0007 = packed record
- dwSize: LongWord;
- dwStyle: LongWord;
- dwCount: LongWord;
- dwSelection: LongWord;
- dwPageStart: LongWord;
- dwPageSize: LongWord;
- dwOffset: array[0..0] of LongWord;
- end;
-
- CANDIDATELIST = __MIDL___MIDL_itf_dimm_0000_0007;
-
- __MIDL___MIDL_itf_dimm_0000_0008 = packed record
- dwStyle: LongWord;
- szDescription: array[0..31] of Shortint;
- end;
-
- STYLEBUFA = __MIDL___MIDL_itf_dimm_0000_0008;
-
- __MIDL___MIDL_itf_dimm_0000_0009 = packed record
- dwStyle: LongWord;
- szDescription: array[0..31] of Word;
- end;
-
- STYLEBUFW = __MIDL___MIDL_itf_dimm_0000_0009;
-
- __MIDL___MIDL_itf_dimm_0000_0010 = packed record
- cbSize: SYSUINT;
- fType: SYSUINT;
- fState: SYSUINT;
- wID: SYSUINT;
- hbmpChecked: wireHBITMAP;
- hbmpUnchecked: wireHBITMAP;
- dwItemData: LongWord;
- szString: array[0..79] of Shortint;
- hbmpItem: wireHBITMAP;
- end;
-
- IMEMENUITEMINFOA = __MIDL___MIDL_itf_dimm_0000_0010;
-
- _userBITMAP = packed record
- bmType: Integer;
- bmWidth: Integer;
- bmHeight: Integer;
- bmWidthBytes: Integer;
- bmPlanes: Word;
- bmBitsPixel: Word;
- cbSize: LongWord;
- pBuffer: ^Byte;
- end;
-
- __MIDL_IWinTypes_0007 = record
- case Integer of
- 0: (hInproc: Integer);
- 1: (hRemote: ^_userBITMAP);
- end;
-
- _userHBITMAP = packed record
- fContext: Integer;
- u: __MIDL_IWinTypes_0007;
- end;
-
- __MIDL___MIDL_itf_dimm_0000_0011 = packed record
- cbSize: SYSUINT;
- fType: SYSUINT;
- fState: SYSUINT;
- wID: SYSUINT;
- hbmpChecked: wireHBITMAP;
- hbmpUnchecked: wireHBITMAP;
- dwItemData: LongWord;
- szString: array[0..79] of Word;
- hbmpItem: wireHBITMAP;
- end;
-
- IMEMENUITEMINFOW = __MIDL___MIDL_itf_dimm_0000_0011;
-
- __MIDL___MIDL_itf_dimm_0000_0013 = record
- case Integer of
- 0: (A: LOGFONTA);
- 1: (W: LOGFONTW);
- end;
-
- __MIDL___MIDL_itf_dimm_0000_0012 = packed record
- hWnd: wireHWND;
- fOpen: Integer;
- ptStatusWndPos: tagPOINT;
- ptSoftKbdPos: tagPOINT;
- fdwConversion: LongWord;
- fdwSentence: LongWord;
- lfFont: __MIDL___MIDL_itf_dimm_0000_0013;
- cfCompForm: COMPOSITIONFORM;
- cfCandForm: array[0..3] of CANDIDATEFORM;
- hCompStr: LongWord;
- hCandInfo: LongWord;
- hGuideLine: LongWord;
- hPrivate: LongWord;
- dwNumMsgBuf: LongWord;
- hMsgBuf: LongWord;
- fdwInit: LongWord;
- dwReserve: array[0..2] of LongWord;
- end;
-
- __MIDL_IWinTypes_0009 = record
- case Integer of
- 0: (hInproc: Integer);
- 1: (hRemote: Integer);
- end;
-
- _RemotableHandle = packed record
- fContext: Integer;
- u: __MIDL_IWinTypes_0009;
- end;
-
- INPUTCONTEXT = __MIDL___MIDL_itf_dimm_0000_0012;
-
- __MIDL___MIDL_itf_dimm_0000_0014 = packed record
- dwPrivateDataSize: LongWord;
- fdwProperty: LongWord;
- fdwConversionCaps: LongWord;
- fdwSentenceCaps: LongWord;
- fdwUICaps: LongWord;
- fdwSCSCaps: LongWord;
- fdwSelectCaps: LongWord;
- end;
-
- IMEINFO = __MIDL___MIDL_itf_dimm_0000_0014;
- UINT_PTR = LongWord;
- LONG_PTR = Integer;
-
- tagMSG = packed record
- hWnd: wireHWND;
- message: SYSUINT;
- wParam: UINT_PTR;
- lParam: LONG_PTR;
- time: LongWord;
- pt: tagPOINT;
- end;
-
-
-// *********************************************************************//
-// Interface: IEnumRegisterWordA
-// Flags: (0)
-// GUID: {08C03412-F96B-11D0-A475-00AA006BCC59}
-// *********************************************************************//
- IEnumRegisterWordA = interface(IUnknown)
- ['{08C03412-F96B-11D0-A475-00AA006BCC59}']
- function Clone(out ppEnum: IEnumRegisterWordA): HResult; stdcall;
- function Next(ulCount: LongWord; out rgRegisterWord: REGISTERWORDA; out pcFetched: LongWord): HResult; stdcall;
- function Reset: HResult; stdcall;
- function Skip(ulCount: LongWord): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IEnumRegisterWordW
-// Flags: (0)
-// GUID: {4955DD31-B159-11D0-8FCF-00AA006BCC59}
-// *********************************************************************//
- IEnumRegisterWordW = interface(IUnknown)
- ['{4955DD31-B159-11D0-8FCF-00AA006BCC59}']
- function Clone(out ppEnum: IEnumRegisterWordW): HResult; stdcall;
- function Next(ulCount: LongWord; out rgRegisterWord: REGISTERWORDW; out pcFetched: LongWord): HResult; stdcall;
- function Reset: HResult; stdcall;
- function Skip(ulCount: LongWord): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IEnumInputContext
-// Flags: (0)
-// GUID: {09B5EAB0-F997-11D1-93D4-0060B067B86E}
-// *********************************************************************//
- IEnumInputContext = interface(IUnknown)
- ['{09B5EAB0-F997-11D1-93D4-0060B067B86E}']
- function Clone(out ppEnum: IEnumInputContext): HResult; stdcall;
- function Next(ulCount: LongWord; out rgInputContext: LongWord; out pcFetched: LongWord): HResult; stdcall;
- function Reset: HResult; stdcall;
- function Skip(ulCount: LongWord): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IActiveIMMRegistrar
-// Flags: (0)
-// GUID: {B3458082-BD00-11D1-939B-0060B067B86E}
-// *********************************************************************//
- IActiveIMMRegistrar = interface(IUnknown)
- ['{B3458082-BD00-11D1-939B-0060B067B86E}']
- function RegisterIME(var rclsid: TGUID; lgid: Word; pszIconFile: PWideChar; pszDesc: PWideChar): HResult; stdcall;
- function UnregisterIME(var rclsid: TGUID): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IActiveIMMMessagePumpOwner
-// Flags: (0)
-// GUID: {B5CF2CFA-8AEB-11D1-9364-0060B067B86E}
-// *********************************************************************//
- IActiveIMMMessagePumpOwner = interface(IUnknown)
- ['{B5CF2CFA-8AEB-11D1-9364-0060B067B86E}']
- function Start: HResult; stdcall;
- function End_: HResult; stdcall;
- function OnTranslateMessage(var pMsg: tagMSG): HResult; stdcall;
- function Pause(out pdwCookie: LongWord): HResult; stdcall;
- function Resume(dwCookie: LongWord): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IActiveIMMApp
-// Flags: (0)
-// GUID: {08C0E040-62D1-11D1-9326-0060B067B86E}
-// *********************************************************************//
- IActiveIMMApp = interface(IUnknown)
- ['{08C0E040-62D1-11D1-9326-0060B067B86E}']
- function AssociateContext(var hWnd: _RemotableHandle; hIME: LongWord; out phPrev: LongWord): HResult; stdcall;
- function ConfigureIMEA(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDA): HResult; stdcall;
- function ConfigureIMEW(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDW): HResult; stdcall;
- function CreateContext(out phIMC: LongWord): HResult; stdcall;
- function DestroyContext(hIME: LongWord): HResult; stdcall;
- function EnumRegisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szRegister: PAnsiChar; var pData: Pointer; out pEnum: IEnumRegisterWordA): HResult; stdcall;
- function EnumRegisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar; var pData: Pointer;
- out pEnum: IEnumRegisterWordW): HResult; stdcall;
- function EscapeA(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT; var pData: Pointer;
- out plResult: LONG_PTR): HResult; stdcall;
- function EscapeW(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT; var pData: Pointer;
- out plResult: LONG_PTR): HResult; stdcall;
- function GetCandidateListA(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult; stdcall;
- function GetCandidateListW(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult; stdcall;
- function GetCandidateListCountA(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult; stdcall;
- function GetCandidateListCountW(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult; stdcall;
- function GetCandidateWindow(hIMC: LongWord; dwIndex: LongWord; out pCandidate: CANDIDATEFORM): HResult; stdcall;
- function GetCompositionFontA(hIMC: LongWord; out plf: LOGFONTA): HResult; stdcall;
- function GetCompositionFontW(hIMC: LongWord; out plf: LOGFONTW): HResult; stdcall;
- function GetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult; stdcall;
- function GetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult; stdcall;
- function GetCompositionWindow(hIMC: LongWord; out pCompForm: COMPOSITIONFORM): HResult; stdcall;
- function GetContext(var hWnd: _RemotableHandle; out phIMC: LongWord): HResult; stdcall;
- function GetConversionListA(var hKL: Pointer; hIMC: LongWord; pSrc: PAnsiChar; uBufLen: SYSUINT;
- uFlag: SYSUINT; out pDst: CANDIDATELIST; out puCopied: SYSUINT): HResult; stdcall;
- function GetConversionListW(var hKL: Pointer; hIMC: LongWord; pSrc: PWideChar;
- uBufLen: SYSUINT; uFlag: SYSUINT; out pDst: CANDIDATELIST;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetConversionStatus(hIMC: LongWord; out pfdwConversion: LongWord;
- out pfdwSentence: LongWord): HResult; stdcall;
- function GetDefaultIMEWnd(var hWnd: _RemotableHandle; out phDefWnd: wireHWND): HResult; stdcall;
- function GetDescriptionA(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PAnsiChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetDescriptionW(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PWideChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetGuideLineA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord; pBuf: PAnsiChar;
- out pdwResult: LongWord): HResult; stdcall;
- function GetGuideLineW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord; pBuf: PWideChar;
- out pdwResult: LongWord): HResult; stdcall;
- function GetIMEFileNameA(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PAnsiChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetIMEFileNameW(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PWideChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetOpenStatus(hIMC: LongWord): HResult; stdcall;
- function GetProperty(var hKL: Pointer; fdwIndex: LongWord; out pdwProperty: LongWord): HResult; stdcall;
- function GetRegisterWordStyleA(var hKL: Pointer; nItem: SYSUINT; out pStyleBuf: STYLEBUFA;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetRegisterWordStyleW(var hKL: Pointer; nItem: SYSUINT; out pStyleBuf: STYLEBUFW;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetStatusWindowPos(hIMC: LongWord; out pptPos: tagPOINT): HResult; stdcall;
- function GetVirtualKey(var hWnd: _RemotableHandle; out puVirtualKey: SYSUINT): HResult; stdcall;
- function InstallIMEA(szIMEFileName: PAnsiChar; szLayoutText: PAnsiChar; out phKL: Pointer): HResult; stdcall;
- function InstallIMEW(szIMEFileName: PWideChar; szLayoutText: PWideChar; out phKL: Pointer): HResult; stdcall;
- function IsIME(var hKL: Pointer): HResult; stdcall;
- function IsUIMessageA(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult; stdcall;
- function IsUIMessageW(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult; stdcall;
- function NotifyIME(hIMC: LongWord; dwAction: LongWord; dwIndex: LongWord; dwValue: LongWord): HResult; stdcall;
- function REGISTERWORDA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord; szRegister: PAnsiChar): HResult; stdcall;
- function REGISTERWORDW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar): HResult; stdcall;
- function ReleaseContext(var hWnd: _RemotableHandle; hIMC: LongWord): HResult; stdcall;
- function SetCandidateWindow(hIMC: LongWord; var pCandidate: CANDIDATEFORM): HResult; stdcall;
- function SetCompositionFontA(hIMC: LongWord; var plf: LOGFONTA): HResult; stdcall;
- function SetCompositionFontW(hIMC: LongWord; var plf: LOGFONTW): HResult; stdcall;
- function SetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer; dwReadLen: LongWord): HResult; stdcall;
- function SetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer; dwReadLen: LongWord): HResult; stdcall;
- function SetCompositionWindow(hIMC: LongWord; var pCompForm: COMPOSITIONFORM): HResult; stdcall;
- function SetConversionStatus(hIMC: LongWord; fdwConversion: LongWord; fdwSentence: LongWord): HResult; stdcall;
- function SetOpenStatus(hIMC: LongWord; fOpen: Integer): HResult; stdcall;
- function SetStatusWindowPos(hIMC: LongWord; var pptPos: tagPOINT): HResult; stdcall;
- function SimulateHotKey(var hWnd: _RemotableHandle; dwHotKeyID: LongWord): HResult; stdcall;
- function UnregisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szUnregister: PAnsiChar): HResult; stdcall;
- function UnregisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szUnregister: PWideChar): HResult; stdcall;
- function Activate(fRestoreLayout: Integer): HResult; stdcall;
- function Deactivate: HResult; stdcall;
- function OnDefWindowProc(var hWnd: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR; out plResult: LONG_PTR): HResult; stdcall;
- function FilterClientWindows(var aaClassList: Word; uSize: SYSUINT): HResult; stdcall;
- function GetCodePageA(var hKL: Pointer; out uCodePage: SYSUINT): HResult; stdcall;
- function GetLangId(var hKL: Pointer; out plid: Word): HResult; stdcall;
- function AssociateContextEx(var hWnd: _RemotableHandle; hIMC: LongWord; dwFlags: LongWord): HResult; stdcall;
- function DisableIME(idThread: LongWord): HResult; stdcall;
- function GetImeMenuItemsA(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOA;
- out pImeMenu: IMEMENUITEMINFOA; dwSize: LongWord;
- out pdwResult: LongWord): HResult; stdcall;
- function GetImeMenuItemsW(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOW;
- out pImeMenu: IMEMENUITEMINFOW; dwSize: LongWord;
- out pdwResult: LongWord): HResult; stdcall;
- function EnumInputContext(idThread: LongWord; out ppEnum: IEnumInputContext): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IActiveIMMIME
-// Flags: (0)
-// GUID: {08C03411-F96B-11D0-A475-00AA006BCC59}
-// *********************************************************************//
- IActiveIMMIME = interface(IUnknown)
- ['{08C03411-F96B-11D0-A475-00AA006BCC59}']
- function AssociateContext(var hWnd: _RemotableHandle; hIME: LongWord; out phPrev: LongWord): HResult; stdcall;
- function ConfigureIMEA(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDA): HResult; stdcall;
- function ConfigureIMEW(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDW): HResult; stdcall;
- function CreateContext(out phIMC: LongWord): HResult; stdcall;
- function DestroyContext(hIME: LongWord): HResult; stdcall;
- function EnumRegisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szRegister: PAnsiChar; var pData: Pointer; out pEnum: IEnumRegisterWordA): HResult; stdcall;
- function EnumRegisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar; var pData: Pointer;
- out pEnum: IEnumRegisterWordW): HResult; stdcall;
- function EscapeA(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT; var pData: Pointer;
- out plResult: LONG_PTR): HResult; stdcall;
- function EscapeW(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT; var pData: Pointer;
- out plResult: LONG_PTR): HResult; stdcall;
- function GetCandidateListA(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult; stdcall;
- function GetCandidateListW(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult; stdcall;
- function GetCandidateListCountA(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult; stdcall;
- function GetCandidateListCountW(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult; stdcall;
- function GetCandidateWindow(hIMC: LongWord; dwIndex: LongWord; out pCandidate: CANDIDATEFORM): HResult; stdcall;
- function GetCompositionFontA(hIMC: LongWord; out plf: LOGFONTA): HResult; stdcall;
- function GetCompositionFontW(hIMC: LongWord; out plf: LOGFONTW): HResult; stdcall;
- function GetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult; stdcall;
- function GetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult; stdcall;
- function GetCompositionWindow(hIMC: LongWord; out pCompForm: COMPOSITIONFORM): HResult; stdcall;
- function GetContext(var hWnd: _RemotableHandle; out phIMC: LongWord): HResult; stdcall;
- function GetConversionListA(var hKL: Pointer; hIMC: LongWord; pSrc: PAnsiChar; uBufLen: SYSUINT;
- uFlag: SYSUINT; out pDst: CANDIDATELIST; out puCopied: SYSUINT): HResult; stdcall;
- function GetConversionListW(var hKL: Pointer; hIMC: LongWord; pSrc: PWideChar;
- uBufLen: SYSUINT; uFlag: SYSUINT; out pDst: CANDIDATELIST;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetConversionStatus(hIMC: LongWord; out pfdwConversion: LongWord;
- out pfdwSentence: LongWord): HResult; stdcall;
- function GetDefaultIMEWnd(var hWnd: _RemotableHandle; out phDefWnd: wireHWND): HResult; stdcall;
- function GetDescriptionA(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PAnsiChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetDescriptionW(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PWideChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetGuideLineA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord; pBuf: PAnsiChar;
- out pdwResult: LongWord): HResult; stdcall;
- function GetGuideLineW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord; pBuf: PWideChar;
- out pdwResult: LongWord): HResult; stdcall;
- function GetIMEFileNameA(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PAnsiChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetIMEFileNameW(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PWideChar;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetOpenStatus(hIMC: LongWord): HResult; stdcall;
- function GetProperty(var hKL: Pointer; fdwIndex: LongWord; out pdwProperty: LongWord): HResult; stdcall;
- function GetRegisterWordStyleA(var hKL: Pointer; nItem: SYSUINT; out pStyleBuf: STYLEBUFA;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetRegisterWordStyleW(var hKL: Pointer; nItem: SYSUINT; out pStyleBuf: STYLEBUFW;
- out puCopied: SYSUINT): HResult; stdcall;
- function GetStatusWindowPos(hIMC: LongWord; out pptPos: tagPOINT): HResult; stdcall;
- function GetVirtualKey(var hWnd: _RemotableHandle; out puVirtualKey: SYSUINT): HResult; stdcall;
- function InstallIMEA(szIMEFileName: PAnsiChar; szLayoutText: PAnsiChar; out phKL: Pointer): HResult; stdcall;
- function InstallIMEW(szIMEFileName: PWideChar; szLayoutText: PWideChar; out phKL: Pointer): HResult; stdcall;
- function IsIME(var hKL: Pointer): HResult; stdcall;
- function IsUIMessageA(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult; stdcall;
- function IsUIMessageW(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult; stdcall;
- function NotifyIME(hIMC: LongWord; dwAction: LongWord; dwIndex: LongWord; dwValue: LongWord): HResult; stdcall;
- function REGISTERWORDA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord; szRegister: PAnsiChar): HResult; stdcall;
- function REGISTERWORDW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar): HResult; stdcall;
- function ReleaseContext(var hWnd: _RemotableHandle; hIMC: LongWord): HResult; stdcall;
- function SetCandidateWindow(hIMC: LongWord; var pCandidate: CANDIDATEFORM): HResult; stdcall;
- function SetCompositionFontA(hIMC: LongWord; var plf: LOGFONTA): HResult; stdcall;
- function SetCompositionFontW(hIMC: LongWord; var plf: LOGFONTW): HResult; stdcall;
- function SetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer; dwReadLen: LongWord): HResult; stdcall;
- function SetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer; dwReadLen: LongWord): HResult; stdcall;
- function SetCompositionWindow(hIMC: LongWord; var pCompForm: COMPOSITIONFORM): HResult; stdcall;
- function SetConversionStatus(hIMC: LongWord; fdwConversion: LongWord; fdwSentence: LongWord): HResult; stdcall;
- function SetOpenStatus(hIMC: LongWord; fOpen: Integer): HResult; stdcall;
- function SetStatusWindowPos(hIMC: LongWord; var pptPos: tagPOINT): HResult; stdcall;
- function SimulateHotKey(var hWnd: _RemotableHandle; dwHotKeyID: LongWord): HResult; stdcall;
- function UnregisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szUnregister: PAnsiChar): HResult; stdcall;
- function UnregisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szUnregister: PWideChar): HResult; stdcall;
- function GenerateMessage(hIMC: LongWord): HResult; stdcall;
- function LockIMC(hIMC: LongWord; out ppIMC: PUserType12): HResult; stdcall;
- function UnlockIMC(hIMC: LongWord): HResult; stdcall;
- function GetIMCLockCount(hIMC: LongWord; out pdwLockCount: LongWord): HResult; stdcall;
- function CreateIMCC(dwSize: LongWord; out phIMCC: LongWord): HResult; stdcall;
- function DestroyIMCC(hIMCC: LongWord): HResult; stdcall;
- function LockIMCC(hIMCC: LongWord; out ppv: Pointer): HResult; stdcall;
- function UnlockIMCC(hIMCC: LongWord): HResult; stdcall;
- 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(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;
- y: SYSINT; out phSoftKbdWnd: wireHWND): HResult; stdcall;
- function DestroySoftKeyboard(var hSoftKbdWnd: _RemotableHandle): HResult; stdcall;
- function ShowSoftKeyboard(var hSoftKbdWnd: _RemotableHandle; nCmdShow: SYSINT): HResult; stdcall;
- function GetCodePageA(var hKL: Pointer; out uCodePage: SYSUINT): HResult; stdcall;
- function GetLangId(var hKL: Pointer; out plid: Word): HResult; stdcall;
- function KeybdEvent(lgidIME: Word; bVk: Byte; bScan: Byte; dwFlags: LongWord;
- dwExtraInfo: LongWord): HResult; stdcall;
- function LockModal: HResult; stdcall;
- function UnlockModal: HResult; stdcall;
- function AssociateContextEx(var hWnd: _RemotableHandle; hIMC: LongWord; dwFlags: LongWord): HResult; stdcall;
- function DisableIME(idThread: LongWord): HResult; stdcall;
- function GetImeMenuItemsA(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOA;
- out pImeMenu: IMEMENUITEMINFOA; dwSize: LongWord;
- out pdwResult: LongWord): HResult; stdcall;
- function GetImeMenuItemsW(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOW;
- out pImeMenu: IMEMENUITEMINFOW; dwSize: LongWord;
- out pdwResult: LongWord): HResult; stdcall;
- function EnumInputContext(idThread: LongWord; out ppEnum: IEnumInputContext): HResult; stdcall;
- function RequestMessageA(hIMC: LongWord; wParam: UINT_PTR; lParam: LONG_PTR;
- out plResult: LONG_PTR): HResult; stdcall;
- function RequestMessageW(hIMC: LongWord; wParam: UINT_PTR; lParam: LONG_PTR;
- out plResult: LONG_PTR): HResult; stdcall;
- function SendIMCA(var hWnd: _RemotableHandle; uMsg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR; out plResult: LONG_PTR): HResult; stdcall;
- function SendIMCW(var hWnd: _RemotableHandle; uMsg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR; out plResult: LONG_PTR): HResult; stdcall;
- function IsSleeping: HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IActiveIME
-// Flags: (0)
-// GUID: {6FE20962-D077-11D0-8FE7-00AA006BCC59}
-// *********************************************************************//
- IActiveIME = interface(IUnknown)
- ['{6FE20962-D077-11D0-8FE7-00AA006BCC59}']
- function Inquire(dwSystemInfoFlags: LongWord; out pIMEInfo: IMEINFO; szWndClass: PWideChar;
- out pdwPrivate: LongWord): HResult; stdcall;
- function ConversionList(hIMC: LongWord; szSource: PWideChar; uFlag: SYSUINT; uBufLen: SYSUINT;
- out pDest: CANDIDATELIST; out puCopied: SYSUINT): HResult; stdcall;
- function Configure(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pRegisterWord: REGISTERWORDW): HResult; stdcall;
- function Destroy(uReserved: SYSUINT): HResult; stdcall;
- function Escape(hIMC: LongWord; uEscape: SYSUINT; var pData: Pointer; out plResult: LONG_PTR): HResult; stdcall;
- function SetActiveContext(hIMC: LongWord; fFlag: Integer): HResult; stdcall;
- function ProcessKey(hIMC: LongWord; uVirKey: SYSUINT; lParam: LongWord; var pbKeyState: Byte): HResult; stdcall;
- function Notify(hIMC: LongWord; dwAction: LongWord; dwIndex: LongWord; dwValue: LongWord): HResult; stdcall;
- function Select(hIMC: LongWord; fSelect: Integer): HResult; stdcall;
- function SetCompositionString(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer; dwReadLen: LongWord): HResult; stdcall;
- function ToAsciiEx(uVirKey: SYSUINT; uScanCode: SYSUINT; var pbKeyState: Byte;
- fuState: SYSUINT; hIMC: LongWord; out pdwTransBuf: LongWord;
- out puSize: SYSUINT): HResult; stdcall;
- function RegisterWord(szReading: PWideChar; dwStyle: LongWord; szString: PWideChar): HResult; stdcall;
- function UnregisterWord(szReading: PWideChar; dwStyle: LongWord; szString: PWideChar): HResult; stdcall;
- function GetRegisterWordStyle(nItem: SYSUINT; out pStyleBuf: STYLEBUFW; out puBufSize: SYSUINT): HResult; stdcall;
- function EnumRegisterWord(szReading: PWideChar; dwStyle: LongWord; szRegister: PWideChar;
- var pData: Pointer; out ppEnum: IEnumRegisterWordW): HResult; stdcall;
- function GetCodePageA(out uCodePage: SYSUINT): HResult; stdcall;
- function GetLangId(out plid: Word): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IActiveIME2
-// Flags: (0)
-// GUID: {E1C4BF0E-2D53-11D2-93E1-0060B067B86E}
-// *********************************************************************//
- IActiveIME2 = interface(IActiveIME)
- ['{E1C4BF0E-2D53-11D2-93E1-0060B067B86E}']
- function Sleep: HResult; stdcall;
- function Unsleep(fDead: Integer): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// The Class CoCActiveIMM provides a Create and CreateRemote method to
-// create instances of the default interface IActiveIMMApp exposed by
-// the CoClass CActiveIMM. The functions are intended to be used by
-// clients wishing to automate the CoClass objects exposed by the
-// server of this typelibrary.
-// *********************************************************************//
- CoCActiveIMM = class
- class function Create: IActiveIMMApp;
- class function CreateRemote(const MachineName: AnsiString): IActiveIMMApp;
- end;
-
-
-// *********************************************************************//
-// OLE Server Proxy class declaration
-// Server Object : TCActiveIMM
-// Help String :
-// Default Interface: IActiveIMMApp
-// Def. Intf. DISP? : No
-// Event Interface:
-// TypeFlags : (2) CanCreate
-// *********************************************************************//
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
- TCActiveIMMProperties= class;
-{$ENDIF}
- TCActiveIMM = class(TOleServer)
- private
- FIntf: IActiveIMMApp;
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
- FProps: TCActiveIMMProperties;
- function GetServerProperties: TCActiveIMMProperties;
-{$ENDIF}
- function GetDefaultInterface: IActiveIMMApp;
- protected
- procedure InitServerData; override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Connect; override;
- procedure ConnectTo(svrIntf: IActiveIMMApp);
- procedure Disconnect; override;
- function AssociateContext(var hWnd: _RemotableHandle; hIME: LongWord; out phPrev: LongWord): HResult;
- function ConfigureIMEA(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDA): HResult;
- function ConfigureIMEW(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDW): HResult;
- function CreateContext(out phIMC: LongWord): HResult;
- function DestroyContext(hIME: LongWord): HResult;
- function EnumRegisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szRegister: PAnsiChar; var pData: Pointer; out pEnum: IEnumRegisterWordA): HResult;
- function EnumRegisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar; var pData: Pointer;
- out pEnum: IEnumRegisterWordW): HResult;
- function EscapeA(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT; var pData: Pointer;
- out plResult: LONG_PTR): HResult;
- function EscapeW(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT; var pData: Pointer;
- out plResult: LONG_PTR): HResult;
- function GetCandidateListA(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult;
- function GetCandidateListW(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult;
- function GetCandidateListCountA(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult;
- function GetCandidateListCountW(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult;
- function GetCandidateWindow(hIMC: LongWord; dwIndex: LongWord; out pCandidate: CANDIDATEFORM): HResult;
- function GetCompositionFontA(hIMC: LongWord; out plf: LOGFONTA): HResult;
- function GetCompositionFontW(hIMC: LongWord; out plf: LOGFONTW): HResult;
- function GetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult;
- function GetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult;
- function GetCompositionWindow(hIMC: LongWord; out pCompForm: COMPOSITIONFORM): HResult;
- function GetContext(var hWnd: _RemotableHandle; out phIMC: LongWord): HResult;
- function GetConversionListA(var hKL: Pointer; hIMC: LongWord; pSrc: PAnsiChar; uBufLen: SYSUINT;
- uFlag: SYSUINT; out pDst: CANDIDATELIST; out puCopied: SYSUINT): HResult;
- function GetConversionListW(var hKL: Pointer; hIMC: LongWord; pSrc: PWideChar;
- uBufLen: SYSUINT; uFlag: SYSUINT; out pDst: CANDIDATELIST;
- out puCopied: SYSUINT): HResult;
- function GetConversionStatus(hIMC: LongWord; out pfdwConversion: LongWord;
- out pfdwSentence: LongWord): HResult;
- function GetDefaultIMEWnd(var hWnd: _RemotableHandle; out phDefWnd: wireHWND): HResult;
- function GetDescriptionA(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PAnsiChar;
- out puCopied: SYSUINT): HResult;
- function GetDescriptionW(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PWideChar;
- out puCopied: SYSUINT): HResult;
- function GetGuideLineA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord; pBuf: PAnsiChar;
- out pdwResult: LongWord): HResult;
- function GetGuideLineW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord; pBuf: PWideChar;
- out pdwResult: LongWord): HResult;
- function GetIMEFileNameA(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PAnsiChar;
- out puCopied: SYSUINT): HResult;
- function GetIMEFileNameW(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PWideChar;
- out puCopied: SYSUINT): HResult;
- function GetOpenStatus(hIMC: LongWord): HResult;
- function GetProperty(var hKL: Pointer; fdwIndex: LongWord; out pdwProperty: LongWord): HResult;
- function GetRegisterWordStyleA(var hKL: Pointer; nItem: SYSUINT; out pStyleBuf: STYLEBUFA;
- out puCopied: SYSUINT): HResult;
- function GetRegisterWordStyleW(var hKL: Pointer; nItem: SYSUINT; out pStyleBuf: STYLEBUFW;
- out puCopied: SYSUINT): HResult;
- function GetStatusWindowPos(hIMC: LongWord; out pptPos: tagPOINT): HResult;
- function GetVirtualKey(var hWnd: _RemotableHandle; out puVirtualKey: SYSUINT): HResult;
- function InstallIMEA(szIMEFileName: PAnsiChar; szLayoutText: PAnsiChar; out phKL: Pointer): HResult;
- function InstallIMEW(szIMEFileName: PWideChar; szLayoutText: PWideChar; out phKL: Pointer): HResult;
- function IsIME(var hKL: Pointer): HResult;
- function IsUIMessageA(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult;
- function IsUIMessageW(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult;
- function NotifyIME(hIMC: LongWord; dwAction: LongWord; dwIndex: LongWord; dwValue: LongWord): HResult;
- function REGISTERWORDA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord; szRegister: PAnsiChar): HResult;
- function REGISTERWORDW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar): HResult;
- function ReleaseContext(var hWnd: _RemotableHandle; hIMC: LongWord): HResult;
- function SetCandidateWindow(hIMC: LongWord; var pCandidate: CANDIDATEFORM): HResult;
- function SetCompositionFontA(hIMC: LongWord; var plf: LOGFONTA): HResult;
- function SetCompositionFontW(hIMC: LongWord; var plf: LOGFONTW): HResult;
- function SetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer; dwReadLen: LongWord): HResult;
- function SetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer; dwReadLen: LongWord): HResult;
- function SetCompositionWindow(hIMC: LongWord; var pCompForm: COMPOSITIONFORM): HResult;
- function SetConversionStatus(hIMC: LongWord; fdwConversion: LongWord; fdwSentence: LongWord): HResult;
- function SetOpenStatus(hIMC: LongWord; fOpen: Integer): HResult;
- function SetStatusWindowPos(hIMC: LongWord; var pptPos: tagPOINT): HResult;
- function SimulateHotKey(var hWnd: _RemotableHandle; dwHotKeyID: LongWord): HResult;
- function UnregisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szUnregister: PAnsiChar): HResult;
- function UnregisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szUnregister: PWideChar): HResult;
- function Activate(fRestoreLayout: Integer): HResult;
- function Deactivate: HResult;
- function OnDefWindowProc(var hWnd: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR; out plResult: LONG_PTR): HResult;
- function FilterClientWindows(var aaClassList: Word; uSize: SYSUINT): HResult;
- function GetCodePageA(var hKL: Pointer; out uCodePage: SYSUINT): HResult;
- function GetLangId(var hKL: Pointer; out plid: Word): HResult;
- function AssociateContextEx(var hWnd: _RemotableHandle; hIMC: LongWord; dwFlags: LongWord): HResult;
- function DisableIME(idThread: LongWord): HResult;
- function GetImeMenuItemsA(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOA;
- out pImeMenu: IMEMENUITEMINFOA; dwSize: LongWord;
- out pdwResult: LongWord): HResult;
- function GetImeMenuItemsW(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOW;
- out pImeMenu: IMEMENUITEMINFOW; dwSize: LongWord;
- out pdwResult: LongWord): HResult;
- function EnumInputContext(idThread: LongWord; out ppEnum: IEnumInputContext): HResult;
- property DefaultInterface: IActiveIMMApp read GetDefaultInterface;
- published
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
- property Server: TCActiveIMMProperties read GetServerProperties;
-{$ENDIF}
- end;
-
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
-// *********************************************************************//
-// OLE Server Properties Proxy Class
-// Server Object : TCActiveIMM
-// (This object is used by the IDE's Property Inspector to allow editing
-// of the properties of this server)
-// *********************************************************************//
- TCActiveIMMProperties = class(TPersistent)
- private
- FServer: TCActiveIMM;
- function GetDefaultInterface: IActiveIMMApp;
- constructor Create(AServer: TCActiveIMM);
- protected
- public
- property DefaultInterface: IActiveIMMApp read GetDefaultInterface;
- published
- end;
-{$ENDIF}
-
-implementation
-
-uses
- ComObj;
-
-class function CoCActiveIMM.Create: IActiveIMMApp;
-begin
- Result := CreateComObject(CLASS_CActiveIMM) as IActiveIMMApp;
-end;
-
-class function CoCActiveIMM.CreateRemote(const MachineName: AnsiString): IActiveIMMApp;
-begin
- Result := CreateRemoteComObject(MachineName, CLASS_CActiveIMM) as IActiveIMMApp;
-end;
-
-procedure TCActiveIMM.InitServerData;
-const
- CServerData: TServerData = (
- ClassID: '{4955DD33-B159-11D0-8FCF-00AA006BCC59}';
- IntfIID: '{08C0E040-62D1-11D1-9326-0060B067B86E}';
- EventIID: '';
- LicenseKey: nil;
- Version: 500);
-begin
- ServerData := @CServerData;
-end;
-
-procedure TCActiveIMM.Connect;
-var
- punk: IUnknown;
-begin
- if FIntf = nil then
- begin
- punk := GetServer;
- Fintf:= punk as IActiveIMMApp;
- end;
-end;
-
-procedure TCActiveIMM.ConnectTo(svrIntf: IActiveIMMApp);
-begin
- Disconnect;
- FIntf := svrIntf;
-end;
-
-procedure TCActiveIMM.DisConnect;
-begin
- if Fintf <> nil then
- begin
- FIntf := nil;
- end;
-end;
-
-function TCActiveIMM.GetDefaultInterface: IActiveIMMApp;
-begin
- if FIntf = nil then
- Connect;
- Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
- Result := FIntf;
-end;
-
-constructor TCActiveIMM.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
- FProps := TCActiveIMMProperties.Create(Self);
-{$ENDIF}
-end;
-
-destructor TCActiveIMM.Destroy;
-begin
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
- FProps.Free;
-{$ENDIF}
- inherited Destroy;
-end;
-
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
-function TCActiveIMM.GetServerProperties: TCActiveIMMProperties;
-begin
- Result := FProps;
-end;
-{$ENDIF}
-
-function TCActiveIMM.AssociateContext(var hWnd: _RemotableHandle; hIME: LongWord;
- out phPrev: LongWord): HResult;
-begin
- Result := DefaultInterface.AssociateContext(hWnd, hIME, phPrev);
-end;
-
-function TCActiveIMM.ConfigureIMEA(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDA): HResult;
-begin
- Result := DefaultInterface.ConfigureIMEA(hKL, hWnd, dwMode, pData);
-end;
-
-function TCActiveIMM.ConfigureIMEW(var hKL: Pointer; var hWnd: _RemotableHandle; dwMode: LongWord;
- var pData: REGISTERWORDW): HResult;
-begin
- Result := DefaultInterface.ConfigureIMEW(hKL, hWnd, dwMode, pData);
-end;
-
-function TCActiveIMM.CreateContext(out phIMC: LongWord): HResult;
-begin
- Result := DefaultInterface.CreateContext(phIMC);
-end;
-
-function TCActiveIMM.DestroyContext(hIME: LongWord): HResult;
-begin
- Result := DefaultInterface.DestroyContext(hIME);
-end;
-
-function TCActiveIMM.EnumRegisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szRegister: PAnsiChar; var pData: Pointer;
- out pEnum: IEnumRegisterWordA): HResult;
-begin
- Result := DefaultInterface.EnumRegisterWordA(hKL, szReading, dwStyle, szRegister, pData, pEnum);
-end;
-
-function TCActiveIMM.EnumRegisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar; var pData: Pointer;
- out pEnum: IEnumRegisterWordW): HResult;
-begin
- Result := DefaultInterface.EnumRegisterWordW(hKL, szReading, dwStyle, szRegister, pData, pEnum);
-end;
-
-function TCActiveIMM.EscapeA(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT;
- var pData: Pointer; out plResult: LONG_PTR): HResult;
-begin
- Result := DefaultInterface.EscapeA(hKL, hIMC, uEscape, pData, plResult);
-end;
-
-function TCActiveIMM.EscapeW(var hKL: Pointer; hIMC: LongWord; uEscape: SYSUINT;
- var pData: Pointer; out plResult: LONG_PTR): HResult;
-begin
- Result := DefaultInterface.EscapeW(hKL, hIMC, uEscape, pData, plResult);
-end;
-
-function TCActiveIMM.GetCandidateListA(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetCandidateListA(hIMC, dwIndex, uBufLen, pCandList, puCopied);
-end;
-
-function TCActiveIMM.GetCandidateListW(hIMC: LongWord; dwIndex: LongWord; uBufLen: SYSUINT;
- out pCandList: CANDIDATELIST; out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetCandidateListW(hIMC, dwIndex, uBufLen, pCandList, puCopied);
-end;
-
-function TCActiveIMM.GetCandidateListCountA(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult;
-begin
- Result := DefaultInterface.GetCandidateListCountA(hIMC, pdwListSize, pdwBufLen);
-end;
-
-function TCActiveIMM.GetCandidateListCountW(hIMC: LongWord; out pdwListSize: LongWord;
- out pdwBufLen: LongWord): HResult;
-begin
- Result := DefaultInterface.GetCandidateListCountW(hIMC, pdwListSize, pdwBufLen);
-end;
-
-function TCActiveIMM.GetCandidateWindow(hIMC: LongWord; dwIndex: LongWord;
- out pCandidate: CANDIDATEFORM): HResult;
-begin
- Result := DefaultInterface.GetCandidateWindow(hIMC, dwIndex, pCandidate);
-end;
-
-function TCActiveIMM.GetCompositionFontA(hIMC: LongWord; out plf: LOGFONTA): HResult;
-begin
- Result := DefaultInterface.GetCompositionFontA(hIMC, plf);
-end;
-
-function TCActiveIMM.GetCompositionFontW(hIMC: LongWord; out plf: LOGFONTW): HResult;
-begin
- Result := DefaultInterface.GetCompositionFontW(hIMC, plf);
-end;
-
-function TCActiveIMM.GetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult;
-begin
- Result := DefaultInterface.GetCompositionStringA(hIMC, dwIndex, dwBufLen, plCopied, pBuf);
-end;
-
-function TCActiveIMM.GetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- out plCopied: Integer; out pBuf: Pointer): HResult;
-begin
- Result := DefaultInterface.GetCompositionStringW(hIMC, dwIndex, dwBufLen, plCopied, pBuf);
-end;
-
-function TCActiveIMM.GetCompositionWindow(hIMC: LongWord; out pCompForm: COMPOSITIONFORM): HResult;
-begin
- Result := DefaultInterface.GetCompositionWindow(hIMC, pCompForm);
-end;
-
-function TCActiveIMM.GetContext(var hWnd: _RemotableHandle; out phIMC: LongWord): HResult;
-begin
- Result := DefaultInterface.GetContext(hWnd, phIMC);
-end;
-
-function TCActiveIMM.GetConversionListA(var hKL: Pointer; hIMC: LongWord; pSrc: PAnsiChar;
- uBufLen: SYSUINT; uFlag: SYSUINT; out pDst: CANDIDATELIST;
- out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetConversionListA(hKL, hIMC, pSrc, uBufLen, uFlag, pDst, puCopied);
-end;
-
-function TCActiveIMM.GetConversionListW(var hKL: Pointer; hIMC: LongWord; pSrc: PWideChar;
- uBufLen: SYSUINT; uFlag: SYSUINT; out pDst: CANDIDATELIST;
- out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetConversionListW(hKL, hIMC, pSrc, uBufLen, uFlag, pDst, puCopied);
-end;
-
-function TCActiveIMM.GetConversionStatus(hIMC: LongWord; out pfdwConversion: LongWord;
- out pfdwSentence: LongWord): HResult;
-begin
- Result := DefaultInterface.GetConversionStatus(hIMC, pfdwConversion, pfdwSentence);
-end;
-
-function TCActiveIMM.GetDefaultIMEWnd(var hWnd: _RemotableHandle; out phDefWnd: wireHWND): HResult;
-begin
- Result := DefaultInterface.GetDefaultIMEWnd(hWnd, phDefWnd);
-end;
-
-function TCActiveIMM.GetDescriptionA(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PAnsiChar;
- out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetDescriptionA(hKL, uBufLen, szDescription, puCopied);
-end;
-
-function TCActiveIMM.GetDescriptionW(var hKL: Pointer; uBufLen: SYSUINT; szDescription: PWideChar;
- out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetDescriptionW(hKL, uBufLen, szDescription, puCopied);
-end;
-
-function TCActiveIMM.GetGuideLineA(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- pBuf: PAnsiChar; out pdwResult: LongWord): HResult;
-begin
- Result := DefaultInterface.GetGuideLineA(hIMC, dwIndex, dwBufLen, pBuf, pdwResult);
-end;
-
-function TCActiveIMM.GetGuideLineW(hIMC: LongWord; dwIndex: LongWord; dwBufLen: LongWord;
- pBuf: PWideChar; out pdwResult: LongWord): HResult;
-begin
- Result := DefaultInterface.GetGuideLineW(hIMC, dwIndex, dwBufLen, pBuf, pdwResult);
-end;
-
-function TCActiveIMM.GetIMEFileNameA(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PAnsiChar;
- out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetIMEFileNameA(hKL, uBufLen, szFileName, puCopied);
-end;
-
-function TCActiveIMM.GetIMEFileNameW(var hKL: Pointer; uBufLen: SYSUINT; szFileName: PWideChar;
- out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetIMEFileNameW(hKL, uBufLen, szFileName, puCopied);
-end;
-
-function TCActiveIMM.GetOpenStatus(hIMC: LongWord): HResult;
-begin
- Result := DefaultInterface.GetOpenStatus(hIMC);
-end;
-
-function TCActiveIMM.GetProperty(var hKL: Pointer; fdwIndex: LongWord; out pdwProperty: LongWord): HResult;
-begin
- Result := DefaultInterface.GetProperty(hKL, fdwIndex, pdwProperty);
-end;
-
-function TCActiveIMM.GetRegisterWordStyleA(var hKL: Pointer; nItem: SYSUINT;
- out pStyleBuf: STYLEBUFA; out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetRegisterWordStyleA(hKL, nItem, pStyleBuf, puCopied);
-end;
-
-function TCActiveIMM.GetRegisterWordStyleW(var hKL: Pointer; nItem: SYSUINT;
- out pStyleBuf: STYLEBUFW; out puCopied: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetRegisterWordStyleW(hKL, nItem, pStyleBuf, puCopied);
-end;
-
-function TCActiveIMM.GetStatusWindowPos(hIMC: LongWord; out pptPos: tagPOINT): HResult;
-begin
- Result := DefaultInterface.GetStatusWindowPos(hIMC, pptPos);
-end;
-
-function TCActiveIMM.GetVirtualKey(var hWnd: _RemotableHandle; out puVirtualKey: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetVirtualKey(hWnd, puVirtualKey);
-end;
-
-function TCActiveIMM.InstallIMEA(szIMEFileName: PAnsiChar; szLayoutText: PAnsiChar; out phKL: Pointer): HResult;
-begin
- Result := DefaultInterface.InstallIMEA(szIMEFileName, szLayoutText, phKL);
-end;
-
-function TCActiveIMM.InstallIMEW(szIMEFileName: PWideChar; szLayoutText: PWideChar;
- out phKL: Pointer): HResult;
-begin
- Result := DefaultInterface.InstallIMEW(szIMEFileName, szLayoutText, phKL);
-end;
-
-function TCActiveIMM.IsIME(var hKL: Pointer): HResult;
-begin
- Result := DefaultInterface.IsIME(hKL);
-end;
-
-function TCActiveIMM.IsUIMessageA(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult;
-begin
- Result := DefaultInterface.IsUIMessageA(hWndIME, msg, wParam, lParam);
-end;
-
-function TCActiveIMM.IsUIMessageW(var hWndIME: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR): HResult;
-begin
- Result := DefaultInterface.IsUIMessageW(hWndIME, msg, wParam, lParam);
-end;
-
-function TCActiveIMM.NotifyIME(hIMC: LongWord; dwAction: LongWord; dwIndex: LongWord;
- dwValue: LongWord): HResult;
-begin
- Result := DefaultInterface.NotifyIME(hIMC, dwAction, dwIndex, dwValue);
-end;
-
-function TCActiveIMM.REGISTERWORDA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szRegister: PAnsiChar): HResult;
-begin
- Result := DefaultInterface.REGISTERWORDA(hKL, szReading, dwStyle, szRegister);
-end;
-
-function TCActiveIMM.REGISTERWORDW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szRegister: PWideChar): HResult;
-begin
- Result := DefaultInterface.REGISTERWORDW(hKL, szReading, dwStyle, szRegister);
-end;
-
-function TCActiveIMM.ReleaseContext(var hWnd: _RemotableHandle; hIMC: LongWord): HResult;
-begin
- Result := DefaultInterface.ReleaseContext(hWnd, hIMC);
-end;
-
-function TCActiveIMM.SetCandidateWindow(hIMC: LongWord; var pCandidate: CANDIDATEFORM): HResult;
-begin
- Result := DefaultInterface.SetCandidateWindow(hIMC, pCandidate);
-end;
-
-function TCActiveIMM.SetCompositionFontA(hIMC: LongWord; var plf: LOGFONTA): HResult;
-begin
- Result := DefaultInterface.SetCompositionFontA(hIMC, plf);
-end;
-
-function TCActiveIMM.SetCompositionFontW(hIMC: LongWord; var plf: LOGFONTW): HResult;
-begin
- Result := DefaultInterface.SetCompositionFontW(hIMC, plf);
-end;
-
-function TCActiveIMM.SetCompositionStringA(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer;
- dwReadLen: LongWord): HResult;
-begin
- Result := DefaultInterface.SetCompositionStringA(hIMC, dwIndex, pComp, dwCompLen, pRead, dwReadLen);
-end;
-
-function TCActiveIMM.SetCompositionStringW(hIMC: LongWord; dwIndex: LongWord; var pComp: Pointer;
- dwCompLen: LongWord; var pRead: Pointer;
- dwReadLen: LongWord): HResult;
-begin
- Result := DefaultInterface.SetCompositionStringW(hIMC, dwIndex, pComp, dwCompLen, pRead, dwReadLen);
-end;
-
-function TCActiveIMM.SetCompositionWindow(hIMC: LongWord; var pCompForm: COMPOSITIONFORM): HResult;
-begin
- Result := DefaultInterface.SetCompositionWindow(hIMC, pCompForm);
-end;
-
-function TCActiveIMM.SetConversionStatus(hIMC: LongWord; fdwConversion: LongWord;
- fdwSentence: LongWord): HResult;
-begin
- Result := DefaultInterface.SetConversionStatus(hIMC, fdwConversion, fdwSentence);
-end;
-
-function TCActiveIMM.SetOpenStatus(hIMC: LongWord; fOpen: Integer): HResult;
-begin
- Result := DefaultInterface.SetOpenStatus(hIMC, fOpen);
-end;
-
-function TCActiveIMM.SetStatusWindowPos(hIMC: LongWord; var pptPos: tagPOINT): HResult;
-begin
- Result := DefaultInterface.SetStatusWindowPos(hIMC, pptPos);
-end;
-
-function TCActiveIMM.SimulateHotKey(var hWnd: _RemotableHandle; dwHotKeyID: LongWord): HResult;
-begin
- Result := DefaultInterface.SimulateHotKey(hWnd, dwHotKeyID);
-end;
-
-function TCActiveIMM.UnregisterWordA(var hKL: Pointer; szReading: PAnsiChar; dwStyle: LongWord;
- szUnregister: PAnsiChar): HResult;
-begin
- Result := DefaultInterface.UnregisterWordA(hKL, szReading, dwStyle, szUnregister);
-end;
-
-function TCActiveIMM.UnregisterWordW(var hKL: Pointer; szReading: PWideChar; dwStyle: LongWord;
- szUnregister: PWideChar): HResult;
-begin
- Result := DefaultInterface.UnregisterWordW(hKL, szReading, dwStyle, szUnregister);
-end;
-
-function TCActiveIMM.Activate(fRestoreLayout: Integer): HResult;
-begin
- Result := DefaultInterface.Activate(fRestoreLayout);
-end;
-
-function TCActiveIMM.Deactivate: HResult;
-begin
- Result := DefaultInterface.Deactivate;
-end;
-
-function TCActiveIMM.OnDefWindowProc(var hWnd: _RemotableHandle; msg: SYSUINT; wParam: UINT_PTR;
- lParam: LONG_PTR; out plResult: LONG_PTR): HResult;
-begin
- Result := DefaultInterface.OnDefWindowProc(hWnd, msg, wParam, lParam, plResult);
-end;
-
-function TCActiveIMM.FilterClientWindows(var aaClassList: Word; uSize: SYSUINT): HResult;
-begin
- Result := DefaultInterface.FilterClientWindows(aaClassList, uSize);
-end;
-
-function TCActiveIMM.GetCodePageA(var hKL: Pointer; out uCodePage: SYSUINT): HResult;
-begin
- Result := DefaultInterface.GetCodePageA(hKL, uCodePage);
-end;
-
-function TCActiveIMM.GetLangId(var hKL: Pointer; out plid: Word): HResult;
-begin
- Result := DefaultInterface.GetLangId(hKL, plid);
-end;
-
-function TCActiveIMM.AssociateContextEx(var hWnd: _RemotableHandle; hIMC: LongWord;
- dwFlags: LongWord): HResult;
-begin
- Result := DefaultInterface.AssociateContextEx(hWnd, hIMC, dwFlags);
-end;
-
-function TCActiveIMM.DisableIME(idThread: LongWord): HResult;
-begin
- Result := DefaultInterface.DisableIME(idThread);
-end;
-
-function TCActiveIMM.GetImeMenuItemsA(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOA;
- out pImeMenu: IMEMENUITEMINFOA; dwSize: LongWord;
- out pdwResult: LongWord): HResult;
-begin
- Result := DefaultInterface.GetImeMenuItemsA(hIMC, dwFlags, dwType, pImeParentMenu, pImeMenu,
- dwSize, pdwResult);
-end;
-
-function TCActiveIMM.GetImeMenuItemsW(hIMC: LongWord; dwFlags: LongWord; dwType: LongWord;
- var pImeParentMenu: IMEMENUITEMINFOW;
- out pImeMenu: IMEMENUITEMINFOW; dwSize: LongWord;
- out pdwResult: LongWord): HResult;
-begin
- Result := DefaultInterface.GetImeMenuItemsW(hIMC, dwFlags, dwType, pImeParentMenu, pImeMenu,
- dwSize, pdwResult);
-end;
-
-function TCActiveIMM.EnumInputContext(idThread: LongWord; out ppEnum: IEnumInputContext): HResult;
-begin
- Result := DefaultInterface.EnumInputContext(idThread, ppEnum);
-end;
-
-{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
-constructor TCActiveIMMProperties.Create(AServer: TCActiveIMM);
-begin
- inherited Create;
- FServer := AServer;
-end;
-
-function TCActiveIMMProperties.GetDefaultInterface: IActiveIMMApp;
-begin
- Result := FServer.DefaultInterface;
-end;
-
-{$ENDIF}
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntActnList.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntActnList.pas deleted file mode 100644 index 0f3e69893c..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntActnList.pas +++ /dev/null @@ -1,835 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntActnList;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, Controls, ActnList, Buttons, ExtCtrls, ComCtrls, StdCtrls, Menus;
-
-type
-{TNT-WARN TActionList}
- TTntActionList = class(TActionList{TNT-ALLOW TActionList})
- private
- FCheckActionsTimer: TTimer;
- procedure CheckActions(Sender: TObject);
- public
- constructor Create(AOwner: TComponent); override;
- end;
-
- ITntAction = interface
- ['{59D0AE37-8161-4AD6-9102-14B28E5761EB}']
- end;
-
-//---------------------------------------------------------------------------------------------
-// ACTIONS
-//---------------------------------------------------------------------------------------------
-
-{TNT-WARN TCustomAction}
- TTntCustomAction = class(TCustomAction{TNT-ALLOW TCustomAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TAction}
- TTntAction = class(TAction{TNT-ALLOW TAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-//---------------------------------------------------------------------------------------------
-
-// MENU ACTION LINK
-//---------------------------------------------------------------------------------------------
-
-{TNT-WARN TMenuActionLink}
- TTntMenuActionLink = class(TMenuActionLink{TNT-ALLOW TMenuActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- end;
-
-//---------------------------------------------------------------------------------------------
-// CONTROL ACTION LINKS
-//---------------------------------------------------------------------------------------------
-
-{TNT-WARN TListViewActionLink}
- TTntListViewActionLink = class(TListViewActionLink{TNT-ALLOW TListViewActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- end;
-
-{TNT-WARN TComboBoxExActionLink}
- TTntComboBoxExActionLink = class(TComboBoxExActionLink{TNT-ALLOW TComboBoxExActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- end;
-
-{TNT-WARN TSpeedButtonActionLink}
- TTntSpeedButtonActionLink = class(TSpeedButtonActionLink{TNT-ALLOW TSpeedButtonActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- {$IFDEF COMPILER_10_UP}
- function IsImageIndexLinked: Boolean; override;
- procedure SetImageIndex(Value: Integer); override;
- {$ENDIF}
- end;
-
-{$IFDEF COMPILER_10_UP}
-{TNT-WARN TBitBtnActionLink}
- TTntBitBtnActionLink = class(TBitBtnActionLink{TNT-ALLOW TBitBtnActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- {$IFDEF COMPILER_10_UP}
- function IsImageIndexLinked: Boolean; override;
- procedure SetImageIndex(Value: Integer); override;
- {$ENDIF}
- end;
-{$ENDIF}
-
-{TNT-WARN TToolButtonActionLink}
- TTntToolButtonActionLink = class(TToolButtonActionLink{TNT-ALLOW TToolButtonActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- end;
-
-{TNT-WARN TButtonActionLink}
- TTntButtonActionLink = class(TButtonActionLink{TNT-ALLOW TButtonActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- end;
-
-{TNT-WARN TWinControlActionLink}
- TTntWinControlActionLink = class(TWinControlActionLink{TNT-ALLOW TWinControlActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- end;
-
-{TNT-WARN TControlActionLink}
- TTntControlActionLink = class(TControlActionLink{TNT-ALLOW TControlActionLink})
- protected
- function IsCaptionLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- procedure SetCaption(const Value: string{TNT-ALLOW string}); override;
- procedure SetHint(const Value: string{TNT-ALLOW string}); override;
- end;
-
-//---------------------------------------------------------------------------------------------
-// helper procs
-//---------------------------------------------------------------------------------------------
-
-//-- TCustomAction helper routines
-procedure TntAction_SetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
-function TntAction_GetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
-function TntAction_GetNewCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
-procedure TntAction_SetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
-function TntAction_GetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
-function TntAction_GetNewHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
-procedure TntAction_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-
-// -- TControl helper routines
-function TntControl_GetActionLinkClass(Control: TControl; InheritedLinkClass: TControlActionLinkClass): TControlActionLinkClass;
-procedure TntControl_BeforeInherited_ActionChange(Control: TControl; Sender: TObject; CheckDefaults: Boolean);
-
-// -- TControlActionLink helper routines
-function TntActionLink_IsCaptionLinked(InheritedIsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
-function TntActionLink_IsHintLinked(InheritedIsHintLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
-procedure TntActionLink_SetCaption(IsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
-procedure TntActionLink_SetHint(IsHintLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
-
-type
- TUpgradeActionListItemsProc = procedure (ActionList: TTntActionList);
-
-var
- UpgradeActionListItemsProc: TUpgradeActionListItemsProc;
-
-implementation
-
-uses
- SysUtils, TntMenus, TntClasses, TntControls;
-
-{ TActionListList }
-
-type
- TActionListList = class(TList)
- private
- FActionList: TTntActionList;
- protected
- procedure Notify(Ptr: Pointer; Action: TListNotification); override;
- end;
-
-procedure TActionListList.Notify(Ptr: Pointer; Action: TListNotification);
-begin
- inherited;
- if (Action = lnAdded) and (FActionList <> nil) and (Ptr <> nil)
- and (not Supports(TObject(Ptr), ITntAction)) then
- begin
- FActionList.FCheckActionsTimer.Enabled := False;
- FActionList.FCheckActionsTimer.Enabled := True;
- end;
-end;
-
-{ THackActionList }
-
-type
-{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
- THackCustomActionList = class(TComponent)
- private
- FActions: TList;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
- THackCustomActionList = class(TComponent)
- private
- FActions: TList;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
- THackCustomActionList = class(TComponent)
- private
- FActions: TList;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
- THackCustomActionList = class(TComponent)
- private
- FActions: TList;
- end;
-{$ENDIF}
-
-{ TTntActionList }
-
-constructor TTntActionList.Create(AOwner: TComponent);
-begin
- inherited;
- if (csDesigning in ComponentState) then begin
- FCheckActionsTimer := TTimer.Create(Self);
- FCheckActionsTimer.Enabled := False;
- FCheckActionsTimer.Interval := 50;
- FCheckActionsTimer.OnTimer := CheckActions;
- //
- THackCustomActionList(Self).FActions.Free;
- THackCustomActionList(Self).FActions := TActionListList.Create;
- TActionListList(THackCustomActionList(Self).FActions).FActionList := Self;
- end;
-end;
-
-procedure TTntActionList.CheckActions(Sender: TObject);
-begin
- if FCheckActionsTimer <> nil then begin
- FCheckActionsTimer.Enabled := False;
- end;
- Assert(csDesigning in ComponentState);
- Assert(Assigned(UpgradeActionListItemsProc));
- UpgradeActionListItemsProc(Self);
-end;
-
-{ TCustomActionHelper }
-
-type
- TCustomActionHelper = class(TComponent)
- private
- FAction: TCustomAction{TNT-ALLOW TCustomAction};
- private
- FCaption: WideString;
- FSettingNewCaption: Boolean;
- FOldWideCaption: WideString;
- FNewAnsiCaption: AnsiString;
- procedure SetAnsiCaption(const Value: AnsiString);
- function SettingNewCaption: Boolean;
- procedure SetCaption(const Value: WideString);
- function GetCaption: WideString;
- private
- FHint: WideString;
- FSettingNewHint: Boolean;
- FOldWideHint: WideString;
- FNewAnsiHint: AnsiString;
- procedure SetAnsiHint(const Value: AnsiString);
- function SettingNewHint: Boolean;
- procedure SetHint(const Value: WideString);
- function GetHint: WideString;
- end;
-
-procedure TCustomActionHelper.SetAnsiCaption(const Value: AnsiString);
-begin
- FAction.Caption := Value;
- if (Value = '') and (FNewAnsiCaption <> '') then
- FOldWideCaption := '';
-end;
-
-function TCustomActionHelper.SettingNewCaption: Boolean;
-begin
- Result := FSettingNewCaption and (FAction.Caption <> FNewAnsiCaption);
-end;
-
-function TCustomActionHelper.GetCaption: WideString;
-begin
- if SettingNewCaption then
- Result := FOldWideCaption
- else
- Result := GetSyncedWideString(FCaption, FAction.Caption)
-end;
-
-procedure TCustomActionHelper.SetCaption(const Value: WideString);
-begin
- FOldWideCaption := GetCaption;
- FNewAnsiCaption := Value;
- FSettingNewCaption := True;
- try
- SetSyncedWideString(Value, FCaption, FAction.Caption, SetAnsiCaption)
- finally
- FSettingNewCaption := False;
- end;
-end;
-
-procedure TCustomActionHelper.SetAnsiHint(const Value: AnsiString);
-begin
- FAction.Hint := Value;
- if (Value = '') and (FNewAnsiHint <> '') then
- FOldWideHint := '';
-end;
-
-function TCustomActionHelper.SettingNewHint: Boolean;
-begin
- Result := FSettingNewHint and (FAction.Hint <> FNewAnsiHint);
-end;
-
-function TCustomActionHelper.GetHint: WideString;
-begin
- if SettingNewHint then
- Result := FOldWideHint
- else
- Result := GetSyncedWideString(FHint, FAction.Hint)
-end;
-
-procedure TCustomActionHelper.SetHint(const Value: WideString);
-begin
- FOldWideHint := GetHint;
- FNewAnsiHint := Value;
- FSettingNewHint := True;
- try
- SetSyncedWideString(Value, FHint, FAction.Hint, SetAnsiHint)
- finally
- FSettingNewHint := False;
- end;
-end;
-
-function FindActionHelper(Action: TCustomAction{TNT-ALLOW TCustomAction}): TCustomActionHelper;
-var
- i: integer;
-begin
- Assert(Action <> nil);
- Result := nil;
- if Supports(Action, ITntAction) then begin
- for i := 0 to Action.ComponentCount - 1 do begin
- if Action.Components[i] is TCustomActionHelper then begin
- Result := TCustomActionHelper(Action.Components[i]);
- break;
- end;
- end;
- if Result = nil then begin
- Result := TCustomActionHelper.Create(Action);
- Result.FAction := Action;
- end;
- end;
-end;
-
-//-- TCustomAction helper routines
-
-procedure TntAction_SetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
-begin
- if Supports(Action, ITntAction) then
- with FindActionHelper(Action) do
- SetCaption(Value)
- else
- Action.Caption := Value;
-end;
-
-function TntAction_GetCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
-begin
- if Supports(Action, ITntAction) then
- with FindActionHelper(Action) do
- Result := GetCaption
- else
- Result := Action.Caption;
-end;
-
-function TntAction_GetNewCaption(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
-begin
- Result := Default;
- if Supports(Action, ITntAction) then
- with FindActionHelper(Action) do
- if SettingNewCaption then
- Result := FCaption;
-end;
-
-procedure TntAction_SetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
-begin
- if Supports(Action, ITntAction) then
- with FindActionHelper(Action) do
- SetHint(Value)
- else
- Action.Hint := Value;
-end;
-
-function TntAction_GetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
-begin
- if Supports(Action, ITntAction) then
- with FindActionHelper(Action) do
- Result := GetHint
- else
- Result := Action.Hint;
-end;
-
-function TntAction_GetNewHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
-begin
- Result := Default;
- if Supports(Action, ITntAction) then
- with FindActionHelper(Action) do
- if SettingNewHint then
- Result := FHint;
-end;
-
-procedure TntAction_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-begin
- with Action do begin
- if (Source is TCustomAction{TNT-ALLOW TCustomAction}) then begin
- Caption := TntAction_GetCaption(Source as TCustomAction{TNT-ALLOW TCustomAction});
- Hint := TntAction_GetHint(Source as TCustomAction{TNT-ALLOW TCustomAction});
- end else if (Source is TControl) then begin
- Caption := TntControl_GetText(Source as TControl);
- Hint := TntControl_GetHint(Source as TControl);
- end;
- end;
-end;
-
-// -- TControl helper routines
-
-function TntControl_GetActionLinkClass(Control: TControl; InheritedLinkClass: TControlActionLinkClass): TControlActionLinkClass;
-begin
- if Control is TCustomListView{TNT-ALLOW TCustomListView} then
- Result := TTntListViewActionLink
- else if Control is TComboBoxEx then
- Result := TTntComboBoxExActionLink
- else if Control is TSpeedButton{TNT-ALLOW TSpeedButton} then
- Result := TTntSpeedButtonActionLink
- {$IFDEF COMPILER_10_UP}
- else if Control is TBitBtn{TNT-ALLOW TBitBtn} then
- Result := TTntBitBtnActionLink
- {$ENDIF}
- else if Control is TToolButton{TNT-ALLOW TToolButton} then
- Result := TTntToolButtonActionLink
- else if Control is TButtonControl then
- Result := TTntButtonActionLink
- else if Control is TWinControl then
- Result := TTntWinControlActionLink
- else
- Result := TTntControlActionLink;
-
- Assert(Result.ClassParent = InheritedLinkClass);
-end;
-
-procedure TntControl_BeforeInherited_ActionChange(Control: TControl; Sender: TObject; CheckDefaults: Boolean);
-begin
- if (Sender is TCustomAction{TNT-ALLOW TCustomAction}) and Supports(Sender, ITntAction) then begin
- if not CheckDefaults or (TntControl_GetText(Control) = '') or (TntControl_GetText(Control) = Control.Name) then
- TntControl_SetText(Control, TntAction_GetCaption(TCustomAction{TNT-ALLOW TCustomAction}(Sender)));
- if not CheckDefaults or (TntControl_GetHint(Control) = '') then
- TntControl_SetHint(Control, TntAction_GetHint(TCustomAction{TNT-ALLOW TCustomAction}(Sender)));
- end;
-end;
-
-// -- TControlActionLink helper routines
-
-function TntActionLink_IsCaptionLinked(InheritedIsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
-begin
- Result := InheritedIsCaptionLinked
- and (TntAction_GetCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}) = TntControl_GetText(FClient));
-end;
-
-function TntActionLink_IsHintLinked(InheritedIsHintLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
-begin
- Result := InheritedIsHintLinked
- and (TntAction_GetHint(Action as TCustomAction{TNT-ALLOW TCustomAction}) = TntControl_GetHint(FClient));
-end;
-
-procedure TntActionLink_SetCaption(IsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
-begin
- if IsCaptionLinked then
- TntControl_SetText(FClient, TntAction_GetNewCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value));
-end;
-
-procedure TntActionLink_SetHint(IsHintLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
-begin
- if IsHintLinked then
- TntControl_SetHint(FClient, TntAction_GetNewHint(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value));
-end;
-
-//---------------------------------------------------------------------------------------------
-// ACTIONS
-//---------------------------------------------------------------------------------------------
-
-{ TTntCustomAction }
-
-procedure TTntCustomAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntAction_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntCustomAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntCustomAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntCustomAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntCustomAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntAction }
-
-procedure TTntAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntAction_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-//---------------------------------------------------------------------------------------------
-// MENU ACTION LINK
-//---------------------------------------------------------------------------------------------
-
-{ TTntMenuActionLink }
-
-function TTntMenuActionLink.IsCaptionLinked: Boolean;
-begin
- Result := inherited IsCaptionLinked
- and WideSameCaption(TntAction_GetCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}), (FClient as TTntMenuItem).Caption);
-end;
-
-function TTntMenuActionLink.IsHintLinked: Boolean;
-begin
- Result := inherited IsHintLinked
- and (TntAction_GetHint(Action as TCustomAction{TNT-ALLOW TCustomAction}) = (FClient as TTntMenuItem).Hint);
-end;
-
-procedure TTntMenuActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- if IsCaptionLinked then
- (FClient as TTntMenuItem).Caption := TntAction_GetNewCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value);
-end;
-
-procedure TTntMenuActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- if IsHintLinked then
- (FClient as TTntMenuItem).Hint := TntAction_GetNewHint(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value);
-end;
-
-//---------------------------------------------------------------------------------------------
-// CONTROL ACTION LINKS
-//---------------------------------------------------------------------------------------------
-
-{ TTntListViewActionLink }
-
-function TTntListViewActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntListViewActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntListViewActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntListViewActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-{ TTntComboBoxExActionLink }
-
-function TTntComboBoxExActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntComboBoxExActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntComboBoxExActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntComboBoxExActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-{ TTntSpeedButtonActionLink }
-
-function TTntSpeedButtonActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntSpeedButtonActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntSpeedButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntSpeedButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-{$IFDEF COMPILER_10_UP}
-// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
-
-function TTntSpeedButtonActionLink.IsImageIndexLinked: Boolean;
-begin
- Result := Action is TCustomAction{TNT-ALLOW TCustomAction}; // taken from TActionLink.IsImageIndexLinked
-end;
-
-procedure TTntSpeedButtonActionLink.SetImageIndex(Value: Integer);
-begin
- ; // taken from TActionLink.IsImageIndexLinked
-end;
-{$ENDIF}
-
-{$IFDEF COMPILER_10_UP}
-{ TTntBitBtnActionLink }
-
-function TTntBitBtnActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntBitBtnActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntBitBtnActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntBitBtnActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-{$IFDEF COMPILER_10_UP}
-// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
-
-function TTntBitBtnActionLink.IsImageIndexLinked: Boolean;
-begin
- Result := Action is TCustomAction{TNT-ALLOW TCustomAction}; // taken from TActionLink.IsImageIndexLinked
-end;
-
-procedure TTntBitBtnActionLink.SetImageIndex(Value: Integer);
-begin
- ; // taken from TActionLink.IsImageIndexLinked
-end;
-{$ENDIF}
-
-{$ENDIF}
-
-{ TTntToolButtonActionLink }
-
-function TTntToolButtonActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntToolButtonActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntToolButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntToolButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-{ TTntButtonActionLink }
-
-function TTntButtonActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntButtonActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-{ TTntWinControlActionLink }
-
-function TTntWinControlActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntWinControlActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntWinControlActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntWinControlActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-{ TTntControlActionLink }
-
-function TTntControlActionLink.IsCaptionLinked: Boolean;
-begin
- Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
-end;
-
-function TTntControlActionLink.IsHintLinked: Boolean;
-begin
- Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
-end;
-
-procedure TTntControlActionLink.SetCaption(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
-end;
-
-procedure TTntControlActionLink.SetHint(const Value: string{TNT-ALLOW string});
-begin
- TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntAxCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntAxCtrls.pas deleted file mode 100644 index bc4b03c883..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntAxCtrls.pas +++ /dev/null @@ -1,191 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntAxCtrls;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- ComObj, StdVcl,
- {$IFNDEF COMPILER_10_UP}
- TntWideStrings,
- {$ELSE}
- WideStrings,
- {$ENDIF}
- TntClasses;
-
-type
- TWideStringsAdapter = class(TAutoIntfObject, IStrings, IWideStringsAdapter)
- private
- FStrings: TWideStrings;
- protected
- { IWideStringsAdapter }
- procedure ReferenceStrings(S: TWideStrings);
- procedure ReleaseStrings;
- { IStrings }
- function Get_ControlDefault(Index: Integer): OleVariant; safecall;
- procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
- function Count: Integer; safecall;
- function Get_Item(Index: Integer): OleVariant; safecall;
- procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
- procedure Remove(Index: Integer); safecall;
- procedure Clear; safecall;
- function Add(Item: OleVariant): Integer; safecall;
- function _NewEnum: IUnknown; safecall;
- public
- constructor Create(Strings: TTntStrings);
- end;
-
-implementation
-
-uses
- Classes, ActiveX, Variants;
-
-{ TStringsEnumerator }
-
-type
- TStringsEnumerator = class(TContainedObject, IEnumString)
- private
- FIndex: Integer; // index of next unread string
- FStrings: IStrings;
- public
- constructor Create(const Strings: IStrings);
- function Next(celt: Longint; out elt;
- pceltFetched: PLongint): HResult; stdcall;
- function Skip(celt: Longint): HResult; stdcall;
- function Reset: HResult; stdcall;
- function Clone(out enm: IEnumString): HResult; stdcall;
- end;
-
-constructor TStringsEnumerator.Create(const Strings: IStrings);
-begin
- inherited Create(Strings);
- FStrings := Strings;
-end;
-
-function TStringsEnumerator.Next(celt: Longint; out elt; pceltFetched: PLongint): HResult;
-var
- I: Integer;
-begin
- I := 0;
- while (I < celt) and (FIndex < FStrings.Count) do
- begin
- TPointerList(elt)[I] := PWideChar(WideString(FStrings.Item[FIndex]));
- Inc(I);
- Inc(FIndex);
- end;
- if pceltFetched <> nil then pceltFetched^ := I;
- if I = celt then Result := S_OK else Result := S_FALSE;
-end;
-
-function TStringsEnumerator.Skip(celt: Longint): HResult;
-begin
- if (FIndex + celt) <= FStrings.Count then
- begin
- Inc(FIndex, celt);
- Result := S_OK;
- end
- else
- begin
- FIndex := FStrings.Count;
- Result := S_FALSE;
- end;
-end;
-
-function TStringsEnumerator.Reset: HResult;
-begin
- FIndex := 0;
- Result := S_OK;
-end;
-
-function TStringsEnumerator.Clone(out enm: IEnumString): HResult;
-begin
- try
- enm := TStringsEnumerator.Create(FStrings);
- TStringsEnumerator(enm).FIndex := FIndex;
- Result := S_OK;
- except
- Result := E_UNEXPECTED;
- end;
-end;
-
-{ TWideStringsAdapter }
-
-constructor TWideStringsAdapter.Create(Strings: TTntStrings);
-var
- StdVcl: ITypeLib;
-begin
- OleCheck(LoadRegTypeLib(LIBID_STDVCL, 4, 0, 0, StdVcl));
- inherited Create(StdVcl, IStrings);
- FStrings := Strings;
-end;
-
-procedure TWideStringsAdapter.ReferenceStrings(S: TWideStrings);
-begin
- FStrings := S;
-end;
-
-procedure TWideStringsAdapter.ReleaseStrings;
-begin
- FStrings := nil;
-end;
-
-function TWideStringsAdapter.Get_ControlDefault(Index: Integer): OleVariant;
-begin
- Result := Get_Item(Index);
-end;
-
-procedure TWideStringsAdapter.Set_ControlDefault(Index: Integer; Value: OleVariant);
-begin
- Set_Item(Index, Value);
-end;
-
-function TWideStringsAdapter.Count: Integer;
-begin
- Result := 0;
- if FStrings <> nil then Result := FStrings.Count;
-end;
-
-function TWideStringsAdapter.Get_Item(Index: Integer): OleVariant;
-begin
- Result := NULL;
- if (FStrings <> nil) then Result := WideString(FStrings[Index]);
-end;
-
-procedure TWideStringsAdapter.Set_Item(Index: Integer; Value: OleVariant);
-begin
- if (FStrings <> nil) then FStrings[Index] := Value;
-end;
-
-procedure TWideStringsAdapter.Remove(Index: Integer);
-begin
- if FStrings <> nil then FStrings.Delete(Index);
-end;
-
-procedure TWideStringsAdapter.Clear;
-begin
- if FStrings <> nil then FStrings.Clear;
-end;
-
-function TWideStringsAdapter.Add(Item: OleVariant): Integer;
-begin
- Result := -1;
- if FStrings <> nil then Result := FStrings.Add(Item);
-end;
-
-function TWideStringsAdapter._NewEnum: IUnknown;
-begin
- Result := TStringsEnumerator.Create(Self);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntBandActn.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntBandActn.pas deleted file mode 100644 index 2528c42ffb..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntBandActn.pas +++ /dev/null @@ -1,92 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntBandActn;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, BandActn, TntActnList;
-
-type
-{TNT-WARN TCustomizeActionBars}
- TTntCustomizeActionBars = class(TCustomizeActionBars{TNT-ALLOW TCustomizeActionBars}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-implementation
-
-uses
- ActnList, TntClasses;
-
-{TNT-IGNORE-UNIT}
-
-procedure TntBandActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-begin
- TntAction_AfterInherited_Assign(Action, Source);
- // TCustomizeActionBars
- if (Action is TCustomizeActionBars) and (Source is TCustomizeActionBars) then begin
- TCustomizeActionBars(Action).ActionManager := TCustomizeActionBars(Source).ActionManager;
- end;
-end;
-
-//-------------------------
-// TNT BAND ACTN
-//-------------------------
-
-{ TTntCustomizeActionBars }
-
-procedure TTntCustomizeActionBars.Assign(Source: TPersistent);
-begin
- inherited;
- TntBandActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntCustomizeActionBars.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomizeActionBars.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntCustomizeActionBars.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntCustomizeActionBars.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntCustomizeActionBars.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntButtons.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntButtons.pas deleted file mode 100644 index dd2ab6028c..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntButtons.pas +++ /dev/null @@ -1,982 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntButtons;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Windows, Messages, Classes, Controls, Graphics, StdCtrls,
- ExtCtrls, CommCtrl, Buttons,
- TntControls;
-
-type
- ITntGlyphButton = interface
- ['{15D7E501-1E33-4293-8B45-716FB3B14504}']
- function GetButtonGlyph: Pointer;
- procedure UpdateInternalGlyphList;
- end;
-
-{TNT-WARN TSpeedButton}
- TTntSpeedButton = class(TSpeedButton {TNT-ALLOW TSpeedButton}, ITntGlyphButton)
- private
- FPaintInherited: Boolean;
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- protected
- function GetButtonGlyph: Pointer;
- procedure UpdateInternalGlyphList; dynamic;
- procedure PaintButton; dynamic;
- procedure Paint; override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TBitBtn}
- TTntBitBtn = class(TBitBtn {TNT-ALLOW TBitBtn}, ITntGlyphButton)
- private
- FPaintInherited: Boolean;
- FMouseInControl: Boolean;
- function IsCaptionStored: Boolean;
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
- 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;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- 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 {$IFDEF COMPILER_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 COMPILER_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
-
-implementation
-
-uses
- SysUtils, ActnList, TntForms, TntStdCtrls, TypInfo, RTLConsts, TntWindows,
- {$IFDEF THEME_7_UP} Themes, {$ENDIF} TntClasses, TntActnList, 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_D6_D7_D9 = class
- protected
- FOriginal: TBitmap;
- FGlyphList: TImageList;
- FIndexs: array[TButtonState] of Integer;
- FxxxxTransparentColor: TColor;
- FNumGlyphs: TNumGlyphs;
- end;
-
- THackBitBtn_D6_D7_D9 = class(TButton{TNT-ALLOW TButton})
- protected
- FCanvas: TCanvas;
- FGlyph: Pointer;
- FxxxxStyle: TButtonStyle;
- FxxxxKind: TBitBtnKind;
- FxxxxLayout: TButtonLayout;
- FxxxxSpacing: Integer;
- FxxxxMargin: Integer;
- IsFocused: Boolean;
- end;
-
- THackSpeedButton_D6_D7_D9 = class(TGraphicControl)
- protected
- FxxxxGroupIndex: Integer;
- FGlyph: Pointer;
- FxxxxDown: Boolean;
- FDragging: Boolean;
- end;
-
- {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
- THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
- THackBitBtn = THackBitBtn_D6_D7_D9;
- THackSpeedButton = THackSpeedButton_D6_D7_D9;
- {$ENDIF}
- {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
- THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
- THackBitBtn = THackBitBtn_D6_D7_D9;
- THackSpeedButton = THackSpeedButton_D6_D7_D9;
- {$ENDIF}
- {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
- THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
- THackBitBtn = THackBitBtn_D6_D7_D9;
- THackSpeedButton = THackSpeedButton_D6_D7_D9;
- {$ENDIF}
- {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
- THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
- THackBitBtn = THackBitBtn_D6_D7_D9;
- THackSpeedButton = THackSpeedButton_D6_D7_D9;
- {$ENDIF}
-
-function GetButtonGlyph(Control: TControl): THackButtonGlyph;
-var
- GlyphButton: ITntGlyphButton;
-begin
- if Control.GetInterface(ITntGlyphButton, GlyphButton) then
- Result := GlyphButton.GetButtonGlyph
- else
- 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 := GetButtonGlyph(Control);
- NumGlyphs := ButtonGlyph.FNumGlyphs;
-
- if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
- Result := ButtonGlyph.FIndexs[State];
- if (Result = -1) then begin
- UpdateInternalGlyphList(Control);
- Result := ButtonGlyph.FIndexs[State];
- end;
-end;
-
-procedure TButtonGlyph_DrawButtonGlyph(Control: TControl; Canvas: TCanvas; const GlyphPos: TPoint;
- State: TButtonState; Transparent: Boolean);
-var
- ButtonGlyph: THackButtonGlyph;
- Glyph: TBitmap;
- GlyphList: TImageList;
- Index: Integer;
- {$IFDEF THEME_7_UP}
- Details: TThemedElementDetails;
- R: TRect;
- Button: TThemedButton;
- {$ENDIF}
-begin
- 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 THEME_7_UP}
- if ThemeServices.ThemesEnabled then begin
- R.TopLeft := GlyphPos;
- R.Right := R.Left + Glyph.Width div ButtonGlyph.FNumGlyphs;
- R.Bottom := R.Top + Glyph.Height;
- case State of
- bsDisabled:
- Button := tbPushButtonDisabled;
- bsDown,
- bsExclusive:
- Button := tbPushButtonPressed;
- else
- // bsUp
- Button := tbPushButtonNormal;
- end;
- Details := ThemeServices.GetElementDetails(Button);
- ThemeServices.DrawIcon(Canvas.Handle, Details, R, GlyphList.Handle, Index);
- end else
- {$ENDIF}
- if Transparent or (State = bsExclusive) then
- ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
- clNone, clNone, ILD_Transparent)
- else
- ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
- ColorToRGB(clBtnFace), clNone, ILD_Normal);
-end;
-
-procedure TButtonGlyph_DrawButtonText(Canvas: TCanvas; const Caption: WideString;
- TextBounds: TRect; State: TButtonState;
- BiDiFlags: LongInt {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
-begin
- with Canvas do
- begin
- Brush.Style := bsClear;
- if State = bsDisabled then
- begin
- OffsetRect(TextBounds, 1, 1);
- Font.Color := clBtnHighlight;
-
- {$IFDEF COMPILER_7_UP}
- if WordWrap then
- Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
- DT_CENTER or DT_VCENTER or BiDiFlags or DT_WORDBREAK)
- else
- {$ENDIF}
- Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
- DT_CENTER or DT_VCENTER or BiDiFlags);
-
- OffsetRect(TextBounds, -1, -1);
- Font.Color := clBtnShadow;
-
- {$IFDEF COMPILER_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
- begin
- {$IFDEF COMPILER_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 {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
-var
- TextPos: TPoint;
- ClientSize,
- GlyphSize,
- TextSize: TPoint;
- TotalSize: TPoint;
- Glyph: TBitmap;
- NumGlyphs: Integer;
- ButtonGlyph: THackButtonGlyph;
-begin
- ButtonGlyph := GetButtonGlyph(Control);
- Glyph := ButtonGlyph.FOriginal;
- NumGlyphs := ButtonGlyph.FNumGlyphs;
-
- if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
- if Layout = blGlyphLeft then
- Layout := blGlyphRight
- else
- if Layout = blGlyphRight then
- Layout := blGlyphLeft;
-
- // Calculate the item sizes.
- ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);
-
- if Assigned(Glyph) then
- GlyphSize := Point(Glyph.Width div NumGlyphs, Glyph.Height)
- else
- GlyphSize := Point(0, 0);
-
- if Length(Caption) > 0 then
- begin
- {$IFDEF COMPILER_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);
- {$ENDIF}
-
- {$IFDEF COMPILER_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);
- end;
-
- // If the layout has the glyph on the right or the left, then both the text and the glyph are centered vertically.
- // If the glyph is on the top or the bottom, then both the text and the glyph are centered horizontally.
- if Layout in [blGlyphLeft, blGlyphRight] then
- begin
- GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
- TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
- end
- else
- begin
- GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
- TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
- end;
-
- // If there is no text or no bitmap, then Spacing is irrelevant.
- if (TextSize.X = 0) or (GlyphSize.X = 0) then
- Spacing := 0;
-
- // Adjust Margin and Spacing.
- if Margin = -1 then
- begin
- if Spacing = -1 then
- begin
- TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
- if Layout in [blGlyphLeft, blGlyphRight] then
- Margin := (ClientSize.X - TotalSize.X) div 3
- else
- Margin := (ClientSize.Y - TotalSize.Y) div 3;
- Spacing := Margin;
- end
- else
- begin
- TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + Spacing + TextSize.Y);
- if Layout in [blGlyphLeft, blGlyphRight] then
- Margin := (ClientSize.X - TotalSize.X + 1) div 2
- else
- Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
- end;
- end
- else
- begin
- if Spacing = -1 then
- begin
- TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y));
- if Layout in [blGlyphLeft, blGlyphRight] then
- Spacing := (TotalSize.X - TextSize.X) div 2
- else
- Spacing := (TotalSize.Y - TextSize.Y) div 2;
- end;
- end;
-
- case Layout of
- blGlyphLeft:
- begin
- GlyphPos.X := Margin;
- TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
- end;
- blGlyphRight:
- begin
- GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
- TextPos.X := GlyphPos.X - Spacing - TextSize.X;
- end;
- blGlyphTop:
- begin
- GlyphPos.Y := Margin;
- TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
- end;
- blGlyphBottom:
- begin
- GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
- TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
- end;
- end;
-
- // Fixup the Result variables.
- with GlyphPos do
- begin
- Inc(X, Client.Left + Offset.X);
- Inc(Y, Client.Top + Offset.Y);
- end;
-
- {$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)
- else
- {$ENDIF}
- OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.Y);
-end;
-
-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 COMPILER_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
-var
- GlyphPos: TPoint;
-begin
- TButtonGlyph_CalcButtonLayout(Control, Canvas.Handle, Client, Offset, Caption, Layout, Margin,
- Spacing, GlyphPos, Result, BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
- TButtonGlyph_DrawButtonGlyph(Control, Canvas, GlyphPos, State, Transparent);
- TButtonGlyph_DrawButtonText(Canvas, Caption, Result, State,
- BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
-end;
-
-{ TTntSpeedButton }
-
-procedure TTntSpeedButton.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSpeedButton.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self)
-end;
-
-function TTntSpeedButton.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntSpeedButton.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntSpeedButton.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntSpeedButton.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntSpeedButton.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntSpeedButton.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntSpeedButton.CMDialogChar(var Message: TCMDialogChar);
-begin
- with Message do
- if IsWideCharAccel(CharCode, Caption) and Enabled and Visible and
- (Parent <> nil) and Parent.Showing then
- begin
- Click;
- Result := 1;
- end else
- inherited;
-end;
-
-function TTntSpeedButton.GetButtonGlyph: Pointer;
-begin
- Result := THackSpeedButton(Self).FGlyph;
-end;
-
-procedure TTntSpeedButton.UpdateInternalGlyphList;
-begin
- FPaintInherited := True;
- try
- Repaint;
- finally
- FPaintInherited := False;
- end;
- Invalidate;
- 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);
-var
- PaintRect: TRect;
- DrawFlags: Integer;
- Offset: TPoint;
- {$IFDEF THEME_7_UP}
- Button: TThemedButton;
- ToolButton: TThemedToolBar;
- Details: TThemedElementDetails;
- {$ENDIF}
-begin
- try
- if not Enabled then
- begin
- FState := bsDisabled;
- THackSpeedButton(Self).FDragging := False;
- end
- else if FState = bsDisabled then
- if Down and (GroupIndex <> 0) then
- FState := bsExclusive
- else
- FState := bsUp;
- Canvas.Font := Self.Font;
-
- {$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
- Button := tbPushButtonDisabled
- else
- if FState in [bsDown, bsExclusive] then
- Button := tbPushButtonPressed
- else
- if MouseInControl then
- Button := tbPushButtonHot
- else
- Button := tbPushButtonNormal;
-
- ToolButton := ttbToolbarDontCare;
- if Flat then
- begin
- case Button of
- tbPushButtonDisabled:
- Toolbutton := ttbButtonDisabled;
- tbPushButtonPressed:
- Toolbutton := ttbButtonPressed;
- tbPushButtonHot:
- Toolbutton := ttbButtonHot;
- tbPushButtonNormal:
- Toolbutton := ttbButtonNormal;
- end;
- end;
-
- PaintRect := ClientRect;
- if ToolButton = ttbToolbarDontCare then
- begin
- Details := ThemeServices.GetElementDetails(Button);
- ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
- PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
- end
- else
- begin
- Details := ThemeServices.GetElementDetails(ToolButton);
- ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
- PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
- end;
-
- if Button = tbPushButtonPressed then
- begin
- // A pressed speed button has a white text. This applies however only to flat buttons.
- if ToolButton <> ttbToolbarDontCare then
- Canvas.Font.Color := clHighlightText;
- Offset := Point(1, 0);
- end
- else
- Offset := Point(0, 0);
- TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption, Layout, Margin, Spacing, FState,
- Transparent, DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});
- end
- else
- {$ENDIF}
- begin
- PaintRect := Rect(0, 0, Width, Height);
- if not Flat then
- begin
- DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
- if FState in [bsDown, bsExclusive] then
- DrawFlags := DrawFlags or DFCS_PUSHED;
- DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
- end
- else
- begin
- if (FState in [bsDown, bsExclusive]) or
- (MouseInControl and (FState <> bsDisabled)) or
- (csDesigning in ComponentState) then
- DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
- FillStyles[Transparent] or BF_RECT)
- else if not Transparent then
- begin
- Canvas.Brush.Color := Color;
- Canvas.FillRect(PaintRect);
- end;
- InflateRect(PaintRect, -1, -1);
- end;
- if FState in [bsDown, bsExclusive] then
- begin
- if (FState = bsExclusive) and (not Flat or not MouseInControl) then
- begin
- Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
- Canvas.FillRect(PaintRect);
- end;
- Offset.X := 1;
- Offset.Y := 1;
- end
- else
- begin
- Offset.X := 0;
- Offset.Y := 0;
- end;
- TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption,
- Layout, Margin, Spacing, FState, Transparent,
- DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});
- end;
- except
- on E: EAbortPaint do
- ;
- else
- raise;
- end;
-end;
-
-function TTntSpeedButton.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{$IFDEF COMPILER_10_UP}
-type
- TAccessGraphicControl = class(TGraphicControl);
-{$ENDIF}
-
-procedure TTntSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-{$IFDEF COMPILER_10_UP}
-// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
-type
- CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
-var
- M: TMethod;
-{$ENDIF}
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- {$IFNDEF COMPILER_10_UP}
- inherited;
- {$ELSE}
- // call TGraphicControl.ActionChange (bypass TSpeedButton.ActionChange)
- M.Code := @TAccessGraphicControl.ActionChange;
- M.Data := Self;
- CallActionChange(M)(Sender, CheckDefaults);
- // call Delphi2005's TSpeedButton.ActionChange
- if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
- with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
- begin
- if CheckDefaults or (Self.GroupIndex = 0) then
- Self.GroupIndex := GroupIndex;
- { Copy image from action's imagelist }
- if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
- (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
- CopyImage(ActionList.Images, ImageIndex);
- end;
- {$ENDIF}
-end;
-
-{ TTntBitBtn }
-
-procedure TTntBitBtn.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'BUTTON');
-end;
-
-procedure TTntBitBtn.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntBitBtn.IsCaptionStored: Boolean;
-var
- BaseClass: TClass;
- PropInfo: PPropInfo;
-begin
- Assert(Self is TButton{TNT-ALLOW TButton});
- Assert(Self is TBitBtn{TNT-ALLOW TBitBtn});
- if Kind = bkCustom then
- // don't use TBitBtn, it's broken for Kind <> bkCustom
- BaseClass := TButton{TNT-ALLOW TButton}
- else begin
- //TBitBtn has it's own storage specifier, based upon the button kind
- BaseClass := TBitBtn{TNT-ALLOW TBitBtn};
- end;
- PropInfo := GetPropInfo(BaseClass, 'Caption');
- if PropInfo = nil then
- raise EPropertyError.CreateResFmt(PResStringRec(@SUnknownProperty), ['Caption']);
- Result := IsStoredProp(Self, PropInfo);
-end;
-
-function TTntBitBtn.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntBitBtn.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntBitBtn.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntBitBtn.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntBitBtn.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntBitBtn.CMDialogChar(var Message: TCMDialogChar);
-begin
- TntButton_CMDialogChar(Self, Message);
-end;
-
-function TTntBitBtn.GetButtonGlyph: Pointer;
-begin
- Result := THackBitBtn(Self).FGlyph;
-end;
-
-procedure TTntBitBtn.UpdateInternalGlyphList;
-begin
- FPaintInherited := True;
- try
- Repaint;
- finally
- FPaintInherited := False;
- end;
- Invalidate;
- raise EAbortPaint.Create('');
-end;
-
-procedure TTntBitBtn.CNDrawItem(var Message: TWMDrawItem);
-begin
- if FPaintInherited then
- inherited
- else
- DrawItem(Message.DrawItemStruct^);
-end;
-
-procedure TTntBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
-var
- IsDown, IsDefault: Boolean;
- State: TButtonState;
- R: TRect;
- Flags: Longint;
- FCanvas: TCanvas;
- IsFocused: Boolean;
- {$IFDEF THEME_7_UP}
- Details: TThemedElementDetails;
- Button: TThemedButton;
- Offset: TPoint;
- {$ENDIF}
-begin
- try
- 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;
-
- 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 IsDown then
- Button := tbPushButtonPressed
- else
- if FMouseInControl then
- Button := tbPushButtonHot
- else
- 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);
-
- 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 COMPILER_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
- {$ENDIF}
- begin
- 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;
-
- { 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 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;
-
- 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) {$IFDEF COMPILER_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);
- end;
- end;
- FCanvas.Handle := 0;
- except
- on E: EAbortPaint do
- ;
- else
- raise;
- end;
-end;
-
-procedure TTntBitBtn.CMMouseEnter(var Message: TMessage);
-begin
- FMouseInControl := True;
- inherited;
-end;
-
-procedure TTntBitBtn.CMMouseLeave(var Message: TMessage);
-begin
- FMouseInControl := False;
- inherited;
-end;
-
-{$IFDEF COMPILER_10_UP}
-type
- TAccessButton = class(TButton{TNT-ALLOW TButton});
-{$ENDIF}
-
-procedure TTntBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-{$IFDEF COMPILER_10_UP}
-// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
-type
- CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
-var
- M: TMethod;
-{$ENDIF}
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- {$IFNDEF COMPILER_10_UP}
- inherited;
- {$ELSE}
- // call TButton.ActionChange (bypass TBitBtn.ActionChange)
- M.Code := @TAccessButton.ActionChange;
- M.Data := Self;
- CallActionChange(M)(Sender, CheckDefaults);
- // call Delphi2005's TBitBtn.ActionChange
- if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
- with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
- begin
- { Copy image from action's imagelist }
- if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
- (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
- CopyImage(ActionList.Images, ImageIndex);
- end;
- {$ENDIF}
-end;
-
-function TTntBitBtn.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntCheckLst.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntCheckLst.pas deleted file mode 100644 index 9d1ae95aa3..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntCheckLst.pas +++ /dev/null @@ -1,184 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntCheckLst;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, Messages, Windows, Controls, StdCtrls, CheckLst,
- TntClasses, TntControls, TntStdCtrls;
-
-type
-{TNT-WARN TCheckListBox}
- TTntCheckListBox = class(TCheckListBox{TNT-ALLOW TCheckListBox}, IWideCustomListControl)
- private
- FItems: TTntStrings;
- FSaveItems: TTntStrings;
- FSaveTopIndex: Integer;
- FSaveItemIndex: Integer;
- FSaved_ItemEnabled: array of Boolean;
- FSaved_State: array of TCheckBoxState;
- FSaved_Header: array of Boolean;
- FOnData: TLBGetWideDataEvent;
- procedure SetItems(const Value: TTntStrings);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
- procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure CreateWnd; override;
- procedure DestroyWnd; override;
- procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure CopySelection(Destination: TCustomListControl); override;
- procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- property Items: TTntStrings read FItems write SetItems;
- property OnData: TLBGetWideDataEvent read FOnData write FOnData;
- end;
-
-implementation
-
-uses
- SysUtils, Math, TntActnList;
-
-{ TTntCheckListBox }
-
-constructor TTntCheckListBox.Create(AOwner: TComponent);
-begin
- inherited;
- FItems := TTntListBoxStrings.Create;
- TTntListBoxStrings(FItems).ListBox := Self;
-end;
-
-destructor TTntCheckListBox.Destroy;
-begin
- FreeAndNil(FItems);
- inherited;
-end;
-
-procedure TTntCheckListBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'LISTBOX');
-end;
-
-procedure TTntCheckListBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- 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];
- Header[i] := FSaved_Header[i];
- 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];
- FSaved_Header[i] := Header[i];
- end;
- TntListBox_BeforeInherited_DestroyWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
- inherited;
-end;
-
-procedure TTntCheckListBox.SetItems(const Value: TTntStrings);
-begin
- FItems.Assign(Value);
-end;
-
-procedure TTntCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
-begin
- inherited;
- if not Assigned(OnDrawItem) then
- TntListBox_DrawItem_Text(Self, Items, Index, Rect);
-end;
-
-function TTntCheckListBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCheckListBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCheckListBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCheckListBox.AddItem(const Item: WideString; AObject: TObject);
-begin
- TntListBox_AddItem(Items, Item, AObject);
-end;
-
-procedure TTntCheckListBox.CopySelection(Destination: TCustomListControl);
-begin
- TntListBox_CopySelection(Self, Items, Destination);
-end;
-
-procedure TTntCheckListBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCheckListBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-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;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntClasses.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntClasses.pas deleted file mode 100644 index e99c0fa3a5..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntClasses.pas +++ /dev/null @@ -1,1780 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntClasses;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: Consider: TTntRegIniFile, TTntMemIniFile (consider if UTF8 fits into this solution). }
-
-{***********************************************}
-{ WideChar-streaming implemented by Maël Hörz }
-{***********************************************}
-
-uses
- Classes, SysUtils, Windows,
- {$IFNDEF COMPILER_10_UP}
- TntWideStrings,
- {$ELSE}
- WideStrings,
- {$ENDIF}
- ActiveX, Contnrs;
-
-// ......... introduced .........
-type
- TTntStreamCharSet = (csAnsi, csUnicode, csUnicodeSwapped, csUtf8);
-
-function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Classes
-//---------------------------------------------------------------------------------------------
-
-{TNT-WARN ExtractStrings}
-{TNT-WARN LineStart}
-{TNT-WARN TStringStream} // TODO: Implement a TWideStringStream
-
-// A potential implementation of TWideStringStream can be found at:
-// http://kdsxml.cvs.sourceforge.net/kdsxml/Global/KDSClasses.pas?revision=1.10&view=markup
-
-procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
-
-type
-{TNT-WARN TFileStream}
- TTntFileStream = class(THandleStream)
- public
- constructor Create(const FileName: WideString; Mode: Word);
- 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
- HResInfo: HRSRC;
- HGlobal: THandle;
- procedure Initialize(Instance: THandle; Name, ResType: PWideChar);
- public
- constructor Create(Instance: THandle; const ResName: WideString; ResType: PWideChar);
- 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;
-
-{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(AWideStrings: 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;
-
-{TNT-WARN TStrings}
- TTntStrings = class(TWideStrings)
- private
- FLastFileCharSet: TTntStreamCharSet;
- FAnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings};
- procedure SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
- procedure ReadData(Reader: TReader);
- procedure ReadDataUTF7(Reader: TReader);
- procedure ReadDataUTF8(Reader: TReader);
- procedure WriteDataUTF7(Writer: TWriter);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- constructor Create;
- destructor Destroy; override;
-
- procedure LoadFromFile(const FileName: WideString); override;
- procedure LoadFromStream(Stream: TStream); override;
- procedure LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;
-
- procedure SaveToFile(const FileName: WideString); override;
- procedure SaveToStream(Stream: TStream); override;
- procedure SaveToStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;
-
- property LastFileCharSet: TTntStreamCharSet read FLastFileCharSet;
- published
- property AnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings} read FAnsiStrings write SetAnsiStrings stored False;
- end;
-
-{ TTntStringList class }
-
- TTntStringList = class;
- TWideStringListSortCompare = function(List: TTntStringList; Index1, Index2: Integer): Integer;
-
-{TNT-WARN TStringList}
- TTntStringList = class(TTntStrings)
- private
- FUpdating: Boolean;
- 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;
- function Get(Index: Integer): WideString; override;
- function GetCapacity: Integer; override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure Put(Index: Integer; const S: WideString); override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetCapacity(NewCapacity: Integer); override;
- procedure SetUpdateState(Updating: Boolean); override;
- function CompareStrings(const S1, S2: WideString): Integer; override;
- procedure InsertItem(Index: Integer; const S: WideString; AObject: TObject); virtual;
- public
- 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;
- 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;
-
-// "synced" wide string
-type TSetAnsiStrEvent = procedure(const Value: AnsiString) of object;
-function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;
-procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;
- const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);
-
-type
- TWideComponentHelper = class(TComponent)
- private
- FComponent: TComponent;
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- constructor Create(AOwner: TComponent); override;
- constructor CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);
- end;
-
-function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;
-
-implementation
-
-uses
- RTLConsts, ComObj, Math,
- Registry, TypInfo, TntSystem, TntSysUtils;
-
-{ TntPersistent }
-
-//===========================================================================
-// The Delphi 5 Classes.pas never supported the streaming of WideStrings.
-// The Delphi 6 Classes.pas supports WideString streaming. But it's too bad that
-// 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.
-//
-
-{ 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 ReaderNeedsUtfHelp(Reader: TReader): Boolean;
-begin
- if Reader.Owner = nil then
- Result := False { designtime - visual form inheritance ancestor }
- else if csDesigning in Reader.Owner.ComponentState then
- {$IFDEF COMPILER_7_UP}
- Result := False { Delphi 7+: designtime - doesn't need UTF help. }
- {$ELSE}
- Result := True { Delphi 6: designtime - always needs UTF help. }
- {$ENDIF}
- else
- Result := RuntimeUTFStreaming; { runtime }
-end;
-
-procedure TTntWideStringPropertyFiler.ReadDataUTF8(Reader: TReader);
-begin
- if ReaderNeedsUtfHelp(Reader) then
- SetWideStrProp(FInstance, FPropInfo, UTF8ToWideString(Reader.ReadString))
- else
- Reader.ReadString; { do nothing with Result }
-end;
-
-procedure TTntWideStringPropertyFiler.ReadDataUTF7(Reader: TReader);
-begin
- if ReaderNeedsUtfHelp(Reader) then
- SetWideStrProp(FInstance, FPropInfo, UTF7ToWideString(Reader.ReadString))
- else
- Reader.ReadString; { do nothing with Result }
-end;
-
-procedure TTntWideStringPropertyFiler.WriteDataUTF7(Writer: TWriter);
-begin
- Writer.WriteString(WideStringToUTF7(GetWideStrProp(FInstance, FPropInfo)));
-end;
-
-procedure TTntWideStringPropertyFiler.DefineProperties(Filer: TFiler; Instance: TPersistent;
- PropName: AnsiString);
-
- {$IFNDEF COMPILER_7_UP}
- 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;
- {$ENDIF}
-
-begin
- 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);
- {$IFDEF COMPILER_7_UP}
- Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, False);
- {$ELSE}
- Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, HasData);
- {$ENDIF}
- end;
- FInstance := nil;
- FPropInfo := nil;
-end;
-
-{ TTntWideCharPropertyFiler }
-type
- TTntWideCharPropertyFiler = class
- private
- FInstance: TPersistent;
- FPropInfo: PPropInfo;
- {$IFNDEF COMPILER_9_UP}
- FWriter: TWriter;
- procedure GetLookupInfo(var Ancestor: TPersistent;
- var Root, LookupRoot, RootAncestor: TComponent);
- {$ENDIF}
- procedure ReadData_W(Reader: TReader);
- procedure ReadDataUTF7(Reader: TReader);
- procedure WriteData_W(Writer: TWriter);
- function ReadChar(Reader: TReader): WideChar;
- public
- procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
- end;
-
-{$IFNDEF COMPILER_9_UP}
-type
- TGetLookupInfoEvent = procedure(var Ancestor: TPersistent;
- var Root, LookupRoot, RootAncestor: TComponent) of object;
-
-function AncestorIsValid(Ancestor: TPersistent; Root, RootAncestor: TComponent): Boolean;
-begin
- Result := (Ancestor <> nil) and (RootAncestor <> nil) and
- Root.InheritsFrom(RootAncestor.ClassType);
-end;
-
-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
- 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;
-
-procedure TTntWideCharPropertyFiler.GetLookupInfo(var Ancestor: TPersistent;
- var Root, LookupRoot, RootAncestor: TComponent);
-begin
- Ancestor := FWriter.Ancestor;
- Root := FWriter.Root;
- LookupRoot := FWriter.LookupRoot;
- RootAncestor := FWriter.RootAncestor;
-end;
-{$ENDIF}
-
-function TTntWideCharPropertyFiler.ReadChar(Reader: TReader): WideChar;
-var
- Temp: WideString;
-begin
- case Reader.NextValue of
- vaWString:
- Temp := Reader.ReadWideString;
- vaString:
- Temp := Reader.ReadString;
- else
- raise EReadError.Create(SInvalidPropertyValue);
- end;
-
- if Length(Temp) > 1 then
- raise EReadError.Create(SInvalidPropertyValue);
- Result := Temp[1];
-end;
-
-procedure TTntWideCharPropertyFiler.ReadData_W(Reader: TReader);
-begin
- SetOrdProp(FInstance, FPropInfo, Ord(ReadChar(Reader)));
-end;
-
-procedure TTntWideCharPropertyFiler.ReadDataUTF7(Reader: TReader);
-var
- S: WideString;
-begin
- S := UTF7ToWideString(Reader.ReadString);
- if S = '' then
- SetOrdProp(FInstance, FPropInfo, 0)
- else
- SetOrdProp(FInstance, FPropInfo, Ord(S[1]))
-end;
-
-type TAccessWriter = class(TWriter);
-
-procedure TTntWideCharPropertyFiler.WriteData_W(Writer: TWriter);
-var
- L: Integer;
- Temp: WideString;
-begin
- Temp := WideChar(GetOrdProp(FInstance, FPropInfo));
-
- TAccessWriter(Writer).WriteValue(vaWString);
- L := Length(Temp);
- Writer.Write(L, SizeOf(Integer));
- Writer.Write(Pointer(@Temp[1])^, L * 2);
-end;
-
-procedure TTntWideCharPropertyFiler.DefineProperties(Filer: TFiler;
- Instance: TPersistent; PropName: AnsiString);
-
- {$IFNDEF COMPILER_9_UP}
- function HasData: Boolean;
- var
- CurrPropValue: Integer;
- begin
- // must be stored
- Result := IsStoredProp(Instance, FPropInfo);
- if Result and (Filer.Ancestor <> nil) and
- (GetPropInfo(Filer.Ancestor, PropName, [tkWChar]) <> nil) then
- begin
- // 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
- FWriter := TWriter(Filer);
- Result := not IsDefaultOrdPropertyValue(Instance, FPropInfo, GetLookupInfo);
- end;
- end;
- {$ENDIF}
-
-begin
- FInstance := Instance;
- FPropInfo := GetPropInfo(Instance, PropName, [tkWChar]);
- if FPropInfo <> nil then
- begin
- // must be published (and of type WideChar)
- {$IFDEF COMPILER_9_UP}
- Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, False);
- {$ELSE}
- Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, HasData);
- {$ENDIF}
- Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, nil, False);
- end;
- FInstance := nil;
- FPropInfo := nil;
-end;
-
-procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
-var
- I, Count: Integer;
- PropInfo: PPropInfo;
- PropList: PPropList;
- WideStringFiler: TTntWideStringPropertyFiler;
- WideCharFiler: TTntWideCharPropertyFiler;
-begin
- Count := GetTypeData(Instance.ClassInfo)^.PropCount;
- if Count > 0 then
- begin
- 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;
-
-{ TTntFileStream }
-
-constructor TTntFileStream.Create(const FileName: WideString; Mode: Word);
-var
- CreateHandle: Integer;
- {$IFDEF DELPHI_7_UP}
- ErrorMessage: WideString;
- {$ENDIF}
-begin
- if Mode = fmCreate then
- begin
- CreateHandle := WideFileCreate(FileName);
- if CreateHandle < 0 then begin
- {$IFDEF DELPHI_7_UP}
- ErrorMessage := WideSysErrorMessage(GetLastError);
- raise EFCreateError.CreateFmt(SFCreateErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
- {$ELSE}
- raise EFCreateError.CreateFmt(SFCreateError, [WideExpandFileName(FileName)]);
- {$ENDIF}
- end;
- end else
- begin
- CreateHandle := WideFileOpen(FileName, Mode);
- if CreateHandle < 0 then begin
- {$IFDEF DELPHI_7_UP}
- ErrorMessage := WideSysErrorMessage(GetLastError);
- raise EFOpenError.CreateFmt(SFOpenErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
- {$ELSE}
- raise EFOpenError.CreateFmt(SFOpenError, [WideExpandFileName(FileName)]);
- {$ENDIF}
- end;
- end;
- inherited Create(CreateHandle);
-end;
-
-destructor TTntFileStream.Destroy;
-begin
- if Handle >= 0 then FileClose(Handle);
-end;
-
-{ TTntMemoryStream }
-
-procedure TTntMemoryStream.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TTntMemoryStream.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-{ TTntResourceStream }
-
-constructor TTntResourceStream.Create(Instance: THandle; const ResName: WideString;
- ResType: PWideChar);
-begin
- inherited Create;
- Initialize(Instance, PWideChar(ResName), ResType);
-end;
-
-constructor TTntResourceStream.CreateFromID(Instance: THandle; ResID: Word;
- ResType: PWideChar);
-begin
- inherited Create;
- Initialize(Instance, PWideChar(ResID), ResType);
-end;
-
-procedure TTntResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);
-
- procedure Error;
- begin
- raise EResNotFound.CreateFmt(SResNotFound, [Name]);
- end;
-
-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));
-end;
-
-destructor TTntResourceStream.Destroy;
-begin
- UnlockResource(HGlobal);
- FreeResource(HGlobal); { Technically this is not necessary (MS KB #193678) }
- inherited Destroy;
-end;
-
-function TTntResourceStream.Write(const Buffer; Count: Longint): Longint;
-begin
- raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));
-end;
-
-procedure TTntResourceStream.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-{ TAnsiStrings }
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStreamEx(Stream, CodePage);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
-var
- Stream: TStream;
-begin
- 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;
-
-{ TAnsiStringsForWideStringsAdapter }
-
-constructor TAnsiStringsForWideStringsAdapter.Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal);
-begin
- inherited Create;
- FWideStrings := AWideStrings;
- FAdapterCodePage := _AdapterCodePage;
-end;
-
-function TAnsiStringsForWideStringsAdapter.AdapterCodePage: Cardinal;
-begin
- if FAdapterCodePage = 0 then
- Result := TntSystem.DefaultSystemCodePage
- else
- Result := FAdapterCodePage;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Clear;
-begin
- FWideStrings.Clear;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Delete(Index: Integer);
-begin
- FWideStrings.Delete(Index);
-end;
-
-function TAnsiStringsForWideStringsAdapter.Get(Index: Integer): AnsiString;
-begin
- Result := WideStringToStringEx(FWideStrings.Get(Index), AdapterCodePage);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Put(Index: Integer; const S: AnsiString);
-begin
- FWideStrings.Put(Index, StringToWideStringEx(S, AdapterCodePage));
-end;
-
-function TAnsiStringsForWideStringsAdapter.GetCount: Integer;
-begin
- Result := FWideStrings.GetCount;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Insert(Index: Integer; const S: AnsiString);
-begin
- FWideStrings.Insert(Index, StringToWideStringEx(S, AdapterCodePage));
-end;
-
-function TAnsiStringsForWideStringsAdapter.GetObject(Index: Integer): TObject;
-begin
- Result := FWideStrings.GetObject(Index);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.PutObject(Index: Integer; AObject: TObject);
-begin
- FWideStrings.PutObject(Index, AObject);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.SetUpdateState(Updating: Boolean);
-begin
- FWideStrings.SetUpdateState(Updating);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.LoadFromStreamEx(Stream: TStream; CodePage: Cardinal);
-var
- Size: Integer;
- S: AnsiString;
-begin
- 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;
-
-procedure TAnsiStringsForWideStringsAdapter.SaveToStreamEx(Stream: TStream; CodePage: Cardinal);
-var
- S: AnsiString;
-begin
- S := WideStringToStringEx(FWideStrings.GetTextStr, CodePage);
- Stream.WriteBuffer(Pointer(S)^, Length(S));
-end;
-
-{ TTntStrings }
-
-constructor TTntStrings.Create;
-begin
- inherited;
- FAnsiStrings := TAnsiStringsForWideStringsAdapter.Create(Self);
- FLastFileCharSet := csUnicode;
-end;
-
-destructor TTntStrings.Destroy;
-begin
- FreeAndNil(FAnsiStrings);
- inherited;
-end;
-
-procedure TTntStrings.SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
-begin
- FAnsiStrings.Assign(Value);
-end;
-
-procedure TTntStrings.DefineProperties(Filer: TFiler);
-
- {$IFNDEF COMPILER_7_UP}
- function DoWrite: Boolean;
- begin
- if Filer.Ancestor <> nil then
- 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
- Result := True;
- break; { found a string with non-ASCII chars (> 127) }
- end;
- end;
- end;
- {$ENDIF}
-
-begin
- inherited DefineProperties(Filer); { Handles main 'Strings' property.' }
- Filer.DefineProperty('WideStrings', ReadData, nil, False);
- Filer.DefineProperty('WideStringsW', ReadDataUTF8, nil, False);
- {$IFDEF COMPILER_7_UP}
- Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, False);
- {$ELSE}
- Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, DoWrite and DoWriteAsUTF7);
- {$ENDIF}
-end;
-
-procedure TTntStrings.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- FLastFileCharSet := AutoDetectCharacterSet(Stream);
- Stream.Position := 0;
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TTntStrings.LoadFromStream(Stream: TStream);
-begin
- LoadFromStream_BOM(Stream, True);
-end;
-
-procedure TTntStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);
-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
- // 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.ReadData(Reader: TReader);
-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;
- end;
-end;
-
-procedure TTntStrings.ReadDataUTF7(Reader: TReader);
-begin
- Reader.ReadListBegin;
- if ReaderNeedsUtfHelp(Reader) 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;
-end;
-
-procedure TTntStrings.ReadDataUTF8(Reader: TReader);
-begin
- 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;
-
-procedure TTntStrings.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TTntStrings.SaveToStream(Stream: TStream);
-begin
- SaveToStream_BOM(Stream, True);
-end;
-
-procedure TTntStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);
-// 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
- if WithBOM then begin
- BOM := UNICODE_BOM;
- Stream.WriteBuffer(BOM, SizeOf(WideChar));
- end;
- SW := GetTextStr;
- Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
-end;
-
-procedure TTntStrings.WriteDataUTF7(Writer: TWriter);
-var
- I: Integer;
-begin
- Writer.WriteListBegin;
- for I := 0 to Count-1 do
- Writer.WriteString(WideStringToUTF7(Get(I)));
- Writer.WriteListEnd;
-end;
-
-{ TTntStringList }
-
-destructor TTntStringList.Destroy;
-begin
- FOnChange := nil;
- FOnChanging := nil;
- inherited Destroy;
- if FCount <> 0 then Finalize(FList^[0], FCount);
- FCount := 0;
- SetCapacity(0);
-end;
-
-function TTntStringList.Add(const S: WideString): Integer;
-begin
- Result := AddObject(S, nil);
-end;
-
-function TTntStringList.AddObject(const S: WideString; AObject: TObject): Integer;
-begin
- 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 TTntStringList.Changed;
-begin
- if (not FUpdating) and Assigned(FOnChange) then
- FOnChange(Self);
-end;
-
-procedure TTntStringList.Changing;
-begin
- if (not FUpdating) and Assigned(FOnChanging) then
- FOnChanging(Self);
-end;
-
-procedure TTntStringList.Clear;
-begin
- if FCount <> 0 then
- begin
- Changing;
- Finalize(FList^[0], FCount);
- FCount := 0;
- SetCapacity(0);
- Changed;
- end;
-end;
-
-procedure TTntStringList.Delete(Index: Integer);
-begin
- 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;
-
-procedure TTntStringList.Exchange(Index1, Index2: Integer);
-begin
- 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 TTntStringList.ExchangeItems(Index1, Index2: Integer);
-var
- Temp: Integer;
- Item1, Item2: PWideStringItem;
-begin
- 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;
-
-function TTntStringList.Find(const S: WideString; var Index: Integer): Boolean;
-var
- L, H, I, C: Integer;
-begin
- Result := False;
- L := 0;
- H := FCount - 1;
- while L <= H do
- begin
- I := (L + H) shr 1;
- C := CompareStrings(FList^[I].FString, S);
- if C < 0 then L := I + 1 else
- begin
- H := I - 1;
- if C = 0 then
- begin
- Result := True;
- if Duplicates <> dupAccept then L := I;
- end;
- end;
- end;
- Index := L;
-end;
-
-function TTntStringList.Get(Index: Integer): WideString;
-begin
- if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
- Result := FList^[Index].FString;
-end;
-
-function TTntStringList.GetCapacity: Integer;
-begin
- Result := FCapacity;
-end;
-
-function TTntStringList.GetCount: Integer;
-begin
- Result := FCount;
-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 TTntStringList.Grow;
-var
- Delta: Integer;
-begin
- if FCapacity > 64 then Delta := FCapacity div 4 else
- if FCapacity > 8 then Delta := 16 else
- Delta := 4;
- SetCapacity(FCapacity + Delta);
-end;
-
-function TTntStringList.IndexOf(const S: WideString): Integer;
-begin
- if not Sorted then Result := inherited IndexOf(S) else
- if not Find(S, Result) then Result := -1;
-end;
-
-function TTntStringList.IndexOfName(const Name: WideString): Integer;
-var
- NameKey: WideString;
-begin
- 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 TTntStringList.Insert(Index: Integer; const S: WideString);
-begin
- InsertObject(Index, S, nil);
-end;
-
-procedure TTntStringList.InsertObject(Index: Integer; const S: WideString;
- AObject: TObject);
-begin
- if Sorted then Error(PResStringRec(@SSortedListError), 0);
- if (Index < 0) or (Index > FCount) then Error(PResStringRec(@SListIndexError), Index);
- InsertItem(Index, S, AObject);
-end;
-
-procedure TTntStringList.InsertItem(Index: Integer; const S: WideString; AObject: TObject);
-begin
- 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 TTntStringList.Put(Index: Integer; const S: WideString);
-begin
- 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 TTntStringList.PutObject(Index: Integer; AObject: TObject);
-begin
- if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
- Changing;
- FList^[Index].FObject := AObject;
- Changed;
-end;
-
-procedure TTntStringList.QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);
-var
- I, J, P: Integer;
-begin
- 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;
-
-procedure TTntStringList.SetCapacity(NewCapacity: Integer);
-begin
- ReallocMem(FList, NewCapacity * SizeOf(TWideStringItem));
- FCapacity := NewCapacity;
-end;
-
-procedure TTntStringList.SetSorted(Value: Boolean);
-begin
- if FSorted <> Value then
- begin
- if Value then Sort;
- FSorted := Value;
- end;
-end;
-
-procedure TTntStringList.SetUpdateState(Updating: Boolean);
-begin
- FUpdating := Updating;
- if Updating then Changing else Changed;
-end;
-
-function WideStringListCompareStrings(List: TTntStringList; Index1, Index2: Integer): Integer;
-begin
- Result := List.CompareStrings(List.FList^[Index1].FString,
- List.FList^[Index2].FString);
-end;
-
-procedure TTntStringList.Sort;
-begin
- CustomSort(WideStringListCompareStrings);
-end;
-
-procedure TTntStringList.CustomSort(Compare: TWideStringListSortCompare);
-begin
- if not Sorted and (FCount > 1) then
- begin
- Changing;
- QuickSort(0, FCount - 1, Compare);
- Changed;
- end;
-end;
-
-function TTntStringList.CompareStrings(const S1, S2: WideString): Integer;
-begin
- if CaseSensitive then
- Result := WideCompareStr(S1, S2)
- else
- Result := WideCompareText(S1, S2);
-end;
-
-procedure TTntStringList.SetCaseSensitive(const Value: Boolean);
-begin
- if Value <> FCaseSensitive then
- begin
- FCaseSensitive := Value;
- if Sorted then Sort;
- end;
-end;
-
-//------------------------- TntClasses introduced procs ----------------------------------
-
-function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
-var
- ByteOrderMark: WideChar;
- BytesRead: Integer;
- Utf8Test: array[0..2] of AnsiChar;
-begin
- // 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 FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;
- Target: Pointer; var Index: Integer): Boolean;
-var
- L, H, I, C: Integer;
-begin
- 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;
-
-function ClassIsRegistered(const clsid: TCLSID): Boolean;
-var
- OleStr: POleStr;
- Reg: TRegIniFile;
- Key, Filename: 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.
-
- // 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;
-
-{ TBufferedAnsiString }
-
-procedure TBufferedAnsiString.Clear;
-begin
- LastWriteIndex := 0;
- if Length(FStringBuffer) > 0 then
- FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(AnsiChar), 0);
-end;
-
-procedure TBufferedAnsiString.AddChar(const wc: AnsiChar);
-const
- MIN_GROW_SIZE = 32;
- MAX_GROW_SIZE = 256;
-var
- GrowSize: Integer;
-begin
- 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;
-
-procedure TBufferedAnsiString.AddString(const s: AnsiString);
-var
- LenS: Integer;
- BlockSize: Integer;
- AllocSize: Integer;
-begin
- 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;
-
-procedure TBufferedAnsiString.AddBuffer(Buff: PAnsiChar; Chars: Integer);
-var
- i: integer;
-begin
- for i := 1 to Chars do begin
- if Buff^ = #0 then
- break;
- AddChar(Buff^);
- Inc(Buff);
- end;
-end;
-
-function TBufferedAnsiString.Value: AnsiString;
-begin
- Result := PAnsiChar(FStringBuffer);
-end;
-
-function TBufferedAnsiString.BuffPtr: PAnsiChar;
-begin
- Result := PAnsiChar(FStringBuffer);
-end;
-
-{ TBufferedWideString }
-
-procedure TBufferedWideString.Clear;
-begin
- LastWriteIndex := 0;
- if Length(FStringBuffer) > 0 then
- FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(WideChar), 0);
-end;
-
-procedure TBufferedWideString.AddChar(const wc: WideChar);
-const
- MIN_GROW_SIZE = 32;
- MAX_GROW_SIZE = 256;
-var
- GrowSize: Integer;
-begin
- 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 TBufferedWideString.AddString(const s: WideString);
-var
- i: integer;
-begin
- for i := 1 to Length(s) do
- AddChar(s[i]);
-end;
-
-procedure TBufferedWideString.AddBuffer(Buff: PWideChar; Chars: Integer);
-var
- i: integer;
-begin
- for i := 1 to Chars do begin
- if Buff^ = #0 then
- break;
- AddChar(Buff^);
- Inc(Buff);
- end;
-end;
-
-function TBufferedWideString.Value: WideString;
-begin
- Result := PWideChar(FStringBuffer);
-end;
-
-function TBufferedWideString.BuffPtr: PWideChar;
-begin
- Result := PWideChar(FStringBuffer);
-end;
-
-{ TBufferedStreamReader }
-
-constructor TBufferedStreamReader.Create(Stream: TStream; BufferSize: Integer = 1024);
-begin
- // 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;
-
-function TBufferedStreamReader.Seek(Offset: Integer; Origin: Word): Longint;
-begin
- case Origin of
- soFromBeginning: FVirtualPosition := Offset;
- soFromCurrent: Inc(FVirtualPosition, Offset);
- soFromEnd: FVirtualPosition := FStreamSize + Offset;
- end;
- Result := FVirtualPosition;
-end;
-
-procedure TBufferedStreamReader.UpdateBufferFromPosition(StartPos: Integer);
-begin
- try
- FStream.Position := StartPos;
- FStream.Read(FBuffer[0], FBufferSize);
- FBufferStartPosition := StartPos;
- except
- FBufferStartPosition := -FBufferSize; { out of any useful range }
- raise;
- end;
-end;
-
-function TBufferedStreamReader.Read(var Buffer; Count: Integer): Longint;
-var
- BytesLeft: Integer;
- FirstBufferRead: Integer;
- StreamDirectRead: Integer;
- Buf: PAnsiChar;
-begin
- 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 TBufferedStreamReader.Write(const Buffer; Count: Integer): Longint;
-begin
- raise ETntInternalError.Create('Internal Error: class can not write.');
- Result := 0;
-end;
-
-//-------- synced wide string -----------------
-
-function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;
-begin
- if AnsiString(WideStr) <> (AnsiStr) then begin
- WideStr := AnsiStr; {AnsiStr changed. Keep WideStr in sync.}
- end;
- Result := WideStr;
-end;
-
-procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;
- const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);
-begin
- if Value <> GetSyncedWideString(WideStr, AnsiStr) then
- begin
- if (not WideSameStr(Value, AnsiString(Value))) {unicode chars lost in conversion}
- and (AnsiStr = AnsiString(Value)) {AnsiStr is not going to change}
- then begin
- SetAnsiStr(''); {force the change}
- end;
- WideStr := Value;
- SetAnsiStr(Value);
- end;
-end;
-
-{ TWideComponentHelper }
-
-function CompareComponentHelperToTarget(Item, Target: Pointer): Integer;
-begin
- if Integer(TWideComponentHelper(Item).FComponent) < Integer(Target) then
- Result := -1
- else if Integer(TWideComponentHelper(Item).FComponent) > Integer(Target) then
- Result := 1
- else
- Result := 0;
-end;
-
-function FindWideComponentHelperIndex(ComponentHelperList: TComponentList; Component: TComponent; var Index: Integer): Boolean;
-begin
- // find Component in sorted wide caption list (list is sorted by TWideComponentHelper.FComponent)
- Result := FindSortedListByTarget(ComponentHelperList, CompareComponentHelperToTarget, Component, Index);
-end;
-
-constructor TWideComponentHelper.Create(AOwner: TComponent);
-begin
- raise ETntInternalError.Create('TNT Internal Error: TWideComponentHelper.Create should never be encountered.');
-end;
-
-constructor TWideComponentHelper.CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);
-var
- Index: Integer;
-begin
- // don't use direct ownership for memory management
- inherited Create(nil);
- FComponent := AOwner;
- FComponent.FreeNotification(Self);
-
- // insert into list according to sort
- FindWideComponentHelperIndex(ComponentHelperList, FComponent, Index);
- ComponentHelperList.Insert(Index, Self);
-end;
-
-procedure TWideComponentHelper.Notification(AComponent: TComponent; Operation: TOperation);
-begin
- inherited;
- if (AComponent = FComponent) and (Operation = opRemove) then begin
- FComponent := nil;
- Free;
- end;
-end;
-
-function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;
-var
- Index: integer;
-begin
- if FindWideComponentHelperIndex(ComponentHelperList, Component, Index) then begin
- Result := TWideComponentHelper(ComponentHelperList[Index]);
- Assert(Result.FComponent = Component, 'TNT Internal Error: FindWideComponentHelperIndex failed.');
- end else
- Result := nil;
-end;
-
-initialization
- RuntimeUTFStreaming := False; { Delphi 6 and higher don't need UTF help at runtime. }
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntClipBrd.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntClipBrd.pas deleted file mode 100644 index cf2c16e9f6..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntClipBrd.pas +++ /dev/null @@ -1,86 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntClipBrd;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Windows, Clipbrd;
-
-type
-{TNT-WARN TClipboard}
- TTntClipboard = class(TClipboard{TNT-ALLOW TClipboard})
- private
- function GetAsWideText: WideString;
- procedure SetAsWideText(const Value: WideString);
- public
- property AsWideText: WideString read GetAsWideText write SetAsWideText;
- property AsText: WideString read GetAsWideText write SetAsWideText;
- end;
-
-{TNT-WARN Clipboard}
-function TntClipboard: TTntClipboard;
-
-implementation
-
-{ TTntClipboard }
-
-function TTntClipboard.GetAsWideText: WideString;
-var
- Data: THandle;
-begin
- Open;
- Data := GetClipboardData(CF_UNICODETEXT);
- try
- if Data <> 0 then
- Result := PWideChar(GlobalLock(Data))
- else
- Result := '';
- finally
- if Data <> 0 then GlobalUnlock(Data);
- Close;
- end;
- if (Data = 0) or (Result = '') then
- Result := inherited AsText
-end;
-
-procedure TTntClipboard.SetAsWideText(const Value: WideString);
-begin
- Open;
- try
- inherited AsText := Value; {Ensures ANSI compatiblity across platforms.}
- SetBuffer(CF_UNICODETEXT, PWideChar(Value)^, (Length(Value) + 1) * SizeOf(WideChar));
- finally
- Close;
- end;
-end;
-
-//------------------------------------------
-
-var
- GTntClipboard: TTntClipboard;
-
-function TntClipboard: TTntClipboard;
-begin
- if GTntClipboard = nil then
- GTntClipboard := TTntClipboard.Create;
- Result := GTntClipboard;
-end;
-
-initialization
-
-finalization
- GTntClipboard.Free;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas deleted file mode 100644 index 42bec4cd46..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas +++ /dev/null @@ -1,5058 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntComCtrls;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: TTntCustomListView events - reintroduce ones that refer to ansi classes (ie. TListItem) }
-{ TODO: Handle RichEdit CRLF emulation at the WndProc level. }
-{ TODO: TTntCustomTreeView events - reintroduce ones that refer to ansi classes (ie. TTreeNode) }
-{ TODO: THotKey, Tanimate, TCoolBar (TCoolBand) }
-{ TODO: TToolBar: Unicode-enable TBN_GETBUTTONINFO/DoGetButton }
-{ TODO: TToolBar: Unicode-enable handling of CN_DIALOGCHAR, WM_SYSCOMMAND, FindButtonFromAccel }
-
-uses
- Classes, Controls, ListActns, Menus, ComCtrls, Messages,
- Windows, CommCtrl, Contnrs, TntControls, TntClasses, Graphics, TntSysUtils;
-
-type
- TTntCustomListView = class;
- TTntListItems = class;
-
-{TNT-WARN TListColumn}
- TTntListColumn = class(TListColumn{TNT-ALLOW TListColumn})
- private
- FCaption: WideString;
- procedure SetInheritedCaption(const Value: AnsiString);
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- end;
-
-{TNT-WARN TListColumns}
- TTntListColumns = class(TListColumns{TNT-ALLOW TListColumns})
- private
- function GetItem(Index: Integer): TTntListColumn;
- procedure SetItem(Index: Integer; Value: TTntListColumn);
- public
- constructor Create(AOwner: TTntCustomListView);
- function Add: TTntListColumn;
- function Owner: TTntCustomListView;
- property Items[Index: Integer]: TTntListColumn read GetItem write SetItem; default;
- end;
-
-{TNT-WARN TListItem}
- TTntListItem = class(TListItem{TNT-ALLOW TListItem})
- private
- FCaption: WideString;
- FSubItems: TTntStrings;
- procedure SetInheritedCaption(const Value: AnsiString);
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- procedure SetSubItems(const Value: TTntStrings);
- function GetListView: TTntCustomListView;
- function GetTntOwner: TTntListItems;
- public
- constructor Create(AOwner: TListItems{TNT-ALLOW TListItems}); virtual;
- destructor Destroy; override;
- property Owner: TTntListItems read GetTntOwner;
- property ListView: TTntCustomListView read GetListView;
- procedure Assign(Source: TPersistent); override;
- property Caption: WideString read GetCaption write SetCaption;
- property SubItems: TTntStrings read FSubItems write SetSubItems;
- end;
-
- TTntListItemsEnumerator = class
- private
- FIndex: Integer;
- FListItems: TTntListItems;
- public
- constructor Create(AListItems: TTntListItems);
- function GetCurrent: TTntListItem;
- function MoveNext: Boolean;
- property Current: TTntListItem read GetCurrent;
- end;
-
-{TNT-WARN TListItems}
- TTntListItems = class(TListItems{TNT-ALLOW TListItems})
- private
- function GetItem(Index: Integer): TTntListItem;
- procedure SetItem(Index: Integer; const Value: TTntListItem);
- public
- function Owner: TTntCustomListView;
- property Item[Index: Integer]: TTntListItem read GetItem write SetItem; default;
- function Add: TTntListItem;
- function AddItem(Item: TTntListItem; Index: Integer = -1): TTntListItem;
- function GetEnumerator: TTntListItemsEnumerator;
- function Insert(Index: Integer): TTntListItem;
- end;
-
- TTntLVEditedEvent = procedure(Sender: TObject; Item: TTntListItem; var S: WideString) of object;
- TTntLVOwnerDataFindEvent = procedure(Sender: TObject; Find: TItemFind;
- const FindString: WideString; const FindPosition: TPoint; FindData: Pointer;
- StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
- var Index: Integer) of object;
-
-{TNT-WARN TCustomListView}
- _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;
- FOnEdited: TTntLVEditedEvent;
- FOnDataFind: TTntLVOwnerDataFindEvent;
- procedure EditWndProcW(var Message: TMessage);
- procedure BeginChangingWideItem;
- procedure EndChangingWideItem;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- function GetListColumns: TTntListColumns;
- 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;
- FChangingWideItemCount: Integer;
- FTempItem: TTntListItem;
- function AreItemsStored: Boolean;
- function GetItems: TTntListItems;
- procedure SetItems(Value: TTntListItems);
- procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
- function GetItemW(Value: TLVItemW): TTntListItem;
- procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure CreateWnd; override;
- procedure DestroyWnd; override;
- procedure WndProc(var Message: TMessage); override;
- function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; reintroduce; virtual;
- function CreateListItem: TListItem{TNT-ALLOW TListItem}; override;
- function CreateListItems: TListItems{TNT-ALLOW TListItems}; override;
- property Items: TTntListItems read GetItems write SetItems stored AreItemsStored;
- procedure Edit(const Item: TLVItem); override;
- function OwnerDataFind(Find: TItemFind; const FindString: WideString;
- const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
- 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;
- property OnDataFind: TTntLVOwnerDataFindEvent read FOnDataFind write FOnDataFind;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property Column[Index: Integer]: TTntListColumn read ColumnFromIndex;
- procedure CopySelection(Destination: TCustomListControl); override;
- 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;
-
-{TNT-WARN TListView}
- TTntListView = class(TTntCustomListView)
- published
- property Action;
- property Align;
- property AllocBy;
- property Anchors;
- property BevelEdges;
- property BevelInner;
- property BevelOuter;
- property BevelKind default bkNone;
- property BevelWidth;
- property BiDiMode;
- property BorderStyle;
- property BorderWidth;
- property Checkboxes;
- property Color;
- property Columns;
- property ColumnClick;
- property Constraints;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property FlatScrollBars;
- property FullDrag;
- property GridLines;
- property HideSelection;
- property HotTrack;
- property HotTrackStyles;
- property HoverTime;
- property IconOptions;
- property Items;
- property LargeImages;
- property MultiSelect;
- property OwnerData;
- property OwnerDraw;
- property ReadOnly default False;
- property RowSelect;
- property ParentBiDiMode;
- property ParentColor default False;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowColumnHeaders;
- property ShowWorkAreas;
- property ShowHint;
- property SmallImages;
- property SortType;
- property StateImages;
- property TabOrder;
- property TabStop default True;
- property ViewStyle;
- property Visible;
- property OnAdvancedCustomDraw;
- property OnAdvancedCustomDrawItem;
- property OnAdvancedCustomDrawSubItem;
- property OnChange;
- property OnChanging;
- property OnClick;
- property OnColumnClick;
- property OnColumnDragged;
- property OnColumnRightClick;
- property OnCompare;
- property OnContextPopup;
- property OnCustomDraw;
- property OnCustomDrawItem;
- property OnCustomDrawSubItem;
- property OnData;
- property OnDataFind;
- property OnDataHint;
- property OnDataStateChange;
- property OnDblClick;
- property OnDeletion;
- property OnDrawItem;
- property OnEdited;
- property OnEditing;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetImageIndex;
- property OnGetSubItemImage;
- property OnDragDrop;
- property OnDragOver;
- property OnInfoTip;
- property OnInsert;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnResize;
- property OnSelectItem;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-type
-{TNT-WARN TToolButton}
- TTntToolButton = class(TToolButton{TNT-ALLOW TToolButton})
- private
- procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function IsCaptionStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
- function GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
- procedure SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
- protected
- procedure DefineProperties(Filer: TFiler); override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- property MenuItem: TMenuItem{TNT-ALLOW TMenuItem} read GetMenuItem write SetMenuItem;
- end;
-
-type
-{TNT-WARN TToolBar}
- TTntToolBar = class(TToolBar{TNT-ALLOW TToolBar})
- private
- FCaption: WideString;
- procedure TBInsertButtonA(var Message: TMessage); message TB_INSERTBUTTONA;
- procedure WMGetText(var Message: TWMGetText); message WM_GETTEXT;
- procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
- procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
- function GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
- procedure SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
- private
- function GetCaption: WideString;
- function GetHint: WideString;
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure SetCaption(const Value: WideString);
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- published
- property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- property Menu: TMainMenu{TNT-ALLOW TMainMenu} read GetMenu write SetMenu;
- end;
-
-type
-{TNT-WARN TCustomRichEdit}
- TTntCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit})
- private
- FRichEditStrings: TTntStrings;
- FPrintingTextLength: Integer;
- procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
- procedure SetRichEditStrings(const Value: TTntStrings);
- function GetWideSelText: WideString;
- function GetText: WideString;
- procedure SetWideSelText(const Value: WideString);
- procedure SetText(const Value: WideString);
- 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;
- procedure CreateWnd; override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- function GetSelText: string{TNT-ALLOW string}; override;
- function CharPosToGet(RawWin32CharPos: Integer): Integer; deprecated; // use EmulatedCharPos()
- function CharPosToSet(EmulatedCharPos: Integer): Integer; deprecated; // 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: 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;
-
-{TNT-WARN TRichEdit}
- TTntRichEdit = class(TTntCustomRichEdit)
- published
- property Align;
- property Alignment;
- property Anchors;
- property BevelEdges;
- property BevelInner;
- property BevelOuter;
- property BevelKind default bkNone;
- property BevelWidth;
- property BiDiMode;
- property BorderStyle;
- property BorderWidth;
- property Color;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HideSelection;
- property HideScrollBars;
- property ImeMode;
- property ImeName;
- property Constraints;
- property Lines;
- property MaxLength;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PlainText;
- property PopupMenu;
- property ReadOnly;
- property ScrollBars;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Visible;
- property WantTabs;
- property WantReturns;
- property WordWrap;
- property OnChange;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnMouseWheelDown;
- property OnMouseWheelUp;
- property OnProtectChange;
- property OnResizeRequest;
- property OnSaveClipboard;
- property OnSelectionChange;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-type
-{TNT-WARN TCustomTabControl}
- TTntCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl})
- private
- FTabs: TTntStrings;
- FSaveTabIndex: Integer;
- FSaveTabs: TTntStrings;
- function GetTabs: TTntStrings;
- procedure SetTabs(const Value: TTntStrings);
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- function GetHint: WideString;
- function IsHintStored: Boolean;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure CreateWnd; override;
- procedure DestroyWnd; override;
- property Tabs: TTntStrings read GetTabs write SetTabs;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TTabControl}
- TTntTabControl = class(TTntCustomTabControl)
- public
- property DisplayRect;
- published
- property Align;
- property Anchors;
- property BiDiMode;
- property Constraints;
- property DockSite;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HotTrack;
- property Images;
- property MultiLine;
- property MultiSelect;
- property OwnerDraw;
- property ParentBiDiMode;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property RaggedRight;
- property ScrollOpposite;
- property ShowHint;
- property Style;
- property TabHeight;
- property TabOrder;
- property TabPosition;
- property Tabs;
- property TabIndex; // must be after Tabs
- property TabStop;
- property TabWidth;
- property Visible;
- property OnChange;
- property OnChanging;
- property OnContextPopup;
- property OnDockDrop;
- property OnDockOver;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawTab;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetImageIndex;
- property OnGetSiteInfo;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnResize;
- property OnStartDock;
- property OnStartDrag;
- property OnUnDock;
- end;
-
-type
-{TNT-WARN TTabSheet}
- TTntTabSheet = class(TTabSheet{TNT-ALLOW TTabSheet})
- private
- Force_Inherited_WMSETTEXT: Boolean;
- function IsCaptionStored: Boolean;
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
- function GetHint: WideString;
- function IsHintStored: Boolean;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TPageControl}
- TTntPageControl = class(TPageControl{TNT-ALLOW TPageControl})
- private
- FNewDockSheet: TTntTabSheet;
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- procedure CMDockNotification(var Message: TCMDockNotification); message CM_DOCKNOTIFICATION;
- procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure WndProc(var Message: TMessage); override;
- procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TTrackBar}
- TTntTrackBar = class(TTrackBar{TNT-ALLOW TTrackBar})
- private
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- 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;
-
-{TNT-WARN TProgressBar}
- TTntProgressBar = class(TProgressBar{TNT-ALLOW TProgressBar})
- private
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- 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;
-
-{TNT-WARN TCustomUpDown}
- TTntCustomUpDown = class(TCustomUpDown{TNT-ALLOW TCustomUpDown})
- private
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- 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;
-
-{TNT-WARN TUpDown}
- TTntUpDown = class(TTntCustomUpDown)
- published
- property AlignButton;
- property Anchors;
- property Associate;
- property ArrowKeys;
- property Enabled;
- property Hint;
- property Min;
- property Max;
- property Increment;
- property Constraints;
- property Orientation;
- property ParentShowHint;
- property PopupMenu;
- property Position;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Thousands;
- property Visible;
- property Wrap;
- property OnChanging;
- property OnChangingEx;
- property OnContextPopup;
- property OnClick;
- property OnEnter;
- property OnExit;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- end;
-
-{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;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TMonthCalendar}
- TTntMonthCalendar = class(TMonthCalendar{TNT-ALLOW TMonthCalendar})
- private
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function GetDate: TDate;
- procedure SetDate(const Value: TDate);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- public
- procedure ForceGetMonthInfo;
- published
- property Date: TDate read GetDate write SetDate;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TPageScroller}
- TTntPageScroller = class(TPageScroller{TNT-ALLOW TPageScroller})
- private
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- 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;
-
-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
- function Add: TTntStatusPanel;
- function AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
- function Insert(Index: Integer): TTntStatusPanel;
- property Items[Index: Integer]: TTntStatusPanel read GetItem write SetItem; default;
- end;
-
-{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;
- function CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels}; override;
- function GetPanelClass: TStatusPanelClass; override;
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure WndProc(var Msg: TMessage); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- public
- 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)
- private
- function GetOnDrawPanel: TDrawPanelEvent;
- procedure SetOnDrawPanel(const Value: TDrawPanelEvent);
- 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;
- property OnCreatePanelClass;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnHint;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- // Required for backwards compatibility with the old event signature
- property OnDrawPanel: TDrawPanelEvent read GetOnDrawPanel write SetOnDrawPanel;
- 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;
-
- TTntTreeNodesEnumerator = class
- private
- FIndex: Integer;
- FTreeNodes: TTntTreeNodes;
- public
- constructor Create(ATreeNodes: TTntTreeNodes);
- function GetCurrent: TTntTreeNode;
- function MoveNext: Boolean;
- property Current: TTntTreeNode read GetCurrent;
- end;
-
-{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;
- function InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
- Ptr: Pointer): TTntTreeNode;
- function AddNode(Node, Relative: TTntTreeNode; const S: WideString;
- Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
- public
- function GetFirstNode: TTntTreeNode;
- function GetEnumerator: TTntTreeNodesEnumerator;
- 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})
- private
- function Wide_FindNextToSelect: TTntTreeNode; virtual; abstract;
- function Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
- public
- function FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode}; override;
- end;
-
- TTntCustomTreeView = class(_TntInternalCustomTreeView)
- private
- FSavedNodeText: TTntStrings;
- FSavedSortType: TSortType;
- 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);
- function Wide_FindNextToSelect: TTntTreeNode; override;
- function GetDropTarget: TTntTreeNode;
- function GetSelected: TTntTreeNode;
- function GetSelection(Index: Integer): TTntTreeNode;
- 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;
- function CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes}; override;
- 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;
- property Selections[Index: Integer]: TTntTreeNode read GetSelection;
- function GetSelections(AList: TList): TTntTreeNode;
- function FindNextToSelect: TTntTreeNode; reintroduce; virtual;
- 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;
- property MultiSelect;
- property MultiSelectStyle;
- 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;
- property OnAddition;
- property OnAdvancedCustomDraw;
- property OnAdvancedCustomDrawItem;
- property OnChange;
- property OnChanging;
- property OnClick;
- property OnCollapsed;
- property OnCollapsing;
- property OnCompare;
- property OnContextPopup;
- property OnCreateNodeClass;
- 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;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- { Items must be published after OnGetImageIndex and OnGetSelectedIndex }
- property Items;
- end;
-
-implementation
-
-uses
- Forms, SysUtils, TntGraphics, ImgList, TntSystem, TntStdCtrls, StdCtrls,
- RichEdit, ActiveIMM_TLB, TntForms, ComStrs, TntMenus,
- TntActnList, TntStdActns, TntWindows,
- {$IFNDEF COMPILER_10_UP}
- TntWideStrings,
- {$ELSE}
- WideStrings,
- {$ENDIF}
- {$IFDEF COMPILER_9_UP} WideStrUtils {$ELSE} TntWideStrUtils {$ENDIF};
-
-procedure CreateUnicodeHandle_ComCtl(Control: TWinControl; const Params: TCreateParams;
- const SubClass: WideString);
-begin
- Assert(SubClass <> '', 'TNT Internal Error: Only call CreateUnicodeHandle_ComCtl for Common Controls.');
- CreateUnicodeHandle(Control, Params, SubClass);
- if Win32PlatformIsUnicode then
- SendMessageW(Control.Handle, CCM_SETUNICODEFORMAT, Integer(True), 0);
-end;
-
-{ TTntListColumn }
-
-procedure TTntListColumn.Assign(Source: TPersistent);
-begin
- inherited;
- if Source is TTntListColumn then
- Caption := TTntListColumn(Source).Caption
- else if Source is TListColumn{TNT-ALLOW TListColumn} then
- FCaption := TListColumn{TNT-ALLOW TListColumn}(Source).Caption;
-end;
-
-procedure TTntListColumn.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntListColumn.SetInheritedCaption(const Value: AnsiString);
-begin
- inherited Caption := Value;
-end;
-
-function TTntListColumn.GetCaption: WideString;
-begin
- Result := GetSyncedWideString(FCaption, inherited Caption);
-end;
-
-procedure TTntListColumn.SetCaption(const Value: WideString);
-begin
- SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
-end;
-
-{ TTntListColumns }
-
-{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
-type
- THackCollection = class(TPersistent)
- protected
- FItemClass: TCollectionItemClass;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
-type
- THackCollection = class(TPersistent)
- protected
- FItemClass: TCollectionItemClass;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
-type
- THackCollection = class(TPersistent)
- protected
- FItemClass: TCollectionItemClass;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
-type
- THackCollection = class(TPersistent)
- protected
- FItemClass: TCollectionItemClass;
- end;
-{$ENDIF}
-
-constructor TTntListColumns.Create(AOwner: TTntCustomListView);
-begin
- inherited Create(AOwner);
- Assert(THackCollection(Self).FItemClass = Self.ItemClass, 'Internal Error in TTntListColumns.Create().');
- THackCollection(Self).FItemClass := TTntListColumn
-end;
-
-function TTntListColumns.Owner: TTntCustomListView;
-begin
- Result := inherited Owner as TTntCustomListView;
-end;
-
-function TTntListColumns.Add: TTntListColumn;
-begin
- Result := (inherited Add) as TTntListColumn;
-end;
-
-function TTntListColumns.GetItem(Index: Integer): TTntListColumn;
-begin
- Result := inherited Items[Index] as TTntListColumn;
-end;
-
-procedure TTntListColumns.SetItem(Index: Integer; Value: TTntListColumn);
-begin
- inherited SetItem(Index, Value);
-end;
-
-{ TWideSubItems }
-type
- TWideSubItems = class(TTntStringList)
- private
- FIgnoreInherited: Boolean;
- FInheritedOwner: TListItem{TNT-ALLOW TListItem};
- FOwner: TTntListItem;
- protected
- procedure Put(Index: Integer; const S: WideString); override;
- function GetObject(Index: Integer): TObject; override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetUpdateState(Updating: Boolean); override;
- public
- procedure Insert(Index: Integer; const S: WideString); override;
- function AddObject(const S: WideString; AObject: TObject): Integer; override;
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- public
- constructor Create(AOwner: TTntListItem);
- end;
-
-constructor TWideSubItems.Create(AOwner: TTntListItem);
-begin
- inherited Create;
- FInheritedOwner := AOwner;
- FOwner := AOwner;
-end;
-
-function TWideSubItems.AddObject(const S: WideString; AObject: TObject): Integer;
-begin
- FOwner.ListView.BeginChangingWideItem;
- try
- Result := inherited AddObject(S, AObject);
- if (not FIgnoreInherited) then
- FInheritedOwner.SubItems.AddObject(S, AObject);
- finally
- FOwner.ListView.EndChangingWideItem;
- end;
-end;
-
-procedure TWideSubItems.Clear;
-begin
- FOwner.ListView.BeginChangingWideItem;
- try
- inherited;
- if (not FIgnoreInherited) then
- FInheritedOwner.SubItems.Clear;
- finally
- FOwner.ListView.EndChangingWideItem;
- end;
-end;
-
-procedure TWideSubItems.Delete(Index: Integer);
-begin
- FOwner.ListView.BeginChangingWideItem;
- try
- inherited;
- if (not FIgnoreInherited) then
- FInheritedOwner.SubItems.Delete(Index);
- finally
- FOwner.ListView.EndChangingWideItem;
- end;
-end;
-
-procedure TWideSubItems.Insert(Index: Integer; const S: WideString);
-begin
- FOwner.ListView.BeginChangingWideItem;
- try
- inherited;
- if (not FIgnoreInherited) then
- FInheritedOwner.SubItems.Insert(Index, S);
- finally
- FOwner.ListView.EndChangingWideItem;
- end;
-end;
-
-procedure TWideSubItems.Put(Index: Integer; const S: WideString);
-begin
- FOwner.ListView.BeginChangingWideItem;
- try
- inherited;
- if (not FIgnoreInherited) then
- FInheritedOwner.SubItems[Index] := S;
- finally
- FOwner.ListView.EndChangingWideItem;
- end;
-end;
-
-function TWideSubItems.GetObject(Index: Integer): TObject;
-begin
- Result := FInheritedOwner.SubItems.Objects[Index];
-end;
-
-procedure TWideSubItems.PutObject(Index: Integer; AObject: TObject);
-begin
- FInheritedOwner.SubItems.Objects[Index] := AObject;
-end;
-
-type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
-
-procedure TWideSubItems.SetUpdateState(Updating: Boolean);
-begin
- inherited;
- TAccessStrings(FInheritedOwner.SubItems).SetUpdateState(Updating);
-end;
-
-{ TTntListItem }
-
-constructor TTntListItem.Create(AOwner: TListItems{TNT-ALLOW TListItems});
-begin
- inherited Create(AOwner);
- FSubItems := TWideSubItems.Create(Self);
-end;
-
-destructor TTntListItem.Destroy;
-begin
- inherited;
- FreeAndNil(FSubItems);
-end;
-
-function TTntListItem.GetCaption: WideString;
-begin
- Result := GetSyncedWideString(FCaption, inherited Caption);
-end;
-
-procedure TTntListItem.SetInheritedCaption(const Value: AnsiString);
-begin
- inherited Caption := Value;
-end;
-
-procedure TTntListItem.SetCaption(const Value: WideString);
-begin
- ListView.BeginChangingWideItem;
- try
- SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
- finally
- ListView.EndChangingWideItem;
- end;
-end;
-
-procedure TTntListItem.Assign(Source: TPersistent);
-begin
- if Source is TTntListItem then
- with Source as TTntListItem do
- begin
- Self.Caption := Caption;
- Self.Data := Data;
- Self.ImageIndex := ImageIndex;
- Self.Indent := Indent;
- Self.OverlayIndex := OverlayIndex;
- Self.StateIndex := StateIndex;
- Self.SubItems := SubItems;
- Self.Checked := Checked;
- end
- else inherited Assign(Source);
-end;
-
-procedure TTntListItem.SetSubItems(const Value: TTntStrings);
-begin
- if Value <> nil then
- FSubItems.Assign(Value);
-end;
-
-function TTntListItem.GetTntOwner: TTntListItems;
-begin
- Result := ListView.Items;
-end;
-
-function TTntListItem.GetListView: TTntCustomListView;
-begin
- Result := ((inherited Owner).Owner as TTntCustomListView);
-end;
-
-{ TTntListItemsEnumerator }
-
-constructor TTntListItemsEnumerator.Create(AListItems: TTntListItems);
-begin
- inherited Create;
- FIndex := -1;
- FListItems := AListItems;
-end;
-
-function TTntListItemsEnumerator.GetCurrent: TTntListItem;
-begin
- Result := FListItems[FIndex];
-end;
-
-function TTntListItemsEnumerator.MoveNext: Boolean;
-begin
- Result := FIndex < FListItems.Count - 1;
- if Result then
- Inc(FIndex);
-end;
-
-{ TTntListItems }
-
-function TTntListItems.Add: TTntListItem;
-begin
- Result := (inherited Add) as TTntListItem;
-end;
-
-function TTntListItems.AddItem(Item: TTntListItem; Index: Integer): TTntListItem;
-begin
- Result := (inherited AddItem(Item, Index)) as TTntListItem;
-end;
-
-function TTntListItems.Insert(Index: Integer): TTntListItem;
-begin
- Result := (inherited Insert(Index)) as TTntListItem;
-end;
-
-function TTntListItems.GetItem(Index: Integer): TTntListItem;
-begin
- Result := (inherited Item[Index]) as TTntListItem;
-end;
-
-function TTntListItems.Owner: TTntCustomListView;
-begin
- Result := (inherited Owner) as TTntCustomListView;
-end;
-
-procedure TTntListItems.SetItem(Index: Integer; const Value: TTntListItem);
-begin
- inherited Item[Index] := Value;
-end;
-
-function TTntListItems.GetEnumerator: TTntListItemsEnumerator;
-begin
- Result := TTntListItemsEnumerator.Create(Self);
-end;
-
-{ TSavedListItem }
-type
- TSavedListItem = class
- FCaption: WideString;
- FSubItems: TTntStrings;
- constructor Create;
- destructor Destroy; override;
- end;
-
-constructor TSavedListItem.Create;
-begin
- inherited;
- FSubItems := TTntStringList.Create;
-end;
-
-destructor TSavedListItem.Destroy;
-begin
- FSubItems.Free;
- 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 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;
- FxxxIconOptions: TIconOptions;
- FxxxHideSelection: Boolean;
- FListColumns: TListColumns{TNT-ALLOW TListColumns};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
-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;
- FxxxIconOptions: TIconOptions;
- FxxxHideSelection: Boolean;
- FListColumns: TListColumns{TNT-ALLOW TListColumns};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
-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;
- FxxxIconOptions: TIconOptions;
- FxxxHideSelection: Boolean;
- FListColumns: TListColumns{TNT-ALLOW TListColumns};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
-type
- THackCustomListView = class(TCustomMultiSelectListControl)
- protected
- FxxxCanvas: TCanvas;
- FxxxBorderStyle: TBorderStyle;
- FxxxViewStyle: TViewStyle;
- FxxxReadOnly: Boolean;
- FxxxLargeImages: TCustomImageList;
- FxxxSaveSelectedIndex: Integer;
- FxxxSmallImages: TCustomImageList;
- FxxxStateImages: TCustomImageList;
- FxxxDragImage: TDragImageList;
- FxxxMultiSelect: Boolean;
- FxxxSortType: TSortType;
- FxxxColumnClick: Boolean;
- FxxxShowColumnHeaders: Boolean;
- FxxxListItems: TListItems{TNT-ALLOW TListItems};
- FxxxClicked: Boolean;
- FxxxRClicked: Boolean;
- FxxxIconOptions: TIconOptions;
- FxxxHideSelection: Boolean;
- FListColumns: TListColumns{TNT-ALLOW TListColumns};
- end;
-{$ENDIF}
-
-var
- ComCtrls_DefaultListViewSort: TLVCompare = nil;
-
-constructor TTntCustomListView.Create(AOwner: TComponent);
-begin
- inherited;
- FEditInstance := Classes.MakeObjectInstance(EditWndProcW);
- // create list columns
- Assert(THackCustomListView(Self).FListColumns = inherited Columns, 'Internal Error in TTntCustomListView.Create().');
- FreeAndNil(THackCustomListView(Self).FListColumns);
- THackCustomListView(Self).FListColumns := TTntListColumns.Create(Self);
-end;
-
-destructor TTntCustomListView.Destroy;
-begin
- inherited;
- Classes.FreeObjectInstance(FEditInstance);
- FreeAndNil(FSavedItems);
-end;
-
-procedure TTntCustomListView.CreateWindowHandle(const Params: TCreateParams);
-
- procedure Capture_ComCtrls_DefaultListViewSort;
- begin
- FTestingForSortProc := True;
- try
- AlphaSort;
- finally
- FTestingForSortProc := False;
- end;
- end;
-
-var
- Column: TLVColumn;
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, WC_LISTVIEW);
- if (Win32PlatformIsUnicode) then begin
- if not Assigned(ComCtrls_DefaultListViewSort) then
- Capture_ComCtrls_DefaultListViewSort;
- // the only way I could get editing to work is after a column had been inserted
- Column.mask := 0;
- ListView_InsertColumn(Handle, 0, Column);
- ListView_DeleteColumn(Handle, 0);
- end;
-end;
-
-procedure TTntCustomListView.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntCustomListView.CreateWnd;
-begin
- inherited;
- FreeAndNil(FSavedItems);
-end;
-
-procedure TTntCustomListView.DestroyWnd;
-var
- i: integer;
- FSavedItem: TSavedListItem;
- Item: TTntListItem;
-begin
- if (not (csDestroying in ComponentState)) and (not OwnerData) then begin
- FreeAndNil(FSavedItems); // fixes a bug on Windows 95.
- FSavedItems := TObjectList.Create(True);
- for i := 0 to Items.Count - 1 do begin
- FSavedItem := TSavedListItem.Create;
- Item := Items[i];
- FSavedItem.FCaption := Item.FCaption;
- FSavedItem.FSubItems.Assign(Item.FSubItems);
- FSavedItems.Add(FSavedItem)
- end;
- end;
- 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;
-end;
-
-procedure TTntCustomListView.SetListColumns(const Value: TTntListColumns);
-begin
- inherited Columns := Value;
-end;
-
-{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
-type
- THackListColumn = class(TCollectionItem)
- protected
- FxxxAlignment: TAlignment;
- FxxxAutoSize: Boolean;
- FxxxCaption: AnsiString;
- FxxxMaxWidth: TWidth;
- FxxxMinWidth: TWidth;
- FxxxImageIndex: TImageIndex;
- FxxxPrivateWidth: TWidth;
- FxxxWidth: TWidth;
- FOrderTag: Integer;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
-type
- THackListColumn = class(TCollectionItem)
- protected
- FxxxAlignment: TAlignment;
- FxxxAutoSize: Boolean;
- FxxxCaption: AnsiString;
- FxxxMaxWidth: TWidth;
- FxxxMinWidth: TWidth;
- FxxxImageIndex: TImageIndex;
- FxxxPrivateWidth: TWidth;
- FxxxWidth: TWidth;
- FOrderTag: Integer;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in 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}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
-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
- I: Integer;
-begin
- for I := 0 to Columns.Count - 1 do
- begin
- Result := Columns[I];
- if THackListColumn(Result).FOrderTag = Tag then Exit;
- end;
- Result := nil;
-end;
-
-function TTntCustomListView.ColumnFromIndex(Index: Integer): TTntListColumn;
-begin
- Result := inherited Column[Index] as TTntListColumn;
-end;
-
-function TTntCustomListView.AreItemsStored: Boolean;
-begin
- if Assigned(Action) then
- begin
- if Action is TCustomListAction{TNT-ALLOW TCustomListAction} then
- Result := False
- else
- Result := True;
- end
- else
- Result := not OwnerData;
-end;
-
-function TTntCustomListView.GetItems: TTntListItems;
-begin
- Result := inherited Items as TTntListItems;
-end;
-
-procedure TTntCustomListView.SetItems(Value: TTntListItems);
-begin
- inherited Items := Value;
-end;
-
-type TTntListItemClass = class of TTntListItem;
-
-function TTntCustomListView.CreateListItem: TListItem{TNT-ALLOW TListItem};
-var
- LClass: TClass;
- TntLClass: TTntListItemClass;
-begin
- LClass := TTntListItem;
- if Assigned(OnCreateItemClass) then
- OnCreateItemClass(Self, TListItemClass(LClass));
- if not LClass.InheritsFrom(TTntListItem) then
- raise ETntInternalError.Create('Internal Error: OnCreateItemClass.ItemClass must inherit from TTntListItem.');
- TntLClass := TTntListItemClass(LClass);
- Result := TntLClass.Create(inherited Items);
- if FTempItem = nil then
- FTempItem := Result as TTntListItem; { In Delphi 5/6/7/9/10, the first item created is the temp item }
- { TODO: Verify that D11 creates a temp item in its constructor. }
-end;
-
-function TTntCustomListView.CreateListItems: TListItems{TNT-ALLOW TListItems};
-begin
- Result := TTntListItems.Create(Self);
-end;
-
-function TTntCustomListView.GetItemW(Value: TLVItemW): TTntListItem;
-begin
- with Value do begin
- if (mask and LVIF_PARAM) <> 0 then
- Result := TListItem{TNT-ALLOW TListItem}(lParam) as TTntListItem
- else if iItem >= 0 then
- Result := Items[IItem]
- else if OwnerData then
- Result := FTempItem
- else
- Result := nil
- 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 Assigned(OnData) then
- begin
- OnData(Self, Item);
- Result := True;
- end
- else Result := False;
-end;
-
-function TntDefaultListViewSort(Item1, Item2: TTntListItem; lParam: Integer): Integer; stdcall;
-begin
- Assert(Win32PlatformIsUnicode);
- with Item1 do
- if Assigned(ListView.OnCompare) then
- ListView.OnCompare(ListView, Item1, Item2, lParam, Result)
- else Result := lstrcmpw(PWideChar(Item1.Caption), PWideChar(Item2.Caption));
-end;
-
-procedure TTntCustomListView.WndProc(var Message: TMessage);
-var
- Item: TTntListItem;
- InheritedItem: TListItem{TNT-ALLOW TListItem};
- SubItem: Integer;
- SavedItem: TSavedListItem;
- PCol: PLVColumn;
- Col: TTntListColumn;
-begin
- with Message do begin
- // restore previous values (during CreateWnd)
- if (FSavedItems <> nil) and (FChangingWideItemCount = 0) and (Msg = LVM_SETITEMTEXTA) then begin
- Item := Items[wParam];
- SavedItem := TSavedListItem(FSavedItems[wParam]);
- if (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).iSubItem = 0) then
- Item.FCaption := SavedItem.FCaption
- else begin
- SubItem := PLVItem(lParam).iSubItem - 1;
- TWideSubItems(Item.SubItems).FIgnoreInherited := True;
- try
- if SubItem < Item.SubItems.Count then begin
- Item.SubItems[SubItem] := SavedItem.FSubItems[SubItem];
- Item.SubItems.Objects[SubItem] := SavedItem.FSubItems.Objects[SubItem]
- end else if SubItem = Item.SubItems.Count then
- Item.SubItems.AddObject(SavedItem.FSubItems[SubItem], SavedItem.FSubItems.Objects[SubItem])
- else
- Item.SubItems.Assign(SavedItem.FSubItems)
- finally
- TWideSubItems(Item.SubItems).FIgnoreInherited := False;
- end;
- end;
- end;
-
- // sync wide with ansi
- if (FSavedItems = nil) and (FChangingWideItemCount = 0) and (Msg = LVM_UPDATE) then begin
- Item := Items[wParam];
- InheritedItem := Item;
- TWideSubItems(Item.SubItems).FIgnoreInherited := True;
- try
- Item.SubItems.Assign(InheritedItem.SubItems)
- finally
- TWideSubItems(Item.SubItems).FIgnoreInherited := False;
- end;
- end;
-
- if (FSavedItems = nil) and (FChangingWideItemCount = 0) and (Msg = LVM_SETITEMTEXTA) then begin
- if OwnerData then
- Item := FTempItem
- else
- Item := Items[wParam];
- InheritedItem := Item;
- if (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).iSubItem = 0) then
- Item.FCaption := InheritedItem.Caption
- else begin
- SubItem := PLVItem(lParam).iSubItem - 1;
- TWideSubItems(Item.SubItems).FIgnoreInherited := True;
- try
- if SubItem < Item.SubItems.Count then begin
- Item.SubItems[SubItem] := InheritedItem.SubItems[SubItem];
- Item.SubItems.Objects[SubItem] := InheritedItem.SubItems.Objects[SubItem]
- end else if SubItem = Item.SubItems.Count then
- Item.SubItems.AddObject(InheritedItem.SubItems[SubItem], InheritedItem.SubItems.Objects[SubItem])
- else
- Item.SubItems.Assign(InheritedItem.SubItems)
- finally
- TWideSubItems(Item.SubItems).FIgnoreInherited := False;
- end;
- end;
- end;
-
- // capture ANSI version of DefaultListViewSort from ComCtrls
- if (FTestingForSortProc)
- and (Msg = LVM_SORTITEMS) then begin
- ComCtrls_DefaultListViewSort := Pointer(lParam);
- exit;
- end;
-
- if (Msg = LVM_SETCOLUMNA) then begin
- // make sure that wide column caption stays in sync with ANSI
- PCol := PLVColumn(lParam);
- if (PCol.mask and LVCF_TEXT) <> 0 then begin
- Col := GetColumnFromTag(wParam);
- if (Col <> nil) and (AnsiString(Col.Caption) <> PCol.pszText) then begin
- Col.FCaption := PCol.pszText;
- end;
- end;
- end;
-
- if (Win32PlatformIsUnicode)
- and (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).pszText = LPSTR_TEXTCALLBACK) then
- // Unicode:: call wide version of text call back instead
- 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 instead
- Result := SendMessageW(Handle, LVM_SORTITEMS, wParam, Integer(@TntDefaultListViewSort))
- else if (Win32PlatformIsUnicode)
- and (Msg = LVM_SETCOLUMNA) and ((PLVColumn(lParam).mask and LVCF_TEXT) <> 0)
- and (GetColumnFromTag(wParam) <> nil) then begin
- PLVColumn(lParam).pszText := PAnsiChar(PWideChar(GetColumnFromTag(wParam).FCaption));
- Result := SendMessageW(Handle, LVM_SETCOLUMNW, wParam, lParam);
- end else begin
- if (Msg = LVM_SETEXTENDEDLISTVIEWSTYLE) and CheckBoxes then begin
- { fix a bug in TCustomListView.ResetExStyles }
- lParam := lParam or LVS_EX_SUBITEMIMAGES or LVS_EX_INFOTIP;
- end;
- inherited;
- end;
- end;
-end;
-
-procedure TTntCustomListView.WMNotify(var Message: TWMNotify);
-begin
- inherited;
- // capture updated info after inherited
- with Message.NMHdr^ do
- case code of
- HDN_ENDTRACKW:
- begin
- Message.NMHdr^.code := HDN_ENDTRACKA;
- try
- inherited
- finally
- Message.NMHdr^.code := HDN_ENDTRACKW;
- end;
- end;
- HDN_DIVIDERDBLCLICKW:
- begin
- Message.NMHdr^.code := HDN_DIVIDERDBLCLICKA;
- try
- inherited
- finally
- Message.NMHdr^.code := HDN_DIVIDERDBLCLICKW;
- end;
- end;
- end;
-end;
-
-procedure TTntCustomListView.CNNotify(var Message: TWMNotify);
-var
- Item: TTntListItem;
-begin
- if (not Win32PlatformIsUnicode) then
- inherited
- else begin
- with Message do
- begin
- case NMHdr^.code of
- HDN_TRACKW:
- begin
- NMHdr^.code := HDN_TRACKA;
- try
- inherited;
- finally
- NMHdr^.code := HDN_TRACKW;
- end;
- end;
- LVN_GETDISPINFOW:
- begin
- // call inherited without the LVIF_TEXT flag
- CurrentDispInfo := PLVDispInfoW(NMHdr);
- try
- OriginalDispInfoMask := PLVDispInfoW(NMHdr)^.item.mask;
-
- PLVDispInfoW(NMHdr)^.item.mask := PLVDispInfoW(NMHdr)^.item.mask and (not LVIF_TEXT);
- try
- NMHdr^.code := LVN_GETDISPINFOA;
- try
- inherited;
- finally
- NMHdr^.code := LVN_GETDISPINFOW;
- end;
- finally
- if (OriginalDispInfoMask and LVIF_TEXT <> 0) then
- PLVDispInfoW(NMHdr)^.item.mask := PLVDispInfoW(NMHdr)^.item.mask or LVIF_TEXT;
- end;
- finally
- CurrentDispInfo := nil;
- end;
-
- // handle any text info
- with PLVDispInfoW(NMHdr)^.item do
- begin
- if (mask and LVIF_TEXT) <> 0 then
- begin
- Item := GetItemW(PLVDispInfoW(NMHdr)^.item);
- if iSubItem = 0 then
- WStrLCopy(pszText, PWideChar(Item.Caption), cchTextMax - 1)
- else begin
- with Item.SubItems do begin
- if iSubItem <= Count then
- WStrLCopy(pszText, PWideChar(Strings[iSubItem - 1]), cchTextMax - 1)
- else pszText[0] := #0;
- end;
- end;
- end;
- end;
- end;
- LVN_ODFINDITEMW:
- with PNMLVFindItem(NMHdr)^ do
- begin
- if ((lvfi.flags and LVFI_PARTIAL) <> 0) or ((lvfi.flags and LVFI_STRING) <> 0) then
- PWideFindString := TLVFindInfoW(lvfi).psz
- else
- PWideFindString := nil;
- lvfi.psz := nil;
- NMHdr^.code := LVN_ODFINDITEMA;
- try
- inherited; {will Result in call to OwnerDataFind}
- finally
- TLVFindInfoW(lvfi).psz := PWideFindString;
- NMHdr^.code := LVN_ODFINDITEMW;
- PWideFindString := nil;
- end;
- end;
- LVN_BEGINLABELEDITW:
- begin
- Item := GetItemW(PLVDispInfoW(NMHdr)^.item);
- if not CanEdit(Item) then Result := 1;
- if Result = 0 then
- begin
- FEditHandle := ListView_GetEditControl(Handle);
- FDefEditProc := Pointer(GetWindowLongW(FEditHandle, GWL_WNDPROC));
- SetWindowLongW(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
- end;
- end;
- LVN_ENDLABELEDITW:
- with PLVDispInfoW(NMHdr)^ do
- if (item.pszText <> nil) and (item.IItem <> -1) then
- Edit(TLVItemA(item));
- LVN_GETINFOTIPW:
- begin
- NMHdr^.code := LVN_GETINFOTIPA;
- try
- inherited;
- finally
- NMHdr^.code := LVN_GETINFOTIPW;
- end;
- end;
- else
- inherited;
- end;
- end;
- end;
-end;
-
-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
- AnsiEvent: TLVOwnerDataFindEvent;
-begin
- Result := -1;
- if Assigned(OnDataFind) then
- OnDataFind(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap, Result)
- else if Assigned(inherited OnDataFind) then begin
- AnsiEvent := inherited OnDataFind;
- AnsiEvent(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction,
- Wrap, Result);
- end;
-end;
-
-procedure TTntCustomListView.Edit(const Item: TLVItem);
-var
- S: WideString;
- AnsiS: AnsiString;
- EditItem: TTntListItem;
- AnsiEvent: TLVEditedEvent;
-begin
- if (not Win32PlatformIsUnicode) then
- S := Item.pszText
- else
- S := TLVItemW(Item).pszText;
- EditItem := GetItemW(TLVItemW(Item));
- if Assigned(OnEdited) then
- OnEdited(Self, EditItem, S)
- else if Assigned(inherited OnEdited) then
- begin
- AnsiEvent := inherited OnEdited;
- AnsiS := S;
- AnsiEvent(Self, EditItem, AnsiS);
- S := AnsiS;
- end;
- if EditItem <> nil then
- EditItem.Caption := S;
-end;
-
-procedure TTntCustomListView.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 TTntCustomListView.BeginChangingWideItem;
-begin
- Inc(FChangingWideItemCount);
-end;
-
-procedure TTntCustomListView.EndChangingWideItem;
-begin
- if FChangingWideItemCount > 0 then
- Dec(FChangingWideItemCount);
-end;
-
-procedure TTntCustomListView.DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect;
- State: TOwnerDrawState);
-begin
- TControlCanvas(Canvas).UpdateTextFlags;
- if Assigned(OnDrawItem) then OnDrawItem(Self, Item, Rect, State)
- else
- begin
- Canvas.FillRect(Rect);
- WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Item.Caption);
- end;
-end;
-
-procedure TTntCustomListView.CopySelection(Destination: TCustomListControl);
-var
- I: Integer;
-begin
- for I := 0 to Items.Count - 1 do
- if Items[I].Selected then
- WideListControl_AddItem(Destination, Items[I].Caption, Items[I].Data);
-end;
-
-procedure TTntCustomListView.AddItem(const Item: WideString; AObject: TObject);
-begin
- with Items.Add do
- begin
- Caption := Item;
- Data := AObject;
- end;
-end;
-
-//-------------
-
-function TTntCustomListView.FindCaption(StartIndex: Integer; Value: WideString;
- Partial, Inclusive, Wrap: Boolean): TTntListItem;
-const
- FullString: array[Boolean] of Integer = (0, LVFI_PARTIAL);
- Wraps: array[Boolean] of Integer = (0, LVFI_WRAP);
-var
- Info: TLVFindInfoW;
- Index: Integer;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := inherited FindCaption(StartIndex, Value, Partial, Inclusive, Wrap) as TTntListItem
- else begin
- with Info do
- begin
- flags := LVFI_STRING or FullString[Partial] or Wraps[Wrap];
- psz := PWideChar(Value);
- end;
- if Inclusive then Dec(StartIndex);
- Index := SendMessageW(Handle, LVM_FINDITEMW, StartIndex, Longint(@Info));
- if Index <> -1 then Result := Items[Index]
- else Result := nil;
- end;
-end;
-
-function TTntCustomListView.StringWidth(S: WideString): Integer;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := inherited StringWidth(S)
- else
- Result := SendMessageW(Handle, LVM_GETSTRINGWIDTHW, 0, Longint(PWideChar(S)))
-end;
-
-function TTntCustomListView.GetSearchString: WideString;
-var
- Buffer: array[0..1023] of WideChar;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := inherited GetSearchString
- else begin
- Result := '';
- if HandleAllocated
- and Bool(SendMessageW(Handle, LVM_GETISEARCHSTRINGW, 0, Longint(PWideChar(@Buffer[0])))) then
- Result := Buffer;
- end;
-end;
-
-function TTntCustomListView.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomListView.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomListView.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomListView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomListView.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntToolButton }
-
-procedure TTntToolButton.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntToolButton.CMVisibleChanged(var Message: TMessage);
-begin
- inherited;
- RefreshControl;
-end;
-
-function TTntToolButton.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntToolButton.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
- RefreshControl; { causes button to be removed and reinserted with TB_INSERTBUTTON }
-end;
-
-function TTntToolButton.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self)
-end;
-
-function TTntToolButton.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntToolButton.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-function TTntToolButton.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-procedure TTntToolButton.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntToolButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntToolButton.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-function TTntToolButton.GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
-begin
- Result := inherited MenuItem;
-end;
-
-procedure TTntToolButton.SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
-begin
- inherited MenuItem := Value;
- if Value is TTntMenuItem then begin
- Caption := TTntMenuItem(Value).Caption;
- Hint := TTntMenuItem(Value).Hint;
- end;
-end;
-
-{ TTntToolBar }
-
-procedure TTntToolBar.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, TOOLBARCLASSNAME);
-end;
-
-procedure TTntToolBar.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntToolBar.TBInsertButtonA(var Message: TMessage);
-var
- Button: TTntToolButton;
- Buffer: WideString;
-begin
- if Win32PlatformIsUnicode
- and (PTBButton(Message.LParam).iString <> -1)
- and (Buttons[Message.WParam] is TTntToolButton) then
- begin
- Button := TTntToolButton(Buttons[Message.WParam]);
- Buffer := Button.Caption + WideChar(#0);
- PTBButton(Message.LParam).iString :=
- SendMessage(Handle, TB_ADDSTRINGW, 0, Integer(PWideChar(Buffer)));
- end;
- inherited;
-end;
-
-{ Need to read/write caption ourselves - default wndproc seems to discard it. }
-
-procedure TTntToolBar.WMGetText(var Message: TWMGetText);
-begin
- if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
- inherited
- else
- with Message do
- Result := WStrLen(WStrLCopy(PWideChar(Text), PWideChar(FCaption), TextMax - 1));
-end;
-
-procedure TTntToolBar.WMGetTextLength(var Message: TWMGetTextLength);
-begin
- if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
- inherited
- else
- Message.Result := Length(FCaption);
-end;
-
-procedure TTntToolBar.WMSetText(var Message: TWMSetText);
-begin
- if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
- inherited
- else
- with Message do
- SetString(FCaption, PWideChar(Text), WStrLen(PWideChar(Text)));
-end;
-
-function TTntToolBar.GetCaption: WideString;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntToolBar.SetCaption(const Value: WideString);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntToolBar.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self);
-end;
-
-function TTntToolBar.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntToolBar.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-function TTntToolBar.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-procedure TTntToolBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntToolBar.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-function TTntToolBar.GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
-begin
- Result := inherited Menu;
-end;
-
-procedure TTntToolBar.SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
-var
- I: Integer;
-begin
- if (Menu <> Value) then begin
- inherited Menu := Value;
- if Assigned(Menu) then begin
- // get rid of TToolButton(s)
- for I := ButtonCount - 1 downto 0 do
- Buttons[I].Free;
- // add TTntToolButton(s)
- for I := Menu.Items.Count - 1 downto 0 do
- begin
- with TTntToolButton.Create(Self) do
- try
- AutoSize := True;
- Grouped := True;
- Parent := Self;
- MenuItem := Menu.Items[I];
- except
- Free;
- raise;
- end;
- end;
- end;
- end;
-end;
-
-{ TTntRichEditStrings }
-type
- TTntRichEditStrings = class(TTntMemoStrings)
- private
- RichEdit: TCustomRichEdit{TNT-ALLOW TCustomRichEdit};
- procedure EnableChange(const Value: Boolean);
- protected
- procedure SetTextStr(const Value: WideString); override;
- public
- constructor Create;
- procedure AddStrings(Strings: TWideStrings); overload; override;
- //--
- procedure LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean); override;
- procedure SaveToStream_BOM(Stream: TStream; WithBOM: Boolean); override;
- procedure LoadFromFile(const FileName: WideString); override;
- procedure SaveToFile(const FileName: WideString); override;
- end;
-
-constructor TTntRichEditStrings.Create;
-begin
- inherited Create;
- FRichEditMode := True;
-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;
-begin
- with RichEdit do
- begin
- if Value then
- EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) or ENM_CHANGE
- else
- EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) and not ENM_CHANGE;
- SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
- end;
-end;
-
-procedure TTntRichEditStrings.SetTextStr(const Value: WideString);
-begin
- EnableChange(False);
- try
- inherited;
- finally
- EnableChange(True);
- end;
-end;
-
-type TAccessCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit});
-
-procedure TTntRichEditStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);
-begin
- if TAccessCustomRichEdit(RichEdit).PlainText then
- inherited LoadFromStream_BOM(Stream, WithBOM)
- else
- TAccessCustomRichEdit(RichEdit).Lines.LoadFromStream(Stream);
-end;
-
-procedure TTntRichEditStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);
-begin
- if TAccessCustomRichEdit(RichEdit).PlainText then
- inherited SaveToStream_BOM(Stream, WithBOM)
- else
- TAccessCustomRichEdit(RichEdit).Lines.SaveToStream(Stream);
-end;
-
-procedure TTntRichEditStrings.LoadFromFile(const FileName: WideString);
-begin
- if TAccessCustomRichEdit(RichEdit).PlainText then
- inherited LoadFromFile(FileName)
- else
- TAccessCustomRichEdit(RichEdit).Lines.LoadFromFile(FileName);
-end;
-
-procedure TTntRichEditStrings.SaveToFile(const FileName: WideString);
-begin
- if TAccessCustomRichEdit(RichEdit).PlainText then
- inherited SaveToFile(FileName)
- else
- TAccessCustomRichEdit(RichEdit).Lines.SaveToFile(FileName);
-end;
-
-{ TTntCustomRichEdit }
-
-constructor TTntCustomRichEdit.Create(AOwner: TComponent);
-begin
- inherited;
- FRichEditStrings := TTntRichEditStrings.Create;
- TTntRichEditStrings(FRichEditStrings).FMemo := Self;
- TTntRichEditStrings(FRichEditStrings).FMemoLines := TAccessCustomRichEdit(Self).Lines;
- TTntRichEditStrings(FRichEditStrings).FLineBreakStyle := Self.LineBreakStyle;
- TTntRichEditStrings(FRichEditStrings).RichEdit := Self;
-end;
-
-var
- FRichEdit20Module: THandle = 0;
-
-function IsRichEdit20Available: Boolean;
-const
- RICHED20_DLL = 'RICHED20.DLL';
-begin
- if FRichEdit20Module = 0 then
- 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);
- if WordWrap then
- Params.Style := Params.Style and not WS_HSCROLL; // more compatible with RichEdit 1.0
-end;
-
-procedure TTntCustomRichEdit.CreateWindowHandle(const Params: TCreateParams);
-begin
- if Win32PlatformIsUnicode and IsRichEdit20Available then
- CreateUnicodeHandle(Self, Params, RICHEDIT_CLASSW)
- else
- inherited
-end;
-
-var
- AIMM: IActiveIMMApp = nil;
-
-function EnableActiveIMM: Boolean;
-begin
- if AIMM <> nil then
- Result := True
- else begin
- Result := False;
- try
- if ClassIsRegistered(CLASS_CActiveIMM) then begin
- AIMM := CoCActiveIMM.Create;
- AIMM.Activate(1);
- Result := True;
- end;
- except
- AIMM := nil;
- end;
- end;
-end;
-
-procedure TTntCustomRichEdit.CreateWnd;
-const
- EM_SETEDITSTYLE = WM_USER + 204;
- SES_USEAIMM = 64;
-begin
- inherited;
- // Only supported in RichEdit 3.0, but this flag is harmless to RichEdit1.0 or RichEdit 2.0
- if EnableActiveIMM then
- SendMessage(Handle, EM_SETEDITSTYLE, SES_USEAIMM, SES_USEAIMM);
-end;
-
-procedure TTntCustomRichEdit.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-destructor TTntCustomRichEdit.Destroy;
-begin
- FreeAndNil(FRichEditStrings);
- inherited;
-end;
-
-procedure TTntCustomRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
-begin
- inherited;
- if (not WantReturns) and (Key = VK_RETURN) and (Shift <> [ssCtrl]) then
- Key := 0;
-end;
-
-function TTntCustomRichEdit.LineBreakStyle: TTntTextLineBreakStyle;
-begin
- if Win32PlatformIsUnicode and IsRichEdit20Available then
- Result := tlbsCR
- else
- Result := tlbsCRLF;
-end;
-
-procedure TTntCustomRichEdit.SetRichEditStrings(const Value: TTntStrings);
-begin
- FRichEditStrings.Assign(Value);
-end;
-
-function TTntCustomRichEdit.GetSelText: string{TNT-ALLOW string};
-begin
- Result := GetWideSelText;
-end;
-
-function TTntCustomRichEdit.GetWideSelText: WideString;
-var
- CharRange: TCharRange;
- Length: Integer;
-begin
- if (not IsWindowUnicode(Handle)) then
- Result := inherited GetSelText
- else begin
- SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
- SetLength(Result, CharRange.cpMax - CharRange.cpMin + 1);
- Length := SendMessageW(Handle, EM_GETSELTEXT, 0, Longint(PWideChar(Result)));
- SetLength(Result, Length);
- end;
- if LineBreakStyle <> tlbsCRLF then
- 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
- 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 (LineBreakStyle <> tlbsCRLF) then
- Result := TntAdjustLineBreaks(Result, tlbsCRLF);
-end;
-
-procedure TTntCustomRichEdit.SetText(const Value: WideString);
-const
- ST_DEFAULT = 0;
-begin
- 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;
-
-function TTntCustomRichEdit.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomRichEdit.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomRichEdit.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomRichEdit.WMGetTextLength(var Message: TWMGetTextLength);
-begin
- if FPrintingTextLength <> 0 then
- Message.Result := FPrintingTextLength
- else
- inherited;
-end;
-
-procedure TTntCustomRichEdit.Print(const Caption: string{TNT-ALLOW string});
-begin
- if (LineBreakStyle <> tlbsCRLF) then
- FPrintingTextLength := TntAdjustLineBreaksLength(Text, LineBreakStyle)
- else
- FPrintingTextLength := 0;
- try
- inherited
- finally
- FPrintingTextLength := 0;
- end;
-end;
-
-{$WARN SYMBOL_DEPRECATED OFF}
-
-function TTntCustomRichEdit.CharPosToGet(RawWin32CharPos: Integer): Integer;
-begin
- Result := EmulatedCharPos(RawWin32CharPos);
-end;
-
-function TTntCustomRichEdit.CharPosToSet(EmulatedCharPos: Integer): Integer;
-begin
- Result := RawWin32CharPos(EmulatedCharPos);
-end;
-{$WARN SYMBOL_DEPRECATED ON}
-
-function TTntCustomRichEdit.EmulatedCharPos(RawWin32CharPos: Integer): Integer;
-var
- i: Integer;
- ThisLine: Integer;
- CharCount: Integer;
- Line_Start: Integer;
- NumLineBreaks: Integer;
-begin
- if (LineBreakStyle = tlbsCRLF) or (RawWin32CharPos <= 0) then
- Result := RawWin32CharPos
- else begin
- Assert(Win32PlatformIsUnicode);
- 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.RawWin32CharPos(EmulatedCharPos: Integer): Integer;
-var
- Line: Integer;
- NumLineBreaks: Integer;
- CharCount: Integer;
- Line_Start: Integer;
- LineLength: Integer;
-begin
- if (LineBreakStyle = tlbsCRLF) or (EmulatedCharPos <= 0) then
- Result := EmulatedCharPos
- else begin
- Assert(Win32PlatformIsUnicode);
- NumLineBreaks := 0;
- CharCount := 0;
- 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 Line_Start > CharCount then begin
- Inc(NumLineBreaks);
- Inc(CharCount);
- end;
- LineLength := TntMemo_LineLength(Handle, Line, Line_Start);
- Inc(CharCount, LineLength);
- if (EmulatedCharPos >= (Line_Start + NumLineBreaks))
- and (EmulatedCharPos < (Line_Start + LineLength + NumLineBreaks)) then
- break; {found it}
- end;
- Result := EmulatedCharPos - NumLineBreaks; {deflate CR/LF -> CR}
- end;
-end;
-
-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
- Find: TFindTextW;
- Flags: Integer;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := inherited FindText(SearchStr, StartPos, Length, Options)
- else begin
- 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 := TntCustomEdit_GetSelStart(Self);
- Result := EmulatedCharPos(Result);
-end;
-
-procedure TTntCustomRichEdit.SetSelStart(const Value: Integer);
-begin
- TntCustomEdit_SetSelStart(Self, RawWin32CharPos(Value));
-end;
-
-function TTntCustomRichEdit.GetSelLength: Integer;
-var
- 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 (LineBreakStyle = tlbsCRLF) then
- TntCustomEdit_SetSelLength(Self, Value)
- else begin
- StartPos := Self.SelStart;
- SelEnd := StartPos + Value;
- inherited SetSelLength(RawWin32CharPos(SelEnd) - RawWin32CharPos(StartPos));
- end;
-end;
-
-procedure TTntCustomRichEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomRichEdit.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntTabStrings }
-
-type TAccessCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl});
-
-type
- TTntTabStrings = class(TTntStrings)
- private
- FTabControl: TCustomTabControl{TNT-ALLOW TCustomTabControl};
- FAnsiTabs: TStrings{TNT-ALLOW TStrings};
- protected
- function Get(Index: Integer): WideString; override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure Put(Index: Integer; const S: WideString); 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: WideString); override;
- end;
-
-procedure TabControlError(const S: WideString);
-begin
- raise EListError.Create(S);
-end;
-
-procedure TTntTabStrings.Clear;
-begin
- FAnsiTabs.Clear;
-end;
-
-procedure TTntTabStrings.Delete(Index: Integer);
-begin
- FAnsiTabs.Delete(Index);
-end;
-
-function TTntTabStrings.GetCount: Integer;
-begin
- Result := FAnsiTabs.Count;
-end;
-
-function TTntTabStrings.GetObject(Index: Integer): TObject;
-begin
- Result := FAnsiTabs.Objects[Index];
-end;
-
-procedure TTntTabStrings.PutObject(Index: Integer; AObject: TObject);
-begin
- FAnsiTabs.Objects[Index] := AObject;
-end;
-
-procedure TTntTabStrings.SetUpdateState(Updating: Boolean);
-begin
- inherited;
- TAccessStrings(FAnsiTabs).SetUpdateState(Updating);
-end;
-
-function TTntTabStrings.Get(Index: Integer): WideString;
-const
- RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
-var
- TCItem: TTCItemW;
- Buffer: array[0..4095] of WideChar;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := FAnsiTabs[Index]
- else begin
- TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading];
- TCItem.pszText := Buffer;
- TCItem.cchTextMax := SizeOf(Buffer);
- if SendMessageW(FTabControl.Handle, TCM_GETITEMW, Index, Longint(@TCItem)) = 0 then
- TabControlError(WideFormat(sTabFailRetrieve, [Index]));
- Result := Buffer;
- end;
-end;
-
-function GetTabControlImageIndex(Self: TCustomTabControl{TNT-ALLOW TCustomTabControl}; TabIndex: Integer): Integer;
-begin
- Result := TabIndex;
- with TAccessCustomTabControl(Self) do
- if Assigned(OnGetImageIndex) then OnGetImageIndex(Self, TabIndex, Result);
-end;
-
-procedure TTntTabStrings.Put(Index: Integer; const S: WideString);
-const
- RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
-var
- TCItem: TTCItemW;
-begin
- if (not Win32PlatformIsUnicode) then
- FAnsiTabs[Index] := S
- else begin
- TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading] or TCIF_IMAGE;
- TCItem.pszText := PWideChar(S);
- TCItem.iImage := GetTabControlImageIndex(FTabControl, Index);
- if SendMessageW(FTabControl.Handle, TCM_SETITEMW, Index, Longint(@TCItem)) = 0 then
- TabControlError(WideFormat(sTabFailSet, [S, Index]));
- TAccessCustomTabControl(FTabControl).UpdateTabImages;
- end;
-end;
-
-procedure TTntTabStrings.Insert(Index: Integer; const S: WideString);
-const
- RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
-var
- TCItem: TTCItemW;
-begin
- if (not Win32PlatformIsUnicode) then
- FAnsiTabs.Insert(Index, S)
- else begin
- TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading] or TCIF_IMAGE;
- TCItem.pszText := PWideChar(S);
- TCItem.iImage := GetTabControlImageIndex(FTabControl, Index);
- if SendMessageW(FTabControl.Handle, TCM_INSERTITEMW, Index, Longint(@TCItem)) < 0 then
- TabControlError(WideFormat(sTabFailSet, [S, Index]));
- TAccessCustomTabControl(FTabControl).UpdateTabImages;
- end;
-end;
-
-{ TTntCustomTabControl }
-
-constructor TTntCustomTabControl.Create(AOwner: TComponent);
-begin
- inherited;
- FTabs := TTntTabStrings.Create;
- TTntTabStrings(FTabs).FTabControl := Self;
- TTntTabStrings(FTabs).FAnsiTabs := inherited Tabs;
-end;
-
-destructor TTntCustomTabControl.Destroy;
-begin
- TTntTabStrings(FTabs).FTabControl := nil;
- TTntTabStrings(FTabs).FAnsiTabs := nil;
- FreeAndNil(FTabs);
- FreeAndNil(FSaveTabs);
- inherited;
-end;
-
-procedure TTntCustomTabControl.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
-end;
-
-procedure TTntCustomTabControl.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntCustomTabControl.CreateWnd;
-begin
- inherited;
- if FSaveTabs <> nil then
- begin
- FTabs.Assign(FSaveTabs);
- FreeAndNil(FSaveTabs);
- TabIndex := FSaveTabIndex;
- end;
-end;
-
-procedure TTntCustomTabControl.DestroyWnd;
-begin
- if (FTabs <> nil) and (FTabs.Count > 0) then
- begin
- FSaveTabs := TTntStringList.Create;
- FSaveTabs.Assign(FTabs);
- FSaveTabIndex := TabIndex;
- end;
- inherited;
-end;
-
-function TTntCustomTabControl.GetTabs: TTntStrings;
-begin
- if FSaveTabs <> nil then
- Result := FSaveTabs // Use FSaveTabs while the window is deallocated
- else
- Result := FTabs;
-end;
-
-procedure TTntCustomTabControl.SetTabs(const Value: TTntStrings);
-begin
- FTabs.Assign(Value);
-end;
-
-function TTntCustomTabControl.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomTabControl.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomTabControl.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomTabControl.CMDialogChar(var Message: TCMDialogChar);
-var
- I: Integer;
-begin
- for I := 0 to Tabs.Count - 1 do
- if IsWideCharAccel(Message.CharCode, Tabs[I]) and CanShowTab(I) and CanFocus then
- begin
- Message.Result := 1;
- if CanChange then
- begin
- TabIndex := I;
- Change;
- end;
- Exit;
- end;
- Broadcast(Message);
-end;
-
-procedure TTntCustomTabControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomTabControl.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntTabSheet }
-
-procedure TTntTabSheet.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-function TTntTabSheet.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self);
-end;
-
-function TTntTabSheet.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntTabSheet.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntTabSheet.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntTabSheet.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntTabSheet.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntTabSheet.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntTabSheet.WMSetText(var Message: TWMSetText);
-begin
- if (not Win32PlatformIsUnicode)
- or (HandleAllocated)
- or (Message.Text = AnsiString(TntControl_GetText(Self)))
- or (Force_Inherited_WMSETTEXT) then
- inherited
- else begin
- // NT, handle not allocated and text is different
- Force_Inherited_WMSETTEXT := True;
- try
- TntControl_SetText(Self, Message.Text) { sync WideCaption with ANSI Caption }
- finally
- Force_Inherited_WMSETTEXT := FALSE;
- end;
- end;
-end;
-
-procedure TTntTabSheet.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntTabSheet.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntPageControl }
-
-procedure TTntPageControl.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
-end;
-
-procedure TTntPageControl.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntPageControl.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntPageControl.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntPageControl.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntPageControl.WndProc(var Message: TMessage);
-const
- RTL: array[Boolean] of Cardinal = (0, TCIF_RTLREADING);
-var
- TCItemA: PTCItemA;
- TabSheet: TTabSheet{TNT-ALLOW TTabSheet};
- Text: WideString;
-begin
- if (not Win32PlatformIsUnicode) then
- inherited
- else begin
- case Message.Msg of
- TCM_SETITEMA:
- begin
- TCItemA := PTCItemA(Message.lParam);
- if ((TCItemA.mask and TCIF_PARAM) = TCIF_PARAM) then
- TabSheet := TObject(TCItemA.lParam) as TTabSheet{TNT-ALLOW TTabSheet}
- else if ((TCItemA.mask and TCIF_TEXT) = TCIF_TEXT)
- and (Message.wParam >= 0) and (Message.wParam <= Tabs.Count - 1) then
- TabSheet := Tabs.Objects[Message.wParam] as TTabSheet{TNT-ALLOW TTabSheet}
- else
- TabSheet := nil;
-
- if TabSheet = nil then begin
- // will always be followed by TCM_SETITEMA(TCIF_PARAM) if TCIF_TEXT is present
- TCItemA.mask := TCItemA.mask and (not TCIF_TEXT);
- end else begin
- // convert message to unicode, add text
- Message.Msg := TCM_SETITEMW;
- TCItemA.mask := TCItemA.mask or TCIF_TEXT or RTL[UseRightToLeftReading];
- if TabSheet is TTntTabSheet then
- Text := TTntTabSheet(TabSheet).Caption
- else
- Text := TabSheet.Caption;
- TCItemA.pszText := PAnsiChar(PWideChar(Text));
- end;
- end;
- TCM_INSERTITEMA:
- begin
- TCItemA := PTCItemA(Message.lParam);
- // will always be followed by TCM_SETITEMA(TCIF_PARAM) if TCIF_TEXT is present
- TCItemA.mask := TCItemA.mask and (not TCIF_TEXT);
- end;
- end;
- inherited;
- end;
-end;
-
-procedure TTntPageControl.CMDialogChar(var Message: TCMDialogChar);
-var
- I: Integer;
- TabText: WideString;
-begin
- for I := 0 to PageCount - 1 do begin
- if Pages[i] is TTntTabSheet then
- TabText := TTntTabSheet(Pages[i]).Caption
- else
- TabText := Pages[i].Caption;
- if IsWideCharAccel(Message.CharCode, TabText) and CanShowTab(Pages[i].TabIndex) and CanFocus then
- begin
- Message.Result := 1;
- if CanChange then
- begin
- TabIndex := Pages[i].TabIndex;
- Change;
- end;
- Exit;
- end;
- end;
- Broadcast(Message);
-end;
-
-procedure TTntPageControl.CMDockClient(var Message: TCMDockClient);
-var
- IsVisible: Boolean;
- DockCtl: TControl;
-begin
- Message.Result := 0;
- FNewDockSheet := TTntTabSheet.Create(Self);
- try
- try
- DockCtl := Message.DockSource.Control;
- if DockCtl is TCustomForm then
- FNewDockSheet.Caption := TntControl_GetText(DockCtl);
- FNewDockSheet.PageControl := Self;
- DockCtl.Dock(Self, Message.DockSource.DockRect);
- except
- FNewDockSheet.Free;
- raise;
- end;
- IsVisible := DockCtl.Visible;
- FNewDockSheet.TabVisible := IsVisible;
- if IsVisible then ActivePage := FNewDockSheet;
- DockCtl.Align := alClient;
- finally
- FNewDockSheet := nil;
- end;
-end;
-
-procedure TTntPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
-begin
- if FNewDockSheet <> nil then
- Client.Parent := FNewDockSheet;
-end;
-
-procedure TTntPageControl.CMDockNotification(var Message: TCMDockNotification);
-var
- I: Integer;
- S: WideString;
- Page: TTabSheet{TNT-ALLOW TTabSheet};
-begin
- Page := GetPageFromDockClient(Message.Client);
- if (Message.NotifyRec.ClientMsg <> WM_SETTEXT)
- or (Page = nil) or (not (Page is TTntTabSheet)) then
- inherited
- else begin
- if (Message.Client is TWinControl)
- and (TWinControl(Message.Client).HandleAllocated)
- and IsWindowUnicode(TWinControl(Message.Client).Handle) then
- S := PWideChar(Message.NotifyRec.MsgLParam)
- else
- S := PAnsiChar(Message.NotifyRec.MsgLParam);
- { Search for first CR/LF and end string there }
- for I := 1 to Length(S) do
- if S[I] in [CR, LF] then
- begin
- SetLength(S, I - 1);
- Break;
- end;
- TTntTabSheet(Page).Caption := S;
- end;
-end;
-
-procedure TTntPageControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntPageControl.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntTrackBar }
-
-procedure TTntTrackBar.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, TRACKBAR_CLASS);
-end;
-
-procedure TTntTrackBar.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntTrackBar.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntTrackBar.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntTrackBar.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntTrackBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntTrackBar.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntProgressBar }
-
-procedure TTntProgressBar.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, PROGRESS_CLASS);
-end;
-
-procedure TTntProgressBar.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntProgressBar.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntProgressBar.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntProgressBar.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntProgressBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntProgressBar.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntCustomUpDown }
-
-procedure TTntCustomUpDown.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, UPDOWN_CLASS);
-end;
-
-procedure TTntCustomUpDown.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomUpDown.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomUpDown.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomUpDown.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomUpDown.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomUpDown.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntDateTimePicker }
-
-procedure TTntDateTimePicker.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, DATETIMEPICK_CLASS);
-end;
-
-procedure TTntDateTimePicker.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDateTimePicker.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntDateTimePicker.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntDateTimePicker.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntDateTimePicker.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntDateTimePicker.GetActionLinkClass: TControlActionLinkClass;
-begin
- 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, Integer(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);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, MONTHCAL_CLASS);
- if Win32PlatformIsUnicode then begin
- { For some reason WM_NOTIFY:MCN_GETDAYSTATE never gets called. }
- ForceGetMonthInfo;
- end;
-end;
-
-procedure TTntMonthCalendar.ForceGetMonthInfo;
-var
- Hdr: TNMDayState;
- Days: array of TMonthDayState;
- Range: array[1..2] of TSystemTime;
-begin
- // populate Days array
- Hdr.nmhdr.hwndFrom := Handle;
- Hdr.nmhdr.idFrom := 0;
- Hdr.nmhdr.code := MCN_GETDAYSTATE;
- Hdr.cDayState := MonthCal_GetMonthRange(Handle, GMR_DAYSTATE, @Range[1]);
- Hdr.stStart := Range[1];
- SetLength(Days, Hdr.cDayState);
- Hdr.prgDayState := @Days[0];
- SendMessage(Handle, CN_NOTIFY, Integer(Handle), Integer(@Hdr));
- // update day state
- SendMessage(Handle, MCM_SETDAYSTATE, Hdr.cDayState, Longint(Hdr.prgDayState))
-end;
-
-procedure TTntMonthCalendar.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntMonthCalendar.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntMonthCalendar.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntMonthCalendar.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-function TTntMonthCalendar.GetDate: TDate;
-begin
- Result := Trunc(inherited Date); { Fixes issue where Date always reflects time of saving dfm. }
-end;
-
-procedure TTntMonthCalendar.SetDate(const Value: TDate);
-begin
- inherited Date := Trunc(Value);
-end;
-
-procedure TTntMonthCalendar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntMonthCalendar.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntPageScroller }
-
-procedure TTntPageScroller.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle_ComCtl(Self, Params, WC_PAGESCROLLER);
-end;
-
-procedure TTntPageScroller.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntPageScroller.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntPageScroller.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntPageScroller.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntPageScroller.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntPageScroller.GetActionLinkClass: TControlActionLinkClass;
-begin
- 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 }
-
-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;
-
-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;
-
-{ TTntCustomStatusBar }
-
-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;
-
-function TTntCustomStatusBar.CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels};
-begin
- Result := TTntStatusPanels.Create(Self);
-end;
-
-function TTntCustomStatusBar.GetPanelClass: TStatusPanelClass;
-begin
- Result := TTntStatusPanel;
-end;
-
-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;
-
-{ TTntStatusBar }
-
-function TTntStatusBar.GetOnDrawPanel: TDrawPanelEvent;
-begin
- Result := TDrawPanelEvent(inherited OnDrawPanel);
-end;
-
-procedure TTntStatusBar.SetOnDrawPanel(const Value: TDrawPanelEvent);
-begin
- inherited OnDrawPanel := TCustomDrawPanelEvent(Value);
-end;
-
-{ 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);
- Owner.Owner.Added(LNode);
- 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;
-
-{ TTntTreeNodesEnumerator }
-
-constructor TTntTreeNodesEnumerator.Create(ATreeNodes: TTntTreeNodes);
-begin
- inherited Create;
- FIndex := -1;
- FTreeNodes := ATreeNodes;
-end;
-
-function TTntTreeNodesEnumerator.GetCurrent: TTntTreeNode;
-begin
- Result := FTreeNodes[FIndex];
-end;
-
-function TTntTreeNodesEnumerator.MoveNext: Boolean;
-begin
- Result := FIndex < FTreeNodes.Count - 1;
- if Result then
- Inc(FIndex);
-end;
-
-{ TTntTreeNodes }
-
-{$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} // verified against VCL source in Delphi 7
-type
- THackTreeNodes = class(TPersistent)
- protected
- FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
- FxxxUpdateCount: Integer;
- FNodeCache: TNodeCache;
- FReading: Boolean;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
-type
- THackTreeNodes = class(TPersistent)
- protected
- FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
- FxxxUpdateCount: Integer;
- FNodeCache: TNodeCache;
- FReading: Boolean;
- end;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
-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
- Result := AddNode(nil, Parent, S, nil, naAddChildFirst);
-end;
-
-function TTntTreeNodes.AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
- Ptr: Pointer): TTntTreeNode;
-begin
- Result := AddNode(nil, Parent, S, Ptr, naAddChildFirst);
-end;
-
-function TTntTreeNodes.AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
-begin
- Result := AddNode(nil, Parent, S, nil, naAddChild);
-end;
-
-function TTntTreeNodes.AddChildObject(Parent: TTntTreeNode; const S: WideString;
- Ptr: Pointer): TTntTreeNode;
-begin
- Result := AddNode(nil, Parent, S, Ptr, naAddChild);
-end;
-
-function TTntTreeNodes.AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
-begin
- Result := AddNode(nil, Sibling, S, nil, naAddFirst);
-end;
-
-function TTntTreeNodes.AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
- Ptr: Pointer): TTntTreeNode;
-begin
- Result := AddNode(nil, Sibling, S, Ptr, naAddFirst);
-end;
-
-function TTntTreeNodes.Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
-begin
- Result := AddNode(nil, Sibling, S, nil, naAdd);
-end;
-
-function TTntTreeNodes.AddObject(Sibling: TTntTreeNode; const S: WideString;
- Ptr: Pointer): TTntTreeNode;
-begin
- Result := AddNode(nil, Sibling, S, Ptr, naAdd);
-end;
-
-function TTntTreeNodes.Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
-begin
- Result := AddNode(nil, Sibling, S, nil, naInsert);
-end;
-
-function TTntTreeNodes.InsertObject(Sibling: TTntTreeNode; const S: WideString;
- Ptr: Pointer): TTntTreeNode;
-begin
- Result := AddNode(nil, Sibling, S, Ptr, naInsert);
-end;
-
-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;
-
-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.GetEnumerator: TTntTreeNodesEnumerator;
-begin
- Result := TTntTreeNodesEnumerator.Create(Self);
-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;
- THackTreeNodes(Self).FReading := True;
- try
- Clear;
- Stream.ReadBuffer(Count, SizeOf(Count));
- for I := 0 to Count - 1 do
- begin
- LNode := Add(nil, '');
- LNode.ReadData(Stream, @NodeInfo);
- Owner.Added(LNode);
- end;
- finally
- THackTreeNodes(Self).FReading := False;
- 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;
-
-{ _TntInternalCustomTreeView }
-
-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;
-
-{ 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 := Classes.MakeObjectInstance(EditWndProcW);
-end;
-
-destructor TTntCustomTreeView.Destroy;
-begin
- Destroying;
- Classes.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;
- if FSavedNodeText <> nil then begin
- FreeAndNil(FSavedNodeText);
- SortType := FSavedSortType;
- end;
-end;
-
-procedure TTntCustomTreeView.DestroyWnd;
-begin
- if (not (csDestroying in ComponentState)) then begin
- FSavedNodeText := TTntStringList.Create;
- FSavedSortType := SortType;
- SortType := stNone; // when recreating window, we are expecting items to come back in same order
- 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;
- 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.');
- TntLClass := TTntTreeNodeClass(LClass);
- Result := TntLClass.Create(inherited Items);
-end;
-
-function TTntCustomTreeView.CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes};
-begin
- Result := TTntTreeNodes.Create(Self);
-end;
-
-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;
-
-function TTntCustomTreeView.Wide_FindNextToSelect: TTntTreeNode;
-begin
- Result := FindNextToSelect;
-end;
-
-function TTntCustomTreeView.FindNextToSelect: TTntTreeNode;
-begin
- Result := Inherited_FindNextToSelect as TTntTreeNode;
-end;
-
-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;
-
-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;
-
-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;
- WStrLCopy(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
- else if Assigned(OnCancelEdit) then
- OnCancelEdit(Self, Node);
- 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
-
-finalization
- if Assigned(AIMM) then
- AIMM.Deactivate;
- if FRichEdit20Module <> 0 then
- FreeLibrary(FRichEdit20Module);
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntCompilers.inc b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntCompilers.inc deleted file mode 100644 index 5ab13901ba..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntCompilers.inc +++ /dev/null @@ -1,356 +0,0 @@ -//----------------------------------------------------------------------------------------------------------------------
-// Include file to determine which compiler is currently being used to build the project/component.
-// This file uses ideas from Brad Stowers DFS.inc file (www.delphifreestuff.com).
-//
-// Portions created by Mike Lischke are Copyright
-// (C) 1999-2002 Dipl. Ing. Mike Lischke. All Rights Reserved.
-//----------------------------------------------------------------------------------------------------------------------
-// The following symbols are defined:
-//
-// COMPILER_1 : Kylix/Delphi/BCB 1.x is the compiler.
-// COMPILER_1_UP : Kylix/Delphi/BCB 1.x or higher is the compiler.
-// COMPILER_2 : Kylix/Delphi 2.x or BCB 1.x is the compiler.
-// COMPILER_2_UP : Kylix/Delphi 2.x or higher, or BCB 1.x or higher is the compiler.
-// COMPILER_3 : Kylix/Delphi/BCB 3.x is the compiler.
-// COMPILER_3_UP : Kylix/Delphi/BCB 3.x or higher is the compiler.
-// COMPILER_4 : Kylix/Delphi/BCB 4.x is the compiler.
-// COMPILER_4_UP : Kylix/Delphi/BCB 4.x or higher is the compiler.
-// COMPILER_5 : Kylix/Delphi/BCB 5.x is the compiler.
-// COMPILER_5_UP : Kylix/Delphi/BCB 5.x or higher is the compiler.
-// COMPILER_6 : Kylix/Delphi/BCB 6.x is the compiler.
-// COMPILER_6_UP : Kylix/Delphi/BCB 6.x or higher is the compiler.
-// COMPILER_7 : Kylix/Delphi/BCB 7.x is the compiler.
-// COMPILER_7_UP : Kylix/Delphi/BCB 7.x or higher is the compiler.
-//
-// Only defined if Windows is the target:
-// CPPB : Any version of BCB is being used.
-// CPPB_1 : BCB v1.x is being used.
-// CPPB_3 : BCB v3.x is being used.
-// CPPB_3_UP : BCB v3.x or higher is being used.
-// CPPB_4 : BCB v4.x is being used.
-// CPPB_4_UP : BCB v4.x or higher is being used.
-// CPPB_5 : BCB v5.x is being used.
-// CPPB_5_UP : BCB v5.x or higher is being used.
-// CPPB_6 : BCB v6.x is being used.
-// CPPB_6_UP : BCB v6.x or higher is being used.
-//
-// Only defined if Windows is the target:
-// DELPHI : Any version of Delphi is being used.
-// DELPHI_1 : Delphi v1.x is being used.
-// DELPHI_2 : Delphi v2.x is being used.
-// DELPHI_2_UP : Delphi v2.x or higher is being used.
-// DELPHI_3 : Delphi v3.x is being used.
-// DELPHI_3_UP : Delphi v3.x or higher is being used.
-// DELPHI_4 : Delphi v4.x is being used.
-// DELPHI_4_UP : Delphi v4.x or higher is being used.
-// DELPHI_5 : Delphi v5.x is being used.
-// DELPHI_5_UP : Delphi v5.x or higher is being used.
-// DELPHI_6 : Delphi v6.x is being used.
-// DELPHI_6_UP : Delphi v6.x or higher is being used.
-// DELPHI_7 : Delphi v7.x is being used.
-// DELPHI_7_UP : Delphi v7.x or higher is being used.
-//
-// Only defined if Linux is the target:
-// KYLIX : Any version of Kylix is being used.
-// KYLIX_1 : Kylix 1.x is being used.
-// KYLIX_1_UP : Kylix 1.x or higher is being used.
-// KYLIX_2 : Kylix 2.x is being used.
-// KYLIX_2_UP : Kylix 2.x or higher is being used.
-// KYLIX_3 : Kylix 3.x is being used.
-// KYLIX_3_UP : Kylix 3.x or higher is being used.
-//
-// Only defined if Linux is the target:
-// QT_CLX : Trolltech's QT library is being used.
-//----------------------------------------------------------------------------------------------------------------------
-
-{$ifdef Win32}
-
- {$ifdef VER180}
- {$define COMPILER_10}
- {$define DELPHI}
- {$define DELPHI_10}
- {$endif}
-
- {$ifdef VER170}
- {$define COMPILER_9}
- {$define DELPHI}
- {$define DELPHI_9}
- {$endif}
-
- {$ifdef VER150}
- {$define COMPILER_7}
- {$define DELPHI}
- {$define DELPHI_7}
- {$endif}
-
- {$ifdef VER140}
- {$define COMPILER_6}
- {$ifdef BCB}
- {$define CPPB}
- {$define CPPB_6}
- {$else}
- {$define DELPHI}
- {$define DELPHI_6}
- {$endif}
- {$endif}
-
- {$ifdef VER130}
- {$define COMPILER_5}
- {$ifdef BCB}
- {$define CPPB}
- {$define CPPB_5}
- {$else}
- {$define DELPHI}
- {$define DELPHI_5}
- {$endif}
- {$endif}
-
- {$ifdef VER125}
- {$define COMPILER_4}
- {$define CPPB}
- {$define CPPB_4}
- {$endif}
-
- {$ifdef VER120}
- {$define COMPILER_4}
- {$define DELPHI}
- {$define DELPHI_4}
- {$endif}
-
- {$ifdef VER110}
- {$define COMPILER_3}
- {$define CPPB}
- {$define CPPB_3}
- {$endif}
-
- {$ifdef VER100}
- {$define COMPILER_3}
- {$define DELPHI}
- {$define DELPHI_3}
- {$endif}
-
- {$ifdef VER93}
- {$define COMPILER_2} // C++ Builder v1 compiler is really v2
- {$define CPPB}
- {$define CPPB_1}
- {$endif}
-
- {$ifdef VER90}
- {$define COMPILER_2}
- {$define DELPHI}
- {$define DELPHI_2}
- {$endif}
-
- {$ifdef VER80}
- {$define COMPILER_1}
- {$define DELPHI}
- {$define DELPHI_1}
- {$endif}
-
- {$ifdef DELPHI_2}
- {$define DELPHI_2_UP}
- {$endif}
-
- {$ifdef DELPHI_3}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$endif}
-
- {$ifdef DELPHI_4}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$endif}
-
- {$ifdef DELPHI_5}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$endif}
-
- {$ifdef DELPHI_6}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$define DELPHI_6_UP}
- {$endif}
-
- {$ifdef DELPHI_7}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$define DELPHI_6_UP}
- {$define DELPHI_7_UP}
- {$endif}
-
- {$ifdef DELPHI_9}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$define DELPHI_6_UP}
- {$define DELPHI_7_UP}
- {$define DELPHI_9_UP}
- {$endif}
-
- {$ifdef DELPHI_10}
- {$define DELPHI_2_UP}
- {$define DELPHI_3_UP}
- {$define DELPHI_4_UP}
- {$define DELPHI_5_UP}
- {$define DELPHI_6_UP}
- {$define DELPHI_7_UP}
- {$define DELPHI_9_UP}
- {$define DELPHI_10_UP}
- {$endif}
-
- {$ifdef CPPB_3}
- {$define CPPB_3_UP}
- {$endif}
-
- {$ifdef CPPB_4}
- {$define CPPB_3_UP}
- {$define CPPB_4_UP}
- {$endif}
-
- {$ifdef CPPB_5}
- {$define CPPB_3_UP}
- {$define CPPB_4_UP}
- {$define CPPB_5_UP}
- {$endif}
-
- {$ifdef CPPB_6}
- {$define CPPB_3_UP}
- {$define CPPB_4_UP}
- {$define CPPB_5_UP}
- {$define CPPB_6_UP}
- {$endif}
-
- {$ifdef CPPB_3_UP}
- // C++ Builder requires this if you use Delphi components in run-time packages.
- {$ObjExportAll On}
- {$endif}
-
-{$else (not Windows)}
- // Linux is the target
- {$define QT_CLX}
-
- {$define KYLIX}
- {$define KYLIX_1}
- {$define KYLIX_1_UP}
-
- {$ifdef VER150}
- {$define COMPILER_7}
- {$define KYLIX_3}
- {$endif}
-
- {$ifdef VER140}
- {$define COMPILER_6}
- {$define KYLIX_2}
- {$endif}
-
- {$ifdef KYLIX_2}
- {$define KYLIX_2_UP}
- {$endif}
-
- {$ifdef KYLIX_3}
- {$define KYLIX_2_UP}
- {$define KYLIX_3_UP}
- {$endif}
-
-{$endif}
-
-// Compiler defines common to all platforms.
-{$ifdef COMPILER_1}
- {$define COMPILER_1_UP}
-{$endif}
-
-{$ifdef COMPILER_2}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
-{$endif}
-
-{$ifdef COMPILER_3}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
-{$endif}
-
-{$ifdef COMPILER_4}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
-{$endif}
-
-{$ifdef COMPILER_5}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
-{$endif}
-
-{$ifdef COMPILER_6}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
- {$define COMPILER_6_UP}
-{$endif}
-
-{$ifdef COMPILER_7}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
- {$define COMPILER_6_UP}
- {$define COMPILER_7_UP}
-{$endif}
-
-{$ifdef COMPILER_9}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
- {$define COMPILER_6_UP}
- {$define COMPILER_7_UP}
- {$define COMPILER_9_UP}
-{$endif}
-
-{$ifdef COMPILER_10}
- {$define COMPILER_1_UP}
- {$define COMPILER_2_UP}
- {$define COMPILER_3_UP}
- {$define COMPILER_4_UP}
- {$define COMPILER_5_UP}
- {$define COMPILER_6_UP}
- {$define COMPILER_7_UP}
- {$define COMPILER_9_UP}
- {$define COMPILER_10_UP}
-{$endif}
-
-//----------------------------------------------------------------------------------------------------------------------
-
-{$ALIGN ON}
-{$BOOLEVAL OFF}
-
-{$ifdef COMPILER_7_UP}
- {$define THEME_7_UP} { Allows experimental theme support on pre-Delphi 7. }
-{$endif}
-
-{$IFDEF COMPILER_6_UP}
-{$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! }
-{$ENDIF}
-
-{$IFDEF COMPILER_7_UP}
-{$WARN UNSAFE_CODE OFF} { We are not going to be "safe"! }
-{$WARN UNSAFE_TYPE OFF}
-{$WARN UNSAFE_CAST OFF}
-{$ENDIF}
\ No newline at end of file diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntControls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntControls.pas deleted file mode 100644 index 55025ecdc2..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntControls.pas +++ /dev/null @@ -1,1099 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-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().
-
- One major reason this works is because the VCL only uses the ANSI version of
- SendMessage() -- SendMessageA(). If you call SendMessageA() on a UNICODE
- window, Windows deals with the ANSI/UNICODE conversion automatically. So
- for example, if the VCL sends WM_SETTEXT to a window using SendMessageA,
- Windows actually *expects* a PAnsiChar even if the target window is a UNICODE
- window. So caling SendMessageA with PChars causes no problems.
-
- A problem in the VCL has to do with the TControl.Perform() method. Perform()
- calls the window procedure directly and assumes an ANSI window. This is a
- problem if, for example, the VCL calls Perform(WM_SETTEXT, ...) passing in a
- PAnsiChar which eventually gets passed downto DefWindowProcW() which expects a PWideChar.
-
- This is the reason for SubClassUnicodeControl(). This procedure will subclass the
- Windows WndProc, and the TWinControl.WindowProc pointer. It will determine if the
- message came from Windows or if the WindowProc was called directly. It will then
- call SendMessageA() for Windows to perform proper conversion on certain text messages.
-
- Another problem has to do with TWinControl.DoKeyPress(). It is called from the WM_CHAR
- message. It casts the WideChar to an AnsiChar, and sends the resulting character to
- DefWindowProc. In order to avoid this, the DefWindowProc is subclassed as well. WindowProc
- will make a WM_CHAR message safe for ANSI handling code by converting the char code to
- #FF before passing it on. It stores the original WideChar in the .Unused field of TWMChar.
- The code #FF is converted back to the WideChar before passing onto DefWindowProc.
-}
-
-{
- Things to consider when designing new controls:
- 1) Check that a WideString Hint property is published.
- 2) If descending from TWinControl, override CreateWindowHandle().
- 3) If not descending from TWinControl, handle CM_HINTSHOW message.
- 4) Check to make sure that CN_CHAR, CN_SYSCHAR and CM_DIALOGCHAR are handled properly.
- 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 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
-
-{ TODO: Unicode enable .OnKeyPress event }
-
-uses
- Classes, Windows, Messages, Controls, Menus;
-
-
-{TNT-WARN TCaption}
-type TWideCaption = type WideString;
-
-// caption/text management
-function TntControl_IsCaptionStored(Control: TControl): Boolean;
-function TntControl_GetStoredText(Control: TControl; const Default: WideString): WideString;
-procedure TntControl_SetStoredText(Control: TControl; const Value: WideString);
-function TntControl_GetText(Control: TControl): WideString;
-procedure TntControl_SetText(Control: TControl; const Text: WideString);
-
-// hint management
-function TntControl_IsHintStored(Control: TControl): Boolean;
-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
- TTntCustomHintWindow = class(THintWindow)
- private
- FActivating: Boolean;
- FBlockPaint: Boolean;
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
-{$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;
- 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);
-procedure RestoreWMCharMsg(var Message: TMessage);
-function GetWideCharFromWMCharMsg(Message: TWMChar): WideChar;
-procedure SetWideCharForWMCharMsg(var Message: TWMChar; Ch: WideChar);
-
-// register/create window
-procedure SubClassUnicodeControl(Control: TWinControl; Params_Caption: PAnsiChar; IDEWindow: Boolean = False);
-procedure RegisterUnicodeClass(Params: TCreateParams; out WideWinClassName: WideString; IDEWindow: Boolean = False);
-procedure CreateUnicodeHandle(Control: TWinControl; const Params: TCreateParams;
- const SubClass: WideString; IDEWindow: Boolean = False);
-procedure ReCreateUnicodeWnd(Control: TWinControl; Subclass: WideString; IDEWindow: Boolean = False);
-
-type
- IWideCustomListControl = interface
- ['{C1801F41-51E9-4DB5-8DB8-58AC86698C2E}']
- procedure AddItem(const Item: WideString; AObject: TObject);
- end;
-
-procedure WideListControl_AddItem(Control: TCustomListControl; const Item: WideString; AObject: TObject);
-
-var
- _IsShellProgramming: Boolean = False;
-
-var
- TNT_WM_DESTROY: Cardinal;
-
-implementation
-
-uses
- ActnList, Forms, SysUtils, Contnrs,
- TntGraphics, TntWindows, TntClasses, TntMenus, TntSysUtils;
-
-type
- TAccessControl = class(TControl);
- TAccessWinControl = class(TWinControl);
- TAccessControlActionLink = class(TControlActionLink{TNT-ALLOW TControlActionLink});
-
-//----------------------------------------------- WIDE CAPTION HOLDERS --------
-
-{ TWideControlHelper }
-
-var
- WideControlHelpers: TComponentList = nil;
-
-type
- TWideControlHelper = class(TWideComponentHelper)
- private
- FControl: TControl;
- FWideCaption: WideString;
- FWideHint: WideString;
- procedure SetAnsiText(const Value: AnsiString);
- procedure SetAnsiHint(const Value: AnsiString);
- public
- constructor Create(AOwner: TControl); reintroduce;
- property WideCaption: WideString read FWideCaption;
- property WideHint: WideString read FWideHint;
- end;
-
-constructor TWideControlHelper.Create(AOwner: TControl);
-begin
- inherited CreateHelper(AOwner, WideControlHelpers);
- FControl := AOwner;
-end;
-
-procedure TWideControlHelper.SetAnsiText(const Value: AnsiString);
-begin
- TAccessControl(FControl).Text := Value;
-end;
-
-procedure TWideControlHelper.SetAnsiHint(const Value: AnsiString);
-begin
- FControl.Hint := Value;
-end;
-
-function FindWideControlHelper(Control: TControl; CreateIfNotFound: Boolean = True): TWideControlHelper;
-begin
- Result := TWideControlHelper(FindWideComponentHelper(WideControlHelpers, Control));
- if (Result = nil) and CreateIfNotFound then
- Result := TWideControlHelper.Create(Control);
-end;
-
-//----------------------------------------------- GET/SET WINDOW CAPTION/HINT -------------
-
-function TntControl_IsCaptionStored(Control: TControl): Boolean;
-begin
- with TAccessControl(Control) do
- Result := (ActionLink = nil) or not TAccessControlActionLink(ActionLink).IsCaptionLinked;
-end;
-
-function TntControl_GetStoredText(Control: TControl; const Default: WideString): WideString;
-var
- WideControlHelper: TWideControlHelper;
-begin
- WideControlHelper := FindWideControlHelper(Control, False);
- if WideControlHelper <> nil then
- Result := WideControlHelper.WideCaption
- else
- Result := Default;
-end;
-
-procedure TntControl_SetStoredText(Control: TControl; const Value: WideString);
-begin
- FindWideControlHelper(Control).FWideCaption := Value;
- TAccessControl(Control).Text := Value;
-end;
-
-function TntControl_GetText(Control: TControl): WideString;
-var
- WideControlHelper: TWideControlHelper;
-begin
- 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
- WideControlHelper := FindWideControlHelper(Control, False);
- if WideControlHelper = nil then
- Result := TAccessControl(Control).Text
- else
- Result := GetSyncedWideString(WideControlHelper.FWideCaption, TAccessControl(Control).Text);
- end else if (not TWinControl(Control).HandleAllocated) then begin
- // NO HANDLE
- Result := TntControl_GetStoredText(Control, TAccessControl(Control).Text)
- end else begin
- // UNICODE & HANDLE
- SetLength(Result, GetWindowTextLengthW(TWinControl(Control).Handle) + 1);
- GetWindowTextW(TWinControl(Control).Handle, PWideChar(Result), Length(Result));
- SetLength(Result, Length(Result) - 1);
- end;
-end;
-
-procedure TntControl_SetText(Control: TControl; const Text: WideString);
-begin
- 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 FindWideControlHelper(Control) do
- SetSyncedWideString(Text, FWideCaption, TAccessControl(Control).Text, SetAnsiText)
- end else if (not TWinControl(Control).HandleAllocated) then begin
- // NO HANDLE
- TntControl_SetStoredText(Control, Text);
- end else if TntControl_GetText(Control) <> Text then begin
- // UNICODE & HANDLE
- Tnt_SetWindowTextW(TWinControl(Control).Handle, PWideChar(Text));
- Control.Perform(CM_TEXTCHANGED, 0, 0);
- end;
-end;
-
-// hint management -----------------------------------------------------------------------
-
-function TntControl_IsHintStored(Control: TControl): Boolean;
-begin
- with TAccessControl(Control) do
- Result := (ActionLink = nil) or not TAccessControlActionLink(ActionLink).IsHintLinked;
-end;
-
-function TntControl_GetHint(Control: TControl): WideString;
-var
- WideControlHelper: TWideControlHelper;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := Control.Hint
- else begin
- WideControlHelper := FindWideControlHelper(Control, False);
- if WideControlHelper <> nil then
- Result := GetSyncedWideString(WideControlHelper.FWideHint, Control.Hint)
- else
- Result := Control.Hint;
- end;
-end;
-
-procedure TntControl_SetHint(Control: TControl; const Value: WideString);
-begin
- if (not Win32PlatformIsUnicode) then
- Control.Hint := Value
- else
- with FindWideControlHelper(Control) do
- SetSyncedWideString(Value, FWideHint, Control.Hint, SetAnsiHint);
-end;
-
-function WideGetHint(Control: TControl): WideString;
-begin
- while Control <> nil do
- if TntControl_GetHint(Control) = '' then
- Control := Control.Parent
- else
- begin
- Result := TntControl_GetHint(Control);
- Exit;
- end;
- Result := '';
-end;
-
-function WideGetShortHint(const Hint: WideString): WideString;
-var
- I: Integer;
-begin
- I := Pos('|', Hint);
- if I = 0 then
- Result := Hint else
- Result := Copy(Hint, 1, I - 1);
-end;
-
-function WideGetLongHint(const Hint: WideString): WideString;
-var
- I: Integer;
-begin
- I := Pos('|', Hint);
- if I = 0 then
- Result := Hint else
- Result := Copy(Hint, I + 1, Maxint);
-end;
-
-//----------------------------------------------------------------------------------------
-
-var UnicodeCreationControl: TWinControl = nil;
-
-function IsUnicodeCreationControl(Handle: HWND): Boolean;
-begin
- Result := (UnicodeCreationControl <> nil)
- and (UnicodeCreationControl.HandleAllocated)
- and (UnicodeCreationControl.Handle = Handle);
-end;
-
-function WMNotifyFormatResult(FromHandle: HWND): Integer;
-begin
- if Win32PlatformIsUnicode
- and (IsWindowUnicode(FromHandle) or IsUnicodeCreationControl(FromHandle)) then
- Result := NFR_UNICODE
- else
- Result := NFR_ANSI;
-end;
-
-function IsTextMessage(Msg: UINT): Boolean;
-begin
- // WM_CHAR is omitted because of the special handling it receives
- Result := (Msg = WM_SETTEXT)
- or (Msg = WM_GETTEXT)
- or (Msg = WM_GETTEXTLENGTH);
-end;
-
-const
- ANSI_UNICODE_HOLDER = $FF;
-
-procedure MakeWMCharMsgSafeForAnsi(var Message: TMessage);
-begin
- with TWMChar(Message) do begin
- Assert(Msg = WM_CHAR);
- 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;
- end;
- end;
-end;
-
-procedure RestoreWMCharMsg(var Message: TMessage);
-begin
- with TWMChar(Message) do begin
- Assert(Message.Msg = WM_CHAR);
- if (Unused > 0)
- and (CharCode = ANSI_UNICODE_HOLDER) then
- CharCode := Unused;
- Unused := 0;
- end;
-end;
-
-function GetWideCharFromWMCharMsg(Message: TWMChar): WideChar;
-begin
- if (Message.CharCode = ANSI_UNICODE_HOLDER)
- and (Message.Unused <> 0) then
- Result := WideChar(Message.Unused)
- else
- Result := WideChar(Message.CharCode);
-end;
-
-procedure SetWideCharForWMCharMsg(var Message: TWMChar; Ch: WideChar);
-begin
- Message.CharCode := Word(Ch);
- Message.Unused := 0;
- MakeWMCharMsgSafeForAnsi(TMessage(Message));
-end;
-
-//-----------------------------------------------------------------------------------
-type
- TWinControlTrap = class(TComponent)
- private
- WinControl_ObjectInstance: Pointer;
- ObjectInstance: Pointer;
- DefObjectInstance: Pointer;
- function IsInSubclassChain(Control: TWinControl): Boolean;
- procedure SubClassWindowProc;
- private
- FControl: TAccessWinControl;
- Handle: THandle;
- PrevWin32Proc: Pointer;
- PrevDefWin32Proc: Pointer;
- PrevWindowProc: TWndMethod;
- private
- LastWin32Msg: UINT;
- Win32ProcLevel: Integer;
- IDEWindow: Boolean;
- DestroyTrap: Boolean;
- TestForNull: Boolean;
- FoundNull: Boolean;
- {$IFDEF TNT_VERIFY_WINDOWPROC}
- LastVerifiedWindowProc: TWndMethod;
- {$ENDIF}
- procedure Win32Proc(var Message: TMessage);
- procedure DefWin32Proc(var Message: TMessage);
- procedure WindowProc(var Message: TMessage);
- private
- procedure SubClassControl(Params_Caption: PAnsiChar);
- procedure UnSubClassUnicodeControl;
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- end;
-
-constructor TWinControlTrap.Create(AOwner: TComponent);
-begin
- FControl := TAccessWinControl(AOwner as TWinControl);
- inherited Create(nil);
- FControl.FreeNotification(Self);
-
- WinControl_ObjectInstance := Classes.MakeObjectInstance(FControl.MainWndProc);
- ObjectInstance := Classes.MakeObjectInstance(Win32Proc);
- DefObjectInstance := Classes.MakeObjectInstance(DefWin32Proc);
-end;
-
-destructor TWinControlTrap.Destroy;
-begin
- Classes.FreeObjectInstance(ObjectInstance);
- Classes.FreeObjectInstance(DefObjectInstance);
- Classes.FreeObjectInstance(WinControl_ObjectInstance);
- inherited;
-end;
-
-procedure TWinControlTrap.Notification(AComponent: TComponent; Operation: TOperation);
-begin
- inherited;
- if (AComponent = FControl) and (Operation = opRemove) then begin
- FControl := nil;
- if Win32ProcLevel = 0 then
- Free
- else
- DestroyTrap := True;
- end;
-end;
-
-procedure TWinControlTrap.SubClassWindowProc;
-begin
- if not IsInSubclassChain(FControl) then begin
- PrevWindowProc := FControl.WindowProc;
- FControl.WindowProc := Self.WindowProc;
- end;
- {$IFDEF TNT_VERIFY_WINDOWPROC}
- LastVerifiedWindowProc := FControl.WindowProc;
- {$ENDIF}
-end;
-
-procedure TWinControlTrap.SubClassControl(Params_Caption: PAnsiChar);
-begin
- // initialize trap object
- Handle := FControl.Handle;
- PrevWin32Proc := Pointer(GetWindowLongW(FControl.Handle, GWL_WNDPROC));
- PrevDefWin32Proc := FControl.DefWndProc;
-
- // subclass Window Procedures
- SetWindowLongW(FControl.Handle, GWL_WNDPROC, Integer(ObjectInstance));
- FControl.DefWndProc := DefObjectInstance;
- SubClassWindowProc;
-
- // For some reason, caption gets garbled after calling SetWindowLongW(.., GWL_WNDPROC).
- TntControl_SetText(FControl, TntControl_GetStoredText(FControl, Params_Caption));
-end;
-
-function SameWndMethod(A, B: TWndMethod): Boolean;
-begin
- Result := @A = @B;
-end;
-
-var
- PendingRecreateWndTrapList: TComponentList = nil;
-
-procedure TWinControlTrap.UnSubClassUnicodeControl;
-begin
- // remember caption for future window creation
- if not (csDestroying in FControl.ComponentState) then
- TntControl_SetStoredText(FControl, TntControl_GetText(FControl));
-
- // restore window procs (restore WindowProc only if we are still the direct subclass)
- if SameWndMethod(FControl.WindowProc, Self.WindowProc) then
- FControl.WindowProc := PrevWindowProc;
- TAccessWinControl(FControl).DefWndProc := PrevDefWin32Proc;
- SetWindowLongW(FControl.Handle, GWL_WNDPROC, Integer(PrevWin32Proc));
-
- if IDEWindow then
- DestroyTrap := True
- else if not (csDestroying in FControl.ComponentState) then
- // control not being destroyed, probably recreating window
- 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
- 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;
- finally
- Dec(Win32ProcLevel);
- end;
- if (Win32ProcLevel = 0) and (DestroyTrap) then
- Free;
- end else if (Message.Msg = WM_DESTROY) or (Message.Msg = TNT_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
- Result := WMNotifyFormatResult(HWND(Message.wParam))
- else begin
- if (Msg = WM_CHAR) then begin
- RestoreWMCharMsg(Message)
- end;
- 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 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;
-
-procedure ProcessCMHintShowMsg(var Message: TMessage);
-begin
- if Win32PlatformIsUnicode then begin
- with TCMHintShow(Message) do begin
- if (HintInfo.HintWindowClass = THintWindow)
- or (HintInfo.HintWindowClass.InheritsFrom(TTntCustomHintWindow)) then begin
- if (HintInfo.HintWindowClass = THintWindow) then
- HintInfo.HintWindowClass := TTntCustomHintWindow;
- HintInfo.HintData := HintInfo;
- HintInfo.HintStr := WideGetShortHint(WideGetHint(HintInfo.HintControl));
- end;
- end;
- end;
-end;
-
-function TWinControlTrap.IsInSubclassChain(Control: TWinControl): Boolean;
-var
- Message: TMessage;
-begin
- if SameWndMethod(Control.WindowProc, TAccessWinControl(Control).WndProc) then
- Result := False { no subclassing }
- else if SameWndMethod(Control.WindowProc, Self.WindowProc) then
- Result := True { directly subclassed }
- else begin
- TestForNull := True;
- FoundNull := False;
- ZeroMemory(@Message, SizeOf(Message));
- Message.Msg := WM_NULL;
- Control.WindowProc(Message);
- Result := FoundNull; { indirectly subclassed }
- end;
-end;
-
-procedure TWinControlTrap.WindowProc(var Message: TMessage);
-var
- CameFromWindows: Boolean;
-begin
- if TestForNull and (Message.Msg = WM_NULL) then
- FoundNull := True;
-
- if (not FControl.HandleAllocated) then
- FControl.WndProc(Message)
- else begin
- CameFromWindows := LastWin32Msg <> WM_NULL;
- LastWin32Msg := WM_NULL;
- with Message do begin
- if Msg = CM_HINTSHOW then
- ProcessCMHintShowMsg(Message);
- if (not CameFromWindows)
- and (IsTextMessage(Msg)) then
- Result := SendMessageA(Handle, Msg, wParam, lParam)
- else begin
- if (Msg = WM_CHAR) then begin
- MakeWMCharMsgSafeForAnsi(Message);
- end;
- PrevWindowProc(Message)
- end;
- if (Msg = TNT_WM_DESTROY) then
- UnSubClassUnicodeControl; {The reason for doing this in DefWin32Proc is because in D9, TWinControl.WMDestroy() does a perform(WM_TEXT) operation. }
- end;
- end;
-end;
-
-//----------------------------------------------------------------------------------
-
-function FindOrCreateWinControlTrap(Control: TWinControl): TWinControlTrap;
-var
- i: integer;
-begin
- // find or create trap object
- Result := nil;
- for i := PendingRecreateWndTrapList.Count - 1 downto 0 do begin
- if TWinControlTrap(PendingRecreateWndTrapList[i]).FControl = Control then begin
- Result := TWinControlTrap(PendingRecreateWndTrapList[i]);
- PendingRecreateWndTrapList.Delete(i);
- break; { found it }
- end;
- end;
- if Result = nil then
- Result := TWinControlTrap.Create(Control);
-end;
-
-procedure SubClassUnicodeControl(Control: TWinControl; Params_Caption: PAnsiChar; IDEWindow: Boolean = False);
-var
- WinControlTrap: TWinControlTrap;
-begin
- if not IsWindowUnicode(Control.Handle) then
- raise ETntInternalError.Create('Internal Error: SubClassUnicodeControl.Control is not Unicode.');
-
- WinControlTrap := FindOrCreateWinControlTrap(Control);
- WinControlTrap.SubClassControl(Params_Caption);
- WinControlTrap.IDEWindow := IDEWindow;
-end;
-
-
-//----------------------------------------------- CREATE/DESTROY UNICODE HANDLE
-
-var
- WindowAtom: TAtom;
- ControlAtom: TAtom;
- WindowAtomString: AnsiString;
- ControlAtomString: AnsiString;
-
-type
- TWndProc = function(HWindow: HWnd; Message, WParam, LParam: Longint): Longint; stdcall;
-
-function InitWndProcW(HWindow: HWnd; Message, WParam, LParam: Longint): Longint; stdcall;
-
- function GetObjectInstance(Control: TWinControl): Pointer;
- var
- WinControlTrap: TWinControlTrap;
- begin
- WinControlTrap := FindOrCreateWinControlTrap(Control);
- PendingRecreateWndTrapList.Add(WinControlTrap);
- Result := WinControlTrap.WinControl_ObjectInstance;
- end;
-
-var
- ObjectInstance: Pointer;
-begin
- TAccessWinControl(CreationControl).WindowHandle := HWindow;
- ObjectInstance := GetObjectInstance(CreationControl);
- {Controls.InitWndProc converts control to ANSI here by calling SetWindowLongA()!}
- 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, Integer(HWindow));
- SetProp(HWindow, MakeIntAtom(ControlAtom), THandle(CreationControl));
- SetProp(HWindow, MakeIntAtom(WindowAtom), THandle(CreationControl));
- CreationControl := nil;
- Result := TWndProc(ObjectInstance)(HWindow, Message, WParam, lParam);
-end;
-
-procedure RegisterUnicodeClass(Params: TCreateParams; out WideWinClassName: WideString; IDEWindow: Boolean = False);
-const
- UNICODE_CLASS_EXT = '.UnicodeClass';
-var
- TempClass: TWndClassW;
- WideClass: TWndClassW;
- ClassRegistered: Boolean;
- InitialProc: TFNWndProc;
-begin
- if IDEWindow then
- InitialProc := @InitWndProc
- else
- InitialProc := @InitWndProcW;
-
- with Params do begin
- WideWinClassName := WinClassName + UNICODE_CLASS_EXT;
- ClassRegistered := GetClassInfoW(hInstance, PWideChar(WideWinClassName), TempClass);
- if (not ClassRegistered) or (TempClass.lpfnWndProc <> InitialProc)
- then begin
- 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));
- end;
- WideClass.lpszClassName := PWideChar(WideWinClassName);
-
- // Register the UNICODE class
- if RegisterClassW(WideClass) = 0 then RaiseLastOSError;
- end;
- end;
-end;
-
-procedure CreateUnicodeHandle(Control: TWinControl; const Params: TCreateParams;
- const SubClass: WideString; IDEWindow: Boolean = False);
-var
- TempSubClass: TWndClassW;
- WideWinClassName: WideString;
- Handle: THandle;
-begin
- if (not Win32PlatformIsUnicode) then begin
- with Params do
- TAccessWinControl(Control).WindowHandle := CreateWindowEx(ExStyle, WinClassName,
- Caption, Style, X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
- end else begin
- // SubClass the unicode version of this control by getting the correct DefWndProc
- if (SubClass <> '')
- and GetClassInfoW(Params.WindowClass.hInstance, PWideChar(SubClass), TempSubClass) then
- TAccessWinControl(Control).DefWndProc := TempSubClass.lpfnWndProc
- else
- TAccessWinControl(Control).DefWndProc := @DefWindowProcW;
-
- // make sure Unicode window class is registered
- RegisterUnicodeClass(Params, WideWinClassName, IDEWindow);
-
- // Create UNICODE window handle
- UnicodeCreationControl := Control;
- try
- with Params do
- Handle := CreateWindowExW(ExStyle, PWideChar(WideWinClassName), nil,
- Style, X, Y, Width, Height, WndParent, 0, hInstance, Param);
- if Handle = 0 then
- RaiseLastOSError;
- TAccessWinControl(Control).WindowHandle := Handle;
- if IDEWindow then
- SetWindowLongW(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_WNDPROC));
- finally
- UnicodeCreationControl := nil;
- end;
-
- SubClassUnicodeControl(Control, Params.Caption, IDEWindow);
- end;
-end;
-
-procedure ReCreateUnicodeWnd(Control: TWinControl; Subclass: WideString; IDEWindow: Boolean = False);
-var
- WasFocused: Boolean;
- Params: TCreateParams;
-begin
- with TAccessWinControl(Control) do begin
- WasFocused := Focused;
- DestroyHandle;
- CreateParams(Params);
- CreationControl := Control;
- CreateUnicodeHandle(Control, Params, SubClass, IDEWindow);
- StrDispose{TNT-ALLOW StrDispose}(WindowText);
- WindowText := nil;
- Perform(WM_SETFONT, Integer(Font.Handle), 1);
- if AutoSize then AdjustSize;
- UpdateControlState;
- if WasFocused and (WindowHandle <> 0) then Windows.SetFocus(WindowHandle);
- end;
-end;
-
-{ 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(TTntCustomHintWindow));
- except
- Result := False;
- end;
-end;
-
-function ExtractTntHintCaption(AData: Pointer): WideString;
-var
- Control: TControl;
- WideHint: WideString;
- AnsiHintWithShortCut: AnsiString;
- ShortCut: TShortCut;
-begin
- Result := PHintInfo(AData).HintStr;
- if Result <> '' then begin
- Control := PHintInfo(AData).HintControl;
- WideHint := WideGetShortHint(WideGetHint(Control));
- if (AnsiString(WideHint) = PHintInfo(AData).HintStr) then
- Result := WideHint
- else if Application.HintShortCuts and (Control <> nil)
- and (Control.Action is TCustomAction{TNT-ALLOW TCustomAction}) then begin
- ShortCut := TCustomAction{TNT-ALLOW TCustomAction}(Control.Action).ShortCut;
- if (ShortCut <> scNone) then
- begin
- AnsiHintWithShortCut := Format{TNT-ALLOW Format}('%s (%s)', [WideHint, ShortCutToText{TNT-ALLOW ShortCutToText}(ShortCut)]);
- if AnsiHintWithShortCut = PHintInfo(AData).HintStr then
- Result := WideFormat('%s (%s)', [WideHint, WideShortCutToText(ShortCut)]);
- end;
- end;
- end;
-end;
-
-{ TTntCustomHintWindow }
-
-procedure TTntCustomHintWindow.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-{$IFNDEF COMPILER_7_UP}
-procedure TTntCustomHintWindow.CreateParams(var Params: TCreateParams);
-const
- CS_DROPSHADOW = $00020000;
-begin
- inherited;
- if Win32PlatformIsXP then { Enable drop shadow effect on Windows XP and later. }
- Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
-end;
-{$ENDIF}
-
-function TTntCustomHintWindow.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntCustomHintWindow.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntCustomHintWindow.Paint;
-var
- R: TRect;
-begin
- if FBlockPaint then
- exit;
- if (not Win32PlatformIsUnicode) then
- inherited
- else begin
- R := ClientRect;
- Inc(R.Left, 2);
- Inc(R.Top, 2);
- Canvas.Font.Color := Screen.HintFont.Color;
- Tnt_DrawTextW(Canvas.Handle, PWideChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
- DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
- end;
-end;
-
-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);
-var
- SaveActivating: Boolean;
-begin
- SaveActivating := FActivating;
- try
- FActivating := True;
- inherited;
- finally
- FActivating := SaveActivating;
- end;
-end;
-
-procedure TTntCustomHintWindow.ActivateHintData(Rect: TRect; const AHint: AnsiString; AData: Pointer);
-var
- SaveActivating: Boolean;
-begin
- if (not Win32PlatformIsUnicode)
- or (not DataPointsToHintInfoForTnt(AData)) then
- inherited
- else begin
- FBlockPaint := True;
- try
- SaveActivating := FActivating;
- try
- FActivating := True;
- inherited;
- Caption := ExtractTntHintCaption(AData);
- finally
- FActivating := SaveActivating;
- end;
- finally
- FBlockPaint := False;
- end;
- Invalidate;
- end;
-end;
-
-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
- if (not Win32PlatformIsUnicode)
- or (not DataPointsToHintInfoForTnt(AData)) then
- Result := inherited CalcHintRect(MaxWidth, AHint, AData)
- else begin
- WideHintStr := ExtractTntHintCaption(AData);
- Result := TntHintWindow_CalcHintRect(Self, MaxWidth, WideHintStr);
- end;
-end;
-
-{ TTntHintWindow }
-
-procedure TTntHintWindow.ActivateHint(Rect: TRect; const AHint: WideString);
-var
- SaveActivating: Boolean;
-begin
- SaveActivating := FActivating;
- try
- FActivating := True;
- Caption := AHint;
- inherited ActivateHint(Rect, AHint);
- finally
- FActivating := SaveActivating;
- end;
-end;
-
-procedure TTntHintWindow.ActivateHintData(Rect: TRect; const AHint: WideString; AData: Pointer);
-var
- SaveActivating: Boolean;
-begin
- FBlockPaint := True;
- try
- SaveActivating := FActivating;
- try
- FActivating := True;
- Caption := AHint;
- inherited ActivateHintData(Rect, AHint, AData);
- finally
- FActivating := SaveActivating;
- 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;
-
-procedure WideListControl_AddItem(Control: TCustomListControl; const Item: WideString; AObject: TObject);
-var
- WideControl: IWideCustomListControl;
-begin
- if Control.GetInterface(IWideCustomListControl, WideControl) then
- WideControl.AddItem(Item, AObject)
- else
- Control.AddItem(Item, AObject);
-end;
-
-procedure InitControls;
-
- procedure InitAtomStrings_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', [Controls_HInstance, GetCurrentThreadID]);
- end;
-
- {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
- procedure InitAtomStrings;
- begin
- InitAtomStrings_D6_D7_D9;
- end;
- {$ENDIF}
- {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
- procedure InitAtomStrings;
- begin
- InitAtomStrings_D6_D7_D9;
- end;
- {$ENDIF}
- {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
- procedure InitAtomStrings;
- begin
- InitAtomStrings_D6_D7_D9;
- end;
- {$ENDIF}
- {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
- procedure InitAtomStrings;
- begin
- InitAtomStrings_D6_D7_D9;
- end;
- {$ENDIF}
-
-begin
- InitAtomStrings;
- WindowAtom := WinCheckH(GlobalAddAtom(PAnsiChar(WindowAtomString)));
- ControlAtom := WinCheckH(GlobalAddAtom(PAnsiChar(ControlAtomString)));
-end;
-
-initialization
- TNT_WM_DESTROY := RegisterWindowMessage('TntUnicodeVcl.DestroyWindow');
- WideControlHelpers := TComponentList.Create(True);
- PendingRecreateWndTrapList := TComponentList.Create(False);
- InitControls;
-
-finalization
- GlobalDeleteAtom(ControlAtom);
- GlobalDeleteAtom(WindowAtom);
- FreeAndNil(WideControlHelpers);
- FreeAndNil(PendingRecreateWndTrapList);
- Finalized := True;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDB.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDB.pas deleted file mode 100644 index 4490bd12e2..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDB.pas +++ /dev/null @@ -1,900 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntDB;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, DB;
-
-type
-{TNT-WARN TDateTimeField}
- TTntDateTimeField = class(TDateTimeField{TNT-ALLOW TDateTimeField})
- protected
- procedure SetAsString(const Value: AnsiString); override;
- end;
-
-{TNT-WARN TDateField}
- TTntDateField = class(TDateField{TNT-ALLOW TDateField})
- protected
- procedure SetAsString(const Value: AnsiString); override;
- end;
-
-{TNT-WARN TTimeField}
- TTntTimeField = class(TTimeField{TNT-ALLOW TTimeField})
- protected
- procedure SetAsString(const Value: AnsiString); override;
- end;
-
- TFieldGetWideTextEvent = procedure(Sender: TField; var Text: WideString;
- DoDisplayText: Boolean) of object;
- TFieldSetWideTextEvent = procedure(Sender: TField; const Text: WideString) of object;
-
- IWideStringField = interface
- ['{679C5F1A-4356-4696-A8F3-9C7C6970A9F6}']
- {$IFNDEF COMPILER_10_UP}
- function GetAsWideString: WideString;
- procedure SetAsWideString(const Value: WideString);
- {$ENDIF}
- function GetWideDisplayText: WideString;
- function GetWideEditText: WideString;
- procedure SetWideEditText(const Value: WideString);
- //--
- {$IFNDEF COMPILER_10_UP}
- property AsWideString: WideString read GetAsWideString write SetAsWideString{inherited};
- {$ENDIF}
- property WideDisplayText: WideString read GetWideDisplayText;
- property WideText: WideString read GetWideEditText write SetWideEditText;
- end;
-
-{TNT-WARN TWideStringField}
- TTntWideStringField = class(TWideStringField{TNT-ALLOW TWideStringField}, IWideStringField)
- private
- FOnGetText: TFieldGetWideTextEvent;
- FOnSetText: TFieldSetWideTextEvent;
- procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
- procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
- procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
- procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
- function GetWideDisplayText: WideString;
- function GetWideEditText: WideString;
- procedure SetWideEditText(const Value: WideString);
- protected
- {$IFNDEF COMPILER_10_UP}
- function GetAsWideString: WideString;
- {$ENDIF}
- public
- property Value: WideString read GetAsWideString write SetAsWideString;
- property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
- property Text: WideString read GetWideEditText write SetWideEditText;
- {$IFNDEF COMPILER_10_UP}
- property AsWideString: WideString read GetAsWideString write SetAsWideString;
- {$ENDIF}
- property WideDisplayText: WideString read GetWideDisplayText;
- property WideText: WideString read GetWideEditText write SetWideEditText;
- published
- property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
- property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
- end;
-
- TTntStringFieldEncodingMode = (emNone, emUTF8, emUTF7, emFixedCodePage, emFixedCodePage_Safe);
-
- //-------------------------------------------------------------------------------------------
- // Comments on TTntStringFieldEncodingMode:
- //
- // emNone - Works like TStringField.
- // emUTF8 - Should work well most databases.
- // emUTF7 - Almost guaranteed to work with any database. Wasteful in database space.
- // emFixedCodePage - Only tested it with Access 97, which doesn't support Unicode.
- // emFixedCodePage_Safe - Like emFixedCodePage but uses char<=#128. Wasteful in database space.
- //
- // Only emUTF8 and emUTF7 fully support Unicode.
- //-------------------------------------------------------------------------------------------
-
- TTntStringFieldCodePageEnum = (fcpOther,
- fcpThai, fcpJapanese, fcpSimplifiedChinese, fcpTraditionalChinese, fcpKorean,
- fcpCentralEuropean, fcpCyrillic, fcpLatinWestern, fcpGreek, fcpTurkish,
- fcpHebrew, fcpArabic, fcpBaltic, fcpVietnamese);
-
-const
- TntStringFieldCodePageEnumMap: array[TTntStringFieldCodePageEnum] of Word = (0,
- 874, 932, 936, 950, 949,
- 1250, 1251, 1252, 1253, 1254,
- 1255, 1256, 1257, 1258);
-
-type
-{TNT-WARN TStringField}
- TTntStringField = class(TStringField{TNT-ALLOW TStringField},IWideStringField)
- private
- FOnGetText: TFieldGetWideTextEvent;
- FOnSetText: TFieldSetWideTextEvent;
- FEncodingMode: TTntStringFieldEncodingMode;
- FFixedCodePage: Word;
- FRawVariantAccess: Boolean;
- procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
- procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
- procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
- procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
- function GetWideDisplayText: WideString;
- function GetWideEditText: WideString;
- procedure SetWideEditText(const Value: WideString);
- function GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
- procedure SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
- function IsFixedCodePageStored: Boolean;
- protected
- {$IFDEF COMPILER_10_UP}
- function GetAsWideString: WideString; override;
- procedure SetAsWideString(const Value: WideString); override;
- {$ELSE}
- function GetAsWideString: WideString; virtual;
- procedure SetAsWideString(const Value: WideString); virtual;
- {$ENDIF}
- function GetAsVariant: Variant; override;
- procedure SetVarValue(const Value: Variant); override;
- function GetAsString: string{TNT-ALLOW string}; override;
- procedure SetAsString(const Value: string{TNT-ALLOW string}); override;
- public
- constructor Create(AOwner: TComponent); override;
- property Value: WideString read GetAsWideString write SetAsWideString;
- property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
- property Text: WideString read GetWideEditText write SetWideEditText;
- {$IFNDEF COMPILER_10_UP}
- property AsWideString: WideString read GetAsWideString write SetAsWideString;
- {$ENDIF}
- property WideDisplayText: WideString read GetWideDisplayText;
- property WideText: WideString read GetWideEditText write SetWideEditText;
- published
- property EncodingMode: TTntStringFieldEncodingMode read FEncodingMode write FEncodingMode default emUTF8;
- property FixedCodePageEnum: TTntStringFieldCodePageEnum read GetFixedCodePageEnum write SetFixedCodePageEnum stored False;
- property FixedCodePage: Word read FFixedCodePage write FFixedCodePage stored IsFixedCodePageStored;
- property RawVariantAccess: Boolean read FRawVariantAccess write FRawVariantAccess default False;
- property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
- property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
- end;
-
-//======================
-type
-{TNT-WARN TMemoField}
- TTntMemoField = class(TMemoField{TNT-ALLOW TMemoField}, IWideStringField)
- private
- FOnGetText: TFieldGetWideTextEvent;
- FOnSetText: TFieldSetWideTextEvent;
- FEncodingMode: TTntStringFieldEncodingMode;
- FFixedCodePage: Word;
- FRawVariantAccess: Boolean;
- procedure SetOnGetText(const Value: TFieldGetWideTextEvent);
- procedure SetOnSetText(const Value: TFieldSetWideTextEvent);
- procedure LegacyGetText(Sender: TField; var AnsiText: AnsiString; DoDisplayText: Boolean);
- procedure LegacySetText(Sender: TField; const AnsiText: AnsiString);
- function GetWideDisplayText: WideString;
- function GetWideEditText: WideString;
- procedure SetWideEditText(const Value: WideString);
- function GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
- procedure SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
- function IsFixedCodePageStored: Boolean;
- protected
- {$IFDEF COMPILER_10_UP}
- function GetAsWideString: WideString; override;
- procedure SetAsWideString(const Value: WideString); override;
- {$ELSE}
- function GetAsWideString: WideString; virtual;
- procedure SetAsWideString(const Value: WideString); virtual;
- {$ENDIF}
- function GetAsVariant: Variant; override;
- procedure SetVarValue(const Value: Variant); override;
- function GetAsString: string{TNT-ALLOW string}; override;
- procedure SetAsString(const Value: string{TNT-ALLOW string}); override;
- public
- constructor Create(AOwner: TComponent); override;
- property Value: WideString read GetAsWideString write SetAsWideString;
- property DisplayText{TNT-ALLOW DisplayText}: WideString read GetWideDisplayText;
- property Text: WideString read GetWideEditText write SetWideEditText;
- {$IFNDEF COMPILER_10_UP}
- property AsWideString: WideString read GetAsWideString write SetAsWideString;
- {$ENDIF}
- property WideDisplayText: WideString read GetWideDisplayText;
- property WideText: WideString read GetWideEditText write SetWideEditText;
- published
- property EncodingMode: TTntStringFieldEncodingMode read FEncodingMode write FEncodingMode default emUTF8;
- property FixedCodePageEnum: TTntStringFieldCodePageEnum read GetFixedCodePageEnum write SetFixedCodePageEnum stored False;
- property FixedCodePage: Word read FFixedCodePage write FFixedCodePage stored IsFixedCodePageStored;
- property RawVariantAccess: Boolean read FRawVariantAccess write FRawVariantAccess default False;
- property OnGetText: TFieldGetWideTextEvent read FOnGetText write SetOnGetText;
- property OnSetText: TFieldSetWideTextEvent read FOnSetText write SetOnSetText;
- end;
-
-//======================
-function GetTntFieldClass(FieldClass: TFieldClass): TFieldClass;
-
-function GetWideDisplayName(Field: TField): WideString; deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
-function GetWideDisplayLabel(Field: TField): WideString; deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
-procedure SetWideDisplayLabel(Field: TField; const Value: WideString); deprecated; // for Unicode-enabled functionality, use Delphi 2006 or newer
-
-{TNT-WARN AsString}
-{TNT-WARN DisplayText}
-
-function GetAsWideString(Field: TField): WideString;
-procedure SetAsWideString(Field: TField; const Value: WideString);
-
-function GetWideDisplayText(Field: TField): WideString;
-
-function GetWideText(Field: TField): WideString;
-procedure SetWideText(Field: TField; const Value: WideString);
-
-procedure RegisterTntFields;
-
-{ TTntWideStringField / TTntStringField common handlers }
-procedure TntWideStringField_GetWideText(Field: TField;
- var Text: WideString; DoDisplayText: Boolean);
-function TntWideStringField_GetWideDisplayText(Field: TField;
- OnGetText: TFieldGetWideTextEvent): WideString;
-function TntWideStringField_GetWideEditText(Field: TField;
- OnGetText: TFieldGetWideTextEvent): WideString;
-procedure TntWideStringField_SetWideText(Field: TField;
- const Value: WideString);
-procedure TntWideStringField_SetWideEditText(Field: TField;
- OnSetText: TFieldSetWideTextEvent; const Value: WideString);
-
-
-implementation
-
-uses
- SysUtils, MaskUtils, Variants, Contnrs, TntSystem, TntSysUtils;
-
-function GetTntFieldClass(FieldClass: TFieldClass): TFieldClass;
-begin
- if FieldClass = TDateTimeField{TNT-ALLOW TDateTimeField} then
- Result := TTntDateTimeField
- else if FieldClass = TDateField{TNT-ALLOW TDateField} then
- Result := TTntDateField
- else if FieldClass = TTimeField{TNT-ALLOW TTimeField} then
- Result := TTntTimeField
- else if FieldClass = TWideStringField{TNT-ALLOW TWideStringField} then
- Result := TTntWideStringField
- else if FieldClass = TStringField{TNT-ALLOW TStringField} then
- Result := TTntStringField
- else
- Result := FieldClass;
-end;
-
-function GetWideDisplayName(Field: TField): WideString;
-begin
- Result := Field.DisplayName;
-end;
-
-function GetWideDisplayLabel(Field: TField): WideString;
-begin
- Result := Field.DisplayLabel;
-end;
-
-procedure SetWideDisplayLabel(Field: TField; const Value: WideString);
-begin
- Field.DisplayLabel := Value;
-end;
-
-function GetAsWideString(Field: TField): WideString;
-{$IFDEF COMPILER_10_UP}
-begin
- if (Field.ClassType = TMemoField{TNT-ALLOW TMemoField}) then
- Result := VarToWideStr(Field.AsVariant) { works for NexusDB BLOB Wide }
- else
- Result := Field.AsWideString
-end;
-{$ELSE}
-var
- WideField: IWideStringField;
-begin
- if Field.GetInterface(IWideStringField, WideField) then
- Result := WideField.AsWideString
- else if (Field is TWideStringField{TNT-ALLOW TWideStringField}) then
- begin
- if Field.IsNull then
- // This fixes a bug in TWideStringField.GetAsWideString which does not handle Null at all.
- Result := ''
- else
- Result := TWideStringField{TNT-ALLOW TWideStringField}(Field).Value
- end else if (Field is TMemoField{TNT-ALLOW TMemoField}) then
- Result := VarToWideStr(Field.AsVariant) { works for NexusDB BLOB Wide }
- else
- Result := Field.AsString{TNT-ALLOW AsString};
-end;
-{$ENDIF}
-
-procedure SetAsWideString(Field: TField; const Value: WideString);
-{$IFDEF COMPILER_10_UP}
-begin
- if (Field.ClassType = TMemoField{TNT-ALLOW TMemoField}) then
- Field.AsVariant := Value { works for NexusDB BLOB Wide }
- else
- Field.AsWideString := Value;
-end;
-{$ELSE}
-var
- WideField: IWideStringField;
-begin
- if Field.GetInterface(IWideStringField, WideField) then
- WideField.AsWideString := Value
- else if (Field is TWideStringField{TNT-ALLOW TWideStringField}) then
- TWideStringField{TNT-ALLOW TWideStringField}(Field).Value := Value
- else if (Field is TMemoField{TNT-ALLOW TMemoField}) then
- Field.AsVariant := Value { works for NexusDB BLOB Wide }
- else
- Field.AsString{TNT-ALLOW AsString} := Value;
-end;
-{$ENDIF}
-
-function GetWideDisplayText(Field: TField): WideString;
-var
- WideField: IWideStringField;
-begin
- if Field.GetInterface(IWideStringField, WideField) then
- Result := WideField.WideDisplayText
- else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
- and (not Assigned(Field.OnGetText)) then
- Result := GetAsWideString(Field)
- else
- Result := Field.DisplayText{TNT-ALLOW DisplayText};
-end;
-
-function GetWideText(Field: TField): WideString;
-var
- WideField: IWideStringField;
-begin
- if Field.GetInterface(IWideStringField, WideField) then
- Result := WideField.WideText
- else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
- and (not Assigned(Field.OnGetText)) then
- Result := GetAsWideString(Field)
- else
- Result := Field.Text;
-end;
-
-procedure SetWideText(Field: TField; const Value: WideString);
-var
- WideField: IWideStringField;
-begin
- if Field.GetInterface(IWideStringField, WideField) then
- WideField.WideText := Value
- else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
- and (not Assigned(Field.OnSetText)) then
- SetAsWideString(Field, Value)
- else
- Field.Text := Value
-end;
-
-{ TTntDateTimeField }
-
-procedure TTntDateTimeField.SetAsString(const Value: AnsiString);
-begin
- if Value = '' then
- inherited
- else
- SetAsDateTime(TntStrToDateTime(Value));
-end;
-
-{ TTntDateField }
-
-procedure TTntDateField.SetAsString(const Value: AnsiString);
-begin
- if Value = '' then
- inherited
- else
- SetAsDateTime(TntStrToDate(Value));
-end;
-
-{ TTntTimeField }
-
-procedure TTntTimeField.SetAsString(const Value: AnsiString);
-begin
- if Value = '' then
- inherited
- else
- SetAsDateTime(TntStrToTime(Value));
-end;
-
-{ TTntWideStringField / TTntStringField common handlers }
-
-procedure TntWideStringField_LegacyGetText(Sender: TField; OnGetText: TFieldGetWideTextEvent;
- var AnsiText: AnsiString; DoDisplayText: Boolean);
-var
- WideText: WideString;
-begin
- if Assigned(OnGetText) then begin
- WideText := AnsiText;
- OnGetText(Sender, WideText, DoDisplayText);
- AnsiText := WideText;
- end;
-end;
-
-procedure TntWideStringField_LegacySetText(Sender: TField; OnSetText: TFieldSetWideTextEvent;
- const AnsiText: AnsiString);
-begin
- if Assigned(OnSetText) then
- OnSetText(Sender, AnsiText);
-end;
-
-procedure TntWideStringField_GetWideText(Field: TField;
- var Text: WideString; DoDisplayText: Boolean);
-var
- WideStringField: IWideStringField;
-begin
- Field.GetInterface(IWideStringField, WideStringField);
- Assert(WideStringField <> nil);
- if DoDisplayText and (Field.EditMaskPtr <> '') then
- { to gain the mask, we lose Unicode! }
- Text := FormatMaskText(Field.EditMaskPtr, GetAsWideString(Field))
- else
- Text := GetAsWideString(Field);
-end;
-
-function TntWideStringField_GetWideDisplayText(Field: TField;
- OnGetText: TFieldGetWideTextEvent): WideString;
-begin
- Result := '';
- if Assigned(OnGetText) then
- OnGetText(Field, Result, True)
- else if Assigned(Field.OnGetText) then
- Result := Field.DisplayText{TNT-ALLOW DisplayText} {we lose Unicode to handle this event}
- else
- TntWideStringField_GetWideText(Field, Result, True);
-end;
-
-function TntWideStringField_GetWideEditText(Field: TField;
- OnGetText: TFieldGetWideTextEvent): WideString;
-begin
- Result := '';
- if Assigned(OnGetText) then
- OnGetText(Field, Result, False)
- else if Assigned(Field.OnGetText) then
- Result := Field.Text {we lose Unicode to handle this event}
- else
- TntWideStringField_GetWideText(Field, Result, False);
-end;
-
-procedure TntWideStringField_SetWideText(Field: TField;
- const Value: WideString);
-{$IFDEF COMPILER_10_UP}
-begin
- Field.AsWideString := Value;
-end;
-{$ELSE}
-var
- WideStringField: IWideStringField;
-begin
- Field.GetInterface(IWideStringField, WideStringField);
- Assert(WideStringField <> nil);
- WideStringField.SetAsWideString(Value);
-end;
-{$ENDIF}
-
-procedure TntWideStringField_SetWideEditText(Field: TField;
- OnSetText: TFieldSetWideTextEvent; const Value: WideString);
-begin
- if Assigned(OnSetText) then
- OnSetText(Field, Value)
- else if Assigned(Field.OnSetText) then
- Field.Text := Value {we lose Unicode to handle this event}
- else
- TntWideStringField_SetWideText(Field, Value);
-end;
-
-{ TTntWideStringField }
-
-{$IFNDEF COMPILER_10_UP}
-function TTntWideStringField.GetAsWideString: WideString;
-begin
- if not GetData(@Result, False) then
- Result := ''; {fixes a bug in inherited which has unpredictable results for NULL}
-end;
-{$ENDIF}
-
-procedure TTntWideStringField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
- DoDisplayText: Boolean);
-begin
- TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
-end;
-
-procedure TTntWideStringField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
-begin
- TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
-end;
-
-procedure TTntWideStringField.SetOnGetText(const Value: TFieldGetWideTextEvent);
-begin
- FOnGetText := Value;
- if Assigned(OnGetText) then
- inherited OnGetText := LegacyGetText
- else
- inherited OnGetText := nil;
-end;
-
-procedure TTntWideStringField.SetOnSetText(const Value: TFieldSetWideTextEvent);
-begin
- FOnSetText := Value;
- if Assigned(OnSetText) then
- inherited OnSetText := LegacySetText
- else
- inherited OnSetText := nil;
-end;
-
-function TTntWideStringField.GetWideDisplayText: WideString;
-begin
- Result := TntWideStringField_GetWideDisplayText(Self, OnGetText);
-end;
-
-function TTntWideStringField.GetWideEditText: WideString;
-begin
- Result := TntWideStringField_GetWideEditText(Self, OnGetText);
-end;
-
-procedure TTntWideStringField.SetWideEditText(const Value: WideString);
-begin
- TntWideStringField_SetWideEditText(Self, OnSetText, Value);
-end;
-
-(* This stuffing method works with CJK codepages - intended to store accented characters in Access 97 *)
-
-function SafeStringToWideStringEx(const S: AnsiString; Codepage: Word): WideString;
-var
- R: AnsiString;
- i: Integer;
-begin
- R := '';
- i := 1;
- while i <= Length(S) do
- begin
- if (S[i] = #128) then
- begin
- Inc(i);
- if S[i] = #128 then
- R := R + #128
- else
- R := R + Chr(Ord(S[i]) + 128);
- Inc(i);
- end
- else
- begin
- R := R + S[I];
- Inc(i);
- end;
- end;
- Result := StringToWideStringEx(R, CodePage);
-end;
-
-function SafeWideStringToStringEx(const W: WideString; CodePage: Word): AnsiString;
-var
- TempS: AnsiString;
- i: integer;
-begin
- TempS := WideStringToStringEx(W, CodePage);
- Result := '';
- for i := 1 to Length(TempS) do
- begin
- if TempS[i] > #128 then
- Result := Result + #128 + Chr(Ord(TempS[i]) - 128)
- else if TempS[i] = #128 then
- Result := Result + #128 + #128
- else
- Result := Result + TempS[i];
- end;
-end;
-
-{ TTntStringField }
-
-constructor TTntStringField.Create(AOwner: TComponent);
-begin
- inherited;
- FEncodingMode := emUTF8;
- FFixedCodePage := TntStringFieldCodePageEnumMap[fcpLatinWestern]
-end;
-
-function TTntStringField.GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
-var
- i: TTntStringFieldCodePageEnum;
-begin
- Result := fcpOther;
- for i := Low(TntStringFieldCodePageEnumMap) to High(TntStringFieldCodePageEnumMap) do begin
- if TntStringFieldCodePageEnumMap[i] = FixedCodePage then begin
- Result := i;
- Break; {found it}
- end;
- end;
-end;
-
-procedure TTntStringField.SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
-begin
- if (Value <> fcpOther) then
- FixedCodePage := TntStringFieldCodePageEnumMap[Value];
-end;
-
-function TTntStringField.GetAsVariant: Variant;
-begin
- if RawVariantAccess then
- Result := inherited GetAsVariant
- else if IsNull then
- Result := Null
- else
- Result := GetAsWideString;
-end;
-
-procedure TTntStringField.SetVarValue(const Value: Variant);
-begin
- if RawVariantAccess then
- inherited
- else
- SetAsWideString(Value);
-end;
-
-function TTntStringField.GetAsWideString: WideString;
-begin
- case EncodingMode of
- emNone: Result := (inherited GetAsString);
- emUTF8: Result := UTF8ToWideString(inherited GetAsString);
- emUTF7: try
- Result := UTF7ToWideString(inherited GetAsString);
- except
- Result := inherited GetAsString;
- end;
- emFixedCodePage: Result := StringToWideStringEx(inherited GetAsString, FixedCodePage);
- emFixedCodePage_Safe: Result := SafeStringToWideStringEx(inherited GetAsString, FixedCodePage);
- else
- raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
- end;
-end;
-
-procedure TTntStringField.SetAsWideString(const Value: WideString);
-begin
- case EncodingMode of
- emNone: inherited SetAsString(Value);
- emUTF8: inherited SetAsString(WideStringToUTF8(Value));
- emUTF7: inherited SetAsString(WideStringToUTF7(Value));
- emFixedCodePage: inherited SetAsString(WideStringToStringEx(Value, FixedCodePage));
- emFixedCodePage_Safe: inherited SetAsString(SafeWideStringToStringEx(Value, FixedCodePage));
- else
- raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
- end;
-end;
-
-function TTntStringField.GetAsString: string{TNT-ALLOW string};
-begin
- if EncodingMode = emNone then
- Result := inherited GetAsString
- else
- Result := GetAsWideString;
-end;
-
-procedure TTntStringField.SetAsString(const Value: string{TNT-ALLOW string});
-begin
- if EncodingMode = emNone then
- inherited SetAsString(Value)
- else
- SetAsWideString(Value);
-end;
-
-procedure TTntStringField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
- DoDisplayText: Boolean);
-begin
- TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
-end;
-
-procedure TTntStringField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
-begin
- TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
-end;
-
-procedure TTntStringField.SetOnGetText(const Value: TFieldGetWideTextEvent);
-begin
- FOnGetText := Value;
- if Assigned(OnGetText) then
- inherited OnGetText := LegacyGetText
- else
- inherited OnGetText := nil;
-end;
-
-procedure TTntStringField.SetOnSetText(const Value: TFieldSetWideTextEvent);
-begin
- FOnSetText := Value;
- if Assigned(OnSetText) then
- inherited OnSetText := LegacySetText
- else
- inherited OnSetText := nil;
-end;
-
-function TTntStringField.GetWideDisplayText: WideString;
-begin
- Result := TntWideStringField_GetWideDisplayText(Self, OnGetText)
-end;
-
-function TTntStringField.GetWideEditText: WideString;
-begin
- Result := TntWideStringField_GetWideEditText(Self, OnGetText);
-end;
-
-procedure TTntStringField.SetWideEditText(const Value: WideString);
-begin
- TntWideStringField_SetWideEditText(Self, OnSetText, Value);
-end;
-
-function TTntStringField.IsFixedCodePageStored: Boolean;
-begin
- Result := EncodingMode = emFixedCodePage;
-end;
-
-//---------------------------------------------------------------------------------------------
-{ TTntMemoField }
-
-constructor TTntMemoField.Create(AOwner: TComponent);
-begin
- inherited;
- FEncodingMode := emUTF8;
- FFixedCodePage := TntStringFieldCodePageEnumMap[fcpLatinWestern]
-end;
-
-function TTntMemoField.GetFixedCodePageEnum: TTntStringFieldCodePageEnum;
-var
- i: TTntStringFieldCodePageEnum;
-begin
- Result := fcpOther;
- for i := Low(TntStringFieldCodePageEnumMap) to High(TntStringFieldCodePageEnumMap) do begin
- if TntStringFieldCodePageEnumMap[i] = FixedCodePage then begin
- Result := i;
- Break; {found it}
- end;
- end;
-end;
-
-procedure TTntMemoField.SetFixedCodePageEnum(const Value: TTntStringFieldCodePageEnum);
-begin
- if (Value <> fcpOther) then
- FixedCodePage := TntStringFieldCodePageEnumMap[Value];
-end;
-
-function TTntMemoField.GetAsVariant: Variant;
-begin
- if RawVariantAccess then
- Result := inherited GetAsVariant
- else if IsNull then
- Result := Null
- else
- Result := GetAsWideString;
-end;
-
-procedure TTntMemoField.SetVarValue(const Value: Variant);
-begin
- if RawVariantAccess then
- inherited
- else
- SetAsWideString(Value);
-end;
-
-function TTntMemoField.GetAsWideString: WideString;
-begin
- case EncodingMode of
- emNone: Result := (inherited GetAsString);
- emUTF8: Result := UTF8ToWideString(inherited GetAsString);
- emUTF7: try
- Result := UTF7ToWideString(inherited GetAsString);
- except
- Result := inherited GetAsString;
- end;
- emFixedCodePage: Result := StringToWideStringEx(inherited GetAsString, FixedCodePage);
- emFixedCodePage_Safe: Result := SafeStringToWideStringEx(inherited GetAsString, FixedCodePage);
- else
- raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
- end;
-end;
-
-procedure TTntMemoField.SetAsWideString(const Value: WideString);
-begin
- case EncodingMode of
- emNone: inherited SetAsString(Value);
- emUTF8: inherited SetAsString(WideStringToUTF8(Value));
- emUTF7: inherited SetAsString(WideStringToUTF7(Value));
- emFixedCodePage: inherited SetAsString(WideStringToStringEx(Value, FixedCodePage));
- emFixedCodePage_Safe: inherited SetAsString(SafeWideStringToStringEx(Value, FixedCodePage));
- else
- raise ETntInternalError.Create('Internal Error: Unexpected EncodingMode');
- end;
-end;
-
-function TTntMemoField.GetAsString: string{TNT-ALLOW string};
-begin
- if EncodingMode = emNone then
- Result := inherited GetAsString
- else
- Result := GetAsWideString;
-end;
-
-procedure TTntMemoField.SetAsString(const Value: string{TNT-ALLOW string});
-begin
- if EncodingMode = emNone then
- inherited SetAsString(Value)
- else
- SetAsWideString(Value);
-end;
-
-procedure TTntMemoField.LegacyGetText(Sender: TField; var AnsiText: AnsiString;
- DoDisplayText: Boolean);
-begin
- TntWideStringField_LegacyGetText(Sender, OnGetText, AnsiText, DoDisplayText);
-end;
-
-procedure TTntMemoField.LegacySetText(Sender: TField; const AnsiText: AnsiString);
-begin
- TntWideStringField_LegacySetText(Sender, OnSetText, AnsiText);
-end;
-
-procedure TTntMemoField.SetOnGetText(const Value: TFieldGetWideTextEvent);
-begin
- FOnGetText := Value;
- if Assigned(OnGetText) then
- inherited OnGetText := LegacyGetText
- else
- inherited OnGetText := nil;
-end;
-
-procedure TTntMemoField.SetOnSetText(const Value: TFieldSetWideTextEvent);
-begin
- FOnSetText := Value;
- if Assigned(OnSetText) then
- inherited OnSetText := LegacySetText
- else
- inherited OnSetText := nil;
-end;
-
-function TTntMemoField.GetWideDisplayText: WideString;
-begin
- Result := TntWideStringField_GetWideDisplayText(Self, OnGetText)
-end;
-
-function TTntMemoField.GetWideEditText: WideString;
-begin
- Result := TntWideStringField_GetWideEditText(Self, OnGetText);
-end;
-
-procedure TTntMemoField.SetWideEditText(const Value: WideString);
-begin
- TntWideStringField_SetWideEditText(Self, OnSetText, Value);
-end;
-
-function TTntMemoField.IsFixedCodePageStored: Boolean;
-begin
- Result := EncodingMode = emFixedCodePage;
-end;
-//==================================================================
-procedure RegisterTntFields;
-begin
- RegisterFields([TTntDateTimeField]);
- RegisterFields([TTntDateField]);
- RegisterFields([TTntTimeField]);
- RegisterFields([TTntWideStringField]);
- RegisterFields([TTntStringField]);
- RegisterFields([TTntMemoField]);
-end;
-
-type PFieldClass = ^TFieldClass;
-
-initialization
-{$IFDEF TNT_FIELDS}
- PFieldClass(@DefaultFieldClasses[ftDate])^ := TTntDateField;
- PFieldClass(@DefaultFieldClasses[ftTime])^ := TTntTimeField;
- PFieldClass(@DefaultFieldClasses[ftDateTime])^ := TTntDateTimeField;
- PFieldClass(@DefaultFieldClasses[ftWideString])^ := TTntWideStringField;
- PFieldClass(@DefaultFieldClasses[ftString])^ := TTntStringField;
- PFieldClass(@DefaultFieldClasses[ftFixedChar])^ := TTntStringField;
-{$ENDIF}
-
-finalization
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBActns.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBActns.pas deleted file mode 100644 index 681257ec1a..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBActns.pas +++ /dev/null @@ -1,594 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntDBActns;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, ActnList, DBActns, TntActnList;
-
-type
-{TNT-WARN TDataSetAction}
- TTntDataSetAction = class(TDataSetAction{TNT-ALLOW TDataSetAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetFirst}
- TTntDataSetFirst = class(TDataSetFirst{TNT-ALLOW TDataSetFirst}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetPrior}
- TTntDataSetPrior = class(TDataSetPrior{TNT-ALLOW TDataSetPrior}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetNext}
- TTntDataSetNext = class(TDataSetNext{TNT-ALLOW TDataSetNext}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetLast}
- TTntDataSetLast = class(TDataSetLast{TNT-ALLOW TDataSetLast}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetInsert}
- TTntDataSetInsert = class(TDataSetInsert{TNT-ALLOW TDataSetInsert}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetDelete}
- TTntDataSetDelete = class(TDataSetDelete{TNT-ALLOW TDataSetDelete}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetEdit}
- TTntDataSetEdit = class(TDataSetEdit{TNT-ALLOW TDataSetEdit}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetPost}
- TTntDataSetPost = class(TDataSetPost{TNT-ALLOW TDataSetPost}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetCancel}
- TTntDataSetCancel = class(TDataSetCancel{TNT-ALLOW TDataSetCancel}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDataSetRefresh}
- TTntDataSetRefresh = class(TDataSetRefresh{TNT-ALLOW TDataSetRefresh}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-procedure TntDBActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-
-implementation
-
-uses
- TntClasses;
-
-{TNT-IGNORE-UNIT}
-
-procedure TntDBActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-begin
- TntAction_AfterInherited_Assign(Action, Source);
- // TDataSetAction
- if (Action is TDataSetAction) and (Source is TDataSetAction) then begin
- TDataSetAction(Action).DataSource := TDataSetAction(Source).DataSource;
- end;
-end;
-
-//-------------------------
-// TNT DB ACTNS
-//-------------------------
-
-{ TTntDataSetAction }
-
-procedure TTntDataSetAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetFirst }
-
-procedure TTntDataSetFirst.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetFirst.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetFirst.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetFirst.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetFirst.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetFirst.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetPrior }
-
-procedure TTntDataSetPrior.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetPrior.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetPrior.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetPrior.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetPrior.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetPrior.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetNext }
-
-procedure TTntDataSetNext.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetNext.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetNext.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetNext.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetNext.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetNext.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetLast }
-
-procedure TTntDataSetLast.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetLast.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetLast.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetLast.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetLast.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetLast.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetInsert }
-
-procedure TTntDataSetInsert.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetInsert.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetInsert.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetInsert.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetInsert.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetInsert.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetDelete }
-
-procedure TTntDataSetDelete.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetDelete.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetDelete.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetDelete.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetDelete.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetDelete.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetEdit }
-
-procedure TTntDataSetEdit.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetEdit.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetEdit.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetEdit.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetEdit.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetEdit.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetPost }
-
-procedure TTntDataSetPost.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetPost.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetPost.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetPost.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetPost.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetPost.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetCancel }
-
-procedure TTntDataSetCancel.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetCancel.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetCancel.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetCancel.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetCancel.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetCancel.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDataSetRefresh }
-
-procedure TTntDataSetRefresh.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDataSetRefresh.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDataSetRefresh.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDataSetRefresh.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDataSetRefresh.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDataSetRefresh.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBClientActns.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBClientActns.pas deleted file mode 100644 index 98904c7380..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBClientActns.pas +++ /dev/null @@ -1,197 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntDBClientActns;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, ActnList, DBClientActns, TntActnList;
-
-type
-{TNT-WARN TClientDataSetApply}
- TTntClientDataSetApply = class(TClientDataSetApply{TNT-ALLOW TClientDataSetApply}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TClientDataSetRevert}
- TTntClientDataSetRevert = class(TClientDataSetRevert{TNT-ALLOW TClientDataSetRevert}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TClientDataSetUndo}
- TTntClientDataSetUndo = class(TClientDataSetUndo{TNT-ALLOW TClientDataSetUndo}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-implementation
-
-uses
- TntClasses, TntDBActns;
-
-{TNT-IGNORE-UNIT}
-
-procedure TntDBClientActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-begin
- TntDBActn_AfterInherited_Assign(Action, Source);
- // TClientDataSetApply
- if (Action is TClientDataSetApply) and (Source is TClientDataSetApply) then begin
- TClientDataSetApply(Action).MaxErrors := TClientDataSetApply(Source).MaxErrors;
- TClientDataSetApply(Action).DisplayErrorDlg := TClientDataSetApply(Source).DisplayErrorDlg;
- end;
- // TClientDataSetUndo
- if (Action is TClientDataSetUndo) and (Source is TClientDataSetUndo) then begin
- TClientDataSetUndo(Action).FollowChange := TClientDataSetUndo(Source).FollowChange;
- end;
-end;
-
-//-------------------------
-// TNT DB ACTNS
-//-------------------------
-
-{ TTntClientDataSetApply }
-
-procedure TTntClientDataSetApply.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBClientActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntClientDataSetApply.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntClientDataSetApply.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntClientDataSetApply.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntClientDataSetApply.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntClientDataSetApply.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntClientDataSetRevert }
-
-procedure TTntClientDataSetRevert.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBClientActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntClientDataSetRevert.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntClientDataSetRevert.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntClientDataSetRevert.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntClientDataSetRevert.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntClientDataSetRevert.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntClientDataSetUndo }
-
-procedure TTntClientDataSetUndo.Assign(Source: TPersistent);
-begin
- inherited;
- TntDBClientActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntClientDataSetUndo.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntClientDataSetUndo.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntClientDataSetUndo.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntClientDataSetUndo.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntClientDataSetUndo.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas deleted file mode 100644 index 49111d4aba..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas +++ /dev/null @@ -1,2195 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntDBCtrls;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, Windows, Messages, DB, DBCtrls, Controls, StdCtrls,
- TntClasses, TntStdCtrls, TntControls, TntComCtrls, TntExtCtrls;
-
-type
-{TNT-WARN TPaintControl}
- TTntPaintControl = class
- private
- FOwner: TWinControl;
- FClassName: WideString;
- FHandle: HWnd;
- FObjectInstance: Pointer;
- FDefWindowProc: Pointer;
- FCtl3dButton: Boolean;
- function GetHandle: HWnd;
- procedure SetCtl3DButton(Value: Boolean);
- procedure WndProc(var Message: TMessage);
- public
- constructor Create(AOwner: TWinControl; const ClassName: WideString);
- destructor Destroy; override;
- procedure DestroyHandle;
- property Ctl3DButton: Boolean read FCtl3dButton write SetCtl3dButton;
- property Handle: HWnd read GetHandle;
- end;
-
-type
-{TNT-WARN TDBEdit}
- TTntDBEdit = class(TDBEdit{TNT-ALLOW TDBEdit})
- private
- InheritedDataChange: TNotifyEvent;
- FPasswordChar: WideChar;
- procedure DataChange(Sender: TObject);
- procedure UpdateData(Sender: TObject);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
- function GetTextMargins: TPoint;
- function GetPasswordChar: WideChar;
- procedure SetPasswordChar(const Value: WideChar);
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- private
- function GetSelStart: Integer; reintroduce; virtual;
- procedure SetSelStart(const Value: Integer); reintroduce; virtual;
- function GetSelLength: Integer; reintroduce; virtual;
- procedure SetSelLength(const Value: Integer); reintroduce; virtual;
- function GetSelText: WideString; reintroduce;
- procedure SetSelText(const Value: WideString);
- function GetText: WideString;
- procedure SetText(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure CreateWnd; override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- public
- constructor Create(AOwner: TComponent); override;
- property SelText: WideString read GetSelText write SetSelText;
- property SelStart: Integer read GetSelStart write SetSelStart;
- property SelLength: Integer read GetSelLength write SetSelLength;
- property Text: WideString read GetText write SetText;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
- end;
-
-{TNT-WARN TDBText}
- TTntDBText = class(TDBText{TNT-ALLOW TDBText})
- private
- FDataLink: TFieldDataLink;
- InheritedDataChange: TNotifyEvent;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- function GetCaption: TWideCaption;
- function IsCaptionStored: Boolean;
- procedure SetCaption(const Value: TWideCaption);
- function GetFieldText: WideString;
- procedure DataChange(Sender: TObject);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- function GetLabelText: WideString; reintroduce; virtual;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TDBComboBox}
- TTntCustomDBComboBox = class(TDBComboBox{TNT-ALLOW TDBComboBox},
- IWideCustomListControl)
- private
- FDataLink: TFieldDataLink;
- FFilter: WideString;
- FLastTime: Cardinal;
- procedure UpdateData(Sender: TObject);
- procedure EditingChange(Sender: TObject);
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure SetReadOnly;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure WMChar(var Message: TWMChar); message WM_CHAR;
- private
- FItems: TTntStrings;
- FSaveItems: TTntStrings;
- FSaveItemIndex: integer;
- function GetItems: TTntStrings;
- procedure SetItems(const Value: TTntStrings); reintroduce;
- function GetSelStart: Integer;
- procedure SetSelStart(const Value: Integer);
- function GetSelLength: Integer;
- procedure SetSelLength(const Value: Integer);
- function GetSelText: WideString;
- procedure SetSelText(const Value: WideString);
- function GetText: WideString;
- procedure SetText(const Value: WideString);
-
- procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
- protected
- procedure DataChange(Sender: TObject);
- function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
- function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
- procedure DoEditCharMsg(var Message: TWMChar); virtual;
- function GetFieldValue: Variant; virtual;
- procedure SetFieldValue(const Value: Variant); virtual;
- function GetComboValue: Variant; virtual; abstract;
- procedure SetComboValue(const Value: Variant); virtual; abstract;
- {$IFDEF DELPHI_7} // fix for Delphi 7 only
- function GetItemsClass: TCustomComboBoxStringsClass; override;
- {$ENDIF}
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure CreateWnd; override;
- procedure DestroyWnd; override;
- procedure WndProc(var Message: TMessage); override;
- procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
- procedure KeyPress(var Key: AnsiChar); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure CopySelection(Destination: TCustomListControl); override;
- procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
- public
- property SelText: WideString read GetSelText write SetSelText;
- property SelStart: Integer read GetSelStart write SetSelStart;
- property SelLength: Integer read GetSelLength write SetSelLength;
- property Text: WideString read GetText write SetText;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- property Items: TTntStrings read GetItems write SetItems;
- end;
-
- TTntDBComboBox = class(TTntCustomDBComboBox)
- protected
- function GetFieldValue: Variant; override;
- procedure SetFieldValue(const Value: Variant); override;
- function GetComboValue: Variant; override;
- procedure SetComboValue(const Value: Variant); override;
- end;
-
-type
-{TNT-WARN TDBCheckBox}
- TTntDBCheckBox = class(TDBCheckBox{TNT-ALLOW TDBCheckBox})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure Toggle; override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TDBRichEdit}
- TTntDBRichEdit = class(TTntCustomRichEdit)
- private
- FDataLink: TFieldDataLink;
- FAutoDisplay: Boolean;
- FFocused: Boolean;
- FMemoLoaded: Boolean;
- FDataSave: AnsiString;
- procedure BeginEditing;
- procedure DataChange(Sender: TObject);
- procedure EditingChange(Sender: TObject);
- function GetDataField: WideString;
- function GetDataSource: TDataSource;
- function GetField: TField;
- function GetReadOnly: Boolean;
- procedure SetDataField(const Value: WideString);
- procedure SetDataSource(Value: TDataSource);
- procedure SetReadOnly(Value: Boolean);
- procedure SetAutoDisplay(Value: Boolean);
- procedure SetFocused(Value: Boolean);
- procedure UpdateData(Sender: TObject);
- procedure WMCut(var Message: TMessage); message WM_CUT;
- procedure WMPaste(var Message: TMessage); message WM_PASTE;
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
- procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
- procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
- protected
- procedure InternalLoadMemo; dynamic;
- procedure InternalSaveMemo; dynamic;
- protected
- procedure Change; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: AnsiChar); override;
- procedure Loaded; override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function ExecuteAction(Action: TBasicAction): Boolean; override;
- procedure LoadMemo; virtual;
- function UpdateAction(Action: TBasicAction): Boolean; override;
- function UseRightToLeftAlignment: Boolean; override;
- property Field: TField read GetField;
- published
- property Align;
- property Alignment;
- property Anchors;
- property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
- property BevelEdges;
- property BevelInner;
- property BevelOuter;
- property BevelKind;
- property BevelWidth;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property Constraints;
- property Ctl3D;
- property DataField: WideString read GetDataField write SetDataField;
- property DataSource: TDataSource read GetDataSource write SetDataSource;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HideSelection;
- property HideScrollBars;
- property ImeMode;
- property ImeName;
- property MaxLength;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PlainText;
- property PopupMenu;
- property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
- property ScrollBars;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- property WantReturns;
- property WantTabs;
- property WordWrap;
- property OnChange;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnResizeRequest;
- property OnSelectionChange;
- property OnProtectChange;
- property OnSaveClipboard;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-type
-{TNT-WARN TDBMemo}
- TTntDBMemo = class(TTntCustomMemo)
- private
- FDataLink: TFieldDataLink;
- FAutoDisplay: Boolean;
- FFocused: Boolean;
- FMemoLoaded: Boolean;
- FPaintControl: TTntPaintControl;
- procedure DataChange(Sender: TObject);
- procedure EditingChange(Sender: TObject);
- function GetDataField: WideString;
- function GetDataSource: TDataSource;
- function GetField: TField;
- function GetReadOnly: Boolean;
- procedure SetDataField(const Value: WideString);
- procedure SetDataSource(Value: TDataSource);
- procedure SetReadOnly(Value: Boolean);
- procedure SetAutoDisplay(Value: Boolean);
- procedure SetFocused(Value: Boolean);
- procedure UpdateData(Sender: TObject);
- procedure WMCut(var Message: TMessage); message WM_CUT;
- procedure WMPaste(var Message: TMessage); message WM_PASTE;
- procedure WMUndo(var Message: TMessage); message WM_UNDO;
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
- procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
- procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
- protected
- procedure Change; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
- procedure Loaded; override;
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- procedure WndProc(var Message: TMessage); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function ExecuteAction(Action: TBasicAction): Boolean; override;
- procedure LoadMemo; virtual;
- function UpdateAction(Action: TBasicAction): Boolean; override;
- function UseRightToLeftAlignment: Boolean; override;
- property Field: TField read GetField;
- published
- property Align;
- property Alignment;
- property Anchors;
- property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
- property BevelEdges;
- property BevelInner;
- property BevelOuter;
- property BevelKind;
- property BevelWidth;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property Constraints;
- property Ctl3D;
- property DataField: WideString read GetDataField write SetDataField;
- property DataSource: TDataSource read GetDataSource write SetDataSource;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HideSelection;
- property ImeMode;
- property ImeName;
- property MaxLength;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
- property ScrollBars;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- property WantReturns;
- property WantTabs;
- property WordWrap;
- property OnChange;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-{ TDBRadioGroup }
-type
- TTntDBRadioGroup = class(TTntCustomRadioGroup)
- private
- FDataLink: TFieldDataLink;
- FValue: WideString;
- FValues: TTntStrings;
- FInSetValue: Boolean;
- FOnChange: TNotifyEvent;
- procedure DataChange(Sender: TObject);
- procedure UpdateData(Sender: TObject);
- function GetDataField: WideString;
- function GetDataSource: TDataSource;
- function GetField: TField;
- function GetReadOnly: Boolean;
- function GetButtonValue(Index: Integer): WideString;
- procedure SetDataField(const Value: WideString);
- procedure SetDataSource(Value: TDataSource);
- procedure SetReadOnly(Value: Boolean);
- procedure SetValue(const Value: WideString);
- procedure SetItems(Value: TTntStrings);
- procedure SetValues(Value: TTntStrings);
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
- protected
- procedure Change; dynamic;
- procedure Click; override;
- procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
- function CanModify: Boolean; override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- property DataLink: TFieldDataLink read FDataLink;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function ExecuteAction(Action: TBasicAction): Boolean; override;
- function UpdateAction(Action: TBasicAction): Boolean; override;
- function UseRightToLeftAlignment: Boolean; override;
- property Field: TField read GetField;
- property ItemIndex;
- property Value: WideString read FValue write SetValue;
- published
- property Align;
- property Anchors;
- property BiDiMode;
- property Caption;
- property Color;
- property Columns;
- property Constraints;
- property Ctl3D;
- property DataField: WideString read GetDataField write SetDataField;
- property DataSource: TDataSource read GetDataSource write SetDataSource;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property Items write SetItems;
- {$IFDEF COMPILER_7_UP}
- property ParentBackground;
- {$ENDIF}
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Values: TTntStrings read FValues write SetValues;
- property Visible;
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- property OnClick;
- property OnContextPopup;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnStartDock;
- property OnStartDrag;
- end;
-
-implementation
-
-uses
- Forms, SysUtils, Graphics, Variants, TntDB,
- TntActnList, TntGraphics, TntSysUtils, RichEdit, Mask;
-
-function FieldIsBlobLike(Field: TField): Boolean;
-begin
- Result := False;
- if Assigned(Field) then begin
- if (Field.IsBlob)
- or (Field.DataType in [Low(TBlobType).. High(TBlobType)]) then
- Result := True
- else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
- and (Field.Size = MaxInt) then
- Result := True; { wide string field filling in for a blob field }
- end;
-end;
-
-{ TTntPaintControl }
-
-type
- TAccessWinControl = class(TWinControl);
-
-constructor TTntPaintControl.Create(AOwner: TWinControl; const ClassName: WideString);
-begin
- FOwner := AOwner;
- FClassName := ClassName;
-end;
-
-destructor TTntPaintControl.Destroy;
-begin
- DestroyHandle;
-end;
-
-procedure TTntPaintControl.DestroyHandle;
-begin
- if FHandle <> 0 then DestroyWindow(FHandle);
- Classes.FreeObjectInstance(FObjectInstance);
- FHandle := 0;
- FObjectInstance := nil;
-end;
-
-function TTntPaintControl.GetHandle: HWnd;
-var
- Params: TCreateParams;
-begin
- if FHandle = 0 then
- begin
- FObjectInstance := Classes.MakeObjectInstance(WndProc);
- TAccessWinControl(FOwner).CreateParams(Params);
- Params.Style := Params.Style and not (WS_HSCROLL or WS_VSCROLL);
- if (not Win32PlatformIsUnicode) then begin
- with Params do
- FHandle := CreateWindowEx(ExStyle, PAnsiChar(AnsiString(FClassName)),
- PAnsiChar(TAccessWinControl(FOwner).Text), Style or WS_VISIBLE,
- X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
- FDefWindowProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
- SetWindowLong(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
- end else begin
- with Params do
- FHandle := CreateWindowExW(ExStyle, PWideChar(FClassName),
- PWideChar(TntControl_GetText(FOwner)), Style or WS_VISIBLE,
- X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
- FDefWindowProc := Pointer(GetWindowLongW(FHandle, GWL_WNDPROC));
- SetWindowLongW(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
- end;
- SendMessage(FHandle, WM_SETFONT, Integer(TAccessWinControl(FOwner).Font.Handle), 1);
- end;
- Result := FHandle;
-end;
-
-procedure TTntPaintControl.SetCtl3DButton(Value: Boolean);
-begin
- if FHandle <> 0 then DestroyHandle;
- FCtl3DButton := Value;
-end;
-
-procedure TTntPaintControl.WndProc(var Message: TMessage);
-begin
- with Message do
- if (Msg >= CN_CTLCOLORMSGBOX) and (Msg <= CN_CTLCOLORSTATIC) then
- Result := FOwner.Perform(Msg, WParam, LParam)
- else if (not Win32PlatformIsUnicode) then
- Result := CallWindowProcA(FDefWindowProc, FHandle, Msg, WParam, LParam)
- else
- Result := CallWindowProcW(FDefWindowProc, FHandle, Msg, WParam, LParam);
-end;
-
-{ THackFieldDataLink }
-type
- THackFieldDataLink_D6_D7_D9 = class(TDataLink)
- protected
- FxxxField: TField;
- FxxxFieldName: string{TNT-ALLOW string};
- FxxxControl: TComponent;
- FxxxEditing: Boolean;
- FModified: Boolean;
- end;
-
-{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
- THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
- THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
- THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
- THackFieldDataLink = class(TDataLink)
- protected
- FxxxField: TField;
- FxxxFieldName: WideString;
- FxxxControl: TComponent;
- FxxxEditing: Boolean;
- FModified: Boolean;
- end;
-{$ENDIF}
-
-{ TTntDBEdit }
-
-type
- THackDBEdit_D6_D7_D9 = class(TCustomMaskEdit)
- protected
- FDataLink: TFieldDataLink;
- FCanvas: TControlCanvas;
- FAlignment: TAlignment;
- FFocused: Boolean;
- end;
-
-{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
- THackDBEdit = THackDBEdit_D6_D7_D9;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
- THackDBEdit = THackDBEdit_D6_D7_D9;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
- THackDBEdit = THackDBEdit_D6_D7_D9;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
- THackDBEdit = THackDBEdit_D6_D7_D9;
-{$ENDIF}
-
-constructor TTntDBEdit.Create(AOwner: TComponent);
-begin
- inherited;
- InheritedDataChange := THackDBEdit(Self).FDataLink.OnDataChange;
- THackDBEdit(Self).FDataLink.OnDataChange := DataChange;
- THackDBEdit(Self).FDataLink.OnUpdateData := UpdateData;
-end;
-
-procedure TTntDBEdit.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'EDIT');
-end;
-
-procedure TTntDBEdit.CreateWnd;
-begin
- inherited;
- TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
-end;
-
-procedure TTntDBEdit.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDBEdit.GetSelStart: Integer;
-begin
- Result := TntCustomEdit_GetSelStart(Self);
-end;
-
-procedure TTntDBEdit.SetSelStart(const Value: Integer);
-begin
- TntCustomEdit_SetSelStart(Self, Value);
-end;
-
-function TTntDBEdit.GetSelLength: Integer;
-begin
- Result := TntCustomEdit_GetSelLength(Self);
-end;
-
-procedure TTntDBEdit.SetSelLength(const Value: Integer);
-begin
- TntCustomEdit_SetSelLength(Self, Value);
-end;
-
-function TTntDBEdit.GetSelText: WideString;
-begin
- Result := TntCustomEdit_GetSelText(Self);
-end;
-
-procedure TTntDBEdit.SetSelText(const Value: WideString);
-begin
- TntCustomEdit_SetSelText(Self, Value);
-end;
-
-function TTntDBEdit.GetPasswordChar: WideChar;
-begin
- Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar)
-end;
-
-procedure TTntDBEdit.SetPasswordChar(const Value: WideChar);
-begin
- TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
-end;
-
-function TTntDBEdit.GetText: WideString;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntDBEdit.SetText(const Value: WideString);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntDBEdit.DataChange(Sender: TObject);
-begin
- with THackDBEdit(Self), Self do begin
- if Field = nil then
- InheritedDataChange(Sender)
- else begin
- if FAlignment <> Field.Alignment then
- begin
- EditText := ''; {forces update}
- FAlignment := Field.Alignment;
- end;
- EditMask := Field.EditMask;
- if not (csDesigning in ComponentState) then
- begin
- if (Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
- MaxLength := Field.Size;
- end;
- if FFocused and FDataLink.CanModify then
- Text := GetWideText(Field)
- else
- begin
- Text := GetWideDisplayText(Field);
- if FDataLink.Editing and THackFieldDataLink(FDataLink).FModified then
- Modified := True;
- end;
- end;
- end;
-end;
-
-procedure TTntDBEdit.UpdateData(Sender: TObject);
-begin
- ValidateEdit;
- SetWideText(Field, Text);
-end;
-
-procedure TTntDBEdit.CMEnter(var Message: TCMEnter);
-var
- SaveFarEast: Boolean;
-begin
- SaveFarEast := SysLocale.FarEast;
- try
- SysLocale.FarEast := False;
- inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
- finally
- SysLocale.FarEast := SaveFarEast;
- end;
-end;
-
-function TTntDBEdit.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntDBEdit.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntDBEdit.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntDBEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntDBEdit.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-procedure TTntDBEdit.WMPaint(var Message: TWMPaint);
-const
- AlignStyle : array[Boolean, TAlignment] of DWORD =
- ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
- (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
-var
- ALeft: Integer;
- _Margins: TPoint;
- R: TRect;
- DC: HDC;
- PS: TPaintStruct;
- S: WideString;
- AAlignment: TAlignment;
- I: Integer;
-begin
- with THackDBEdit(Self), Self do begin
- AAlignment := FAlignment;
- if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
- if ((AAlignment = taLeftJustify) or FFocused) and (not (csPaintCopy in ControlState))
- or (not Win32PlatformIsUnicode) then
- begin
- inherited;
- Exit;
- end;
- { Since edit controls do not handle justification unless multi-line (and
- then only poorly) we will draw right and center justify manually unless
- the edit has the focus. }
- if FCanvas = nil then
- begin
- FCanvas := TControlCanvas.Create;
- FCanvas.Control := Self;
- end;
- DC := Message.DC;
- if DC = 0 then DC := BeginPaint(Handle, PS);
- FCanvas.Handle := DC;
- try
- FCanvas.Font := Font;
- with FCanvas do
- begin
- R := ClientRect;
- if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
- begin
- Brush.Color := clWindowFrame;
- FrameRect(R);
- InflateRect(R, -1, -1);
- end;
- Brush.Color := Color;
- if not Enabled then
- Font.Color := clGrayText;
- if (csPaintCopy in ControlState) and (Field <> nil) then
- begin
- S := GetWideDisplayText(Field);
- case CharCase of
- ecUpperCase:
- S := Tnt_WideUpperCase(S);
- ecLowerCase:
- S := Tnt_WideLowerCase(S);
- end;
- end else
- S := Text { EditText? };
- if PasswordChar <> #0 then
- for I := 1 to Length(S) do S[I] := PasswordChar;
- _Margins := GetTextMargins;
- case AAlignment of
- taLeftJustify: ALeft := _Margins.X;
- taRightJustify: ALeft := ClientWidth - WideCanvasTextWidth(FCanvas, S) - _Margins.X - 1;
- else
- ALeft := (ClientWidth - WideCanvasTextWidth(FCanvas, S)) div 2;
- end;
- if SysLocale.MiddleEast then UpdateTextFlags;
- WideCanvasTextRect(FCanvas, R, ALeft, _Margins.Y, S);
- end;
- finally
- FCanvas.Handle := 0;
- if Message.DC = 0 then EndPaint(Handle, PS);
- end;
- end;
-end;
-
-function TTntDBEdit.GetTextMargins: TPoint;
-var
- DC: HDC;
- SaveFont: HFont;
- I: Integer;
- SysMetrics, Metrics: TTextMetric;
-begin
- if NewStyleControls then
- begin
- if BorderStyle = bsNone then I := 0 else
- if Ctl3D then I := 1 else I := 2;
- Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
- Result.Y := I;
- end else
- begin
- if BorderStyle = bsNone then I := 0 else
- begin
- DC := GetDC(0);
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then I := Metrics.tmHeight;
- I := I div 4;
- end;
- Result.X := I;
- Result.Y := I;
- end;
-end;
-
-{ TTntDBText }
-
-constructor TTntDBText.Create(AOwner: TComponent);
-begin
- inherited;
- FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
- InheritedDataChange := FDataLink.OnDataChange;
- FDataLink.OnDataChange := DataChange;
-end;
-
-destructor TTntDBText.Destroy;
-begin
- FDataLink := nil;
- inherited;
-end;
-
-procedure TTntDBText.CMDialogChar(var Message: TCMDialogChar);
-begin
- TntLabel_CMDialogChar(Self, Message, Caption);
-end;
-
-function TTntDBText.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self)
-end;
-
-function TTntDBText.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntDBText.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntDBText.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDBText.GetLabelText: WideString;
-begin
- if csPaintCopy in ControlState then
- Result := GetFieldText
- else
- Result := Caption;
-end;
-
-procedure TTntDBText.DoDrawText(var Rect: TRect; Flags: Integer);
-begin
- if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
- inherited;
-end;
-
-function TTntDBText.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntDBText.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntDBText.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntDBText.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntDBText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntDBText.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-function TTntDBText.GetFieldText: WideString;
-begin
- if Field <> nil then
- Result := GetWideDisplayText(Field)
- else
- if csDesigning in ComponentState then Result := Name else Result := '';
-end;
-
-procedure TTntDBText.DataChange(Sender: TObject);
-begin
- Caption := GetFieldText;
-end;
-
-{ TTntCustomDBComboBox }
-
-constructor TTntCustomDBComboBox.Create(AOwner: TComponent);
-begin
- inherited;
- FItems := TTntComboBoxStrings.Create;
- TTntComboBoxStrings(FItems).ComboBox := Self;
- FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
- FDataLink.OnDataChange := DataChange;
- FDataLink.OnUpdateData := UpdateData;
- FDataLink.OnEditingChange := EditingChange;
-end;
-
-destructor TTntCustomDBComboBox.Destroy;
-begin
- FreeAndNil(FItems);
- FreeAndNil(FSaveItems);
- FDataLink := nil;
- inherited;
-end;
-
-procedure TTntCustomDBComboBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'COMBOBOX');
-end;
-
-procedure TTntCustomDBComboBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-type
- TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
-
-procedure TTntCustomDBComboBox.CreateWnd;
-var
- PreInheritedAnsiText: AnsiString;
-begin
- PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
- inherited;
- TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
-end;
-
-procedure TTntCustomDBComboBox.DestroyWnd;
-var
- SavedText: WideString;
-begin
- if not (csDestroyingHandle in ControlState) then begin { avoid recursion when parent is TToolBar and system font changes. }
- TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex, SavedText);
- inherited;
- TntControl_SetStoredText(Self, SavedText);
- end;
-end;
-
-procedure TTntCustomDBComboBox.SetReadOnly;
-begin
- if (Style in [csDropDown, csSimple]) and HandleAllocated then
- SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.CanModify), 0);
-end;
-
-procedure TTntCustomDBComboBox.EditingChange(Sender: TObject);
-begin
- SetReadOnly;
-end;
-
-procedure TTntCustomDBComboBox.CMEnter(var Message: TCMEnter);
-var
- SaveFarEast: Boolean;
-begin
- SaveFarEast := SysLocale.FarEast;
- try
- SysLocale.FarEast := False;
- inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
- finally
- SysLocale.FarEast := SaveFarEast;
- end;
-end;
-
-procedure TTntCustomDBComboBox.WndProc(var Message: TMessage);
-begin
- if (not (csDesigning in ComponentState))
- and (Message.Msg = CB_SHOWDROPDOWN)
- and (Message.WParam = 0)
- and (not FDataLink.Editing) then begin
- DataChange(Self); {Restore text}
- Dispatch(Message); {Do NOT call inherited!}
- end else
- inherited WndProc(Message);
-end;
-
-procedure TTntCustomDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
-begin
- if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
- inherited;
-end;
-
-procedure TTntCustomDBComboBox.KeyPress(var Key: AnsiChar);
-var
- SaveAutoComplete: Boolean;
-begin
- TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
- try
- inherited;
- finally
- TntCombo_AfterKeyPress(Self, SaveAutoComplete);
- end;
-end;
-
-procedure TTntCustomDBComboBox.DoEditCharMsg(var Message: TWMChar);
-begin
- TntCombo_AutoCompleteKeyPress(Self, Items, Message,
- GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
-end;
-
-procedure TTntCustomDBComboBox.WMChar(var Message: TWMChar);
-begin
- TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
- inherited;
-end;
-
-function TTntCustomDBComboBox.GetItems: TTntStrings;
-begin
- Result := FItems;
-end;
-
-procedure TTntCustomDBComboBox.SetItems(const Value: TTntStrings);
-begin
- FItems.Assign(Value);
- DataChange(Self);
-end;
-
-function TTntCustomDBComboBox.GetSelStart: Integer;
-begin
- Result := TntCombo_GetSelStart(Self);
-end;
-
-procedure TTntCustomDBComboBox.SetSelStart(const Value: Integer);
-begin
- TntCombo_SetSelStart(Self, Value);
-end;
-
-function TTntCustomDBComboBox.GetSelLength: Integer;
-begin
- Result := TntCombo_GetSelLength(Self);
-end;
-
-procedure TTntCustomDBComboBox.SetSelLength(const Value: Integer);
-begin
- TntCombo_SetSelLength(Self, Value);
-end;
-
-function TTntCustomDBComboBox.GetSelText: WideString;
-begin
- Result := TntCombo_GetSelText(Self);
-end;
-
-procedure TTntCustomDBComboBox.SetSelText(const Value: WideString);
-begin
- TntCombo_SetSelText(Self, Value);
-end;
-
-function TTntCustomDBComboBox.GetText: WideString;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntCustomDBComboBox.SetText(const Value: WideString);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntCustomDBComboBox.CNCommand(var Message: TWMCommand);
-begin
- if not TntCombo_CNCommand(Self, Items, Message) then
- inherited;
-end;
-
-function TTntCustomDBComboBox.GetFieldValue: Variant;
-begin
- Result := Field.Value;
-end;
-
-procedure TTntCustomDBComboBox.SetFieldValue(const Value: Variant);
-begin
- Field.Value := Value;
-end;
-
-procedure TTntCustomDBComboBox.DataChange(Sender: TObject);
-begin
- if not (Style = csSimple) and DroppedDown then Exit;
- if Field <> nil then
- SetComboValue(GetFieldValue)
- else
- if csDesigning in ComponentState then
- SetComboValue(Name)
- else
- SetComboValue(Null);
-end;
-
-procedure TTntCustomDBComboBox.UpdateData(Sender: TObject);
-begin
- SetFieldValue(GetComboValue);
-end;
-
-function TTntCustomDBComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
-begin
- Result := True;
-end;
-
-function TTntCustomDBComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
-begin
- Result := False;
-end;
-
-function TTntCustomDBComboBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomDBComboBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomDBComboBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomDBComboBox.AddItem(const Item: WideString; AObject: TObject);
-begin
- TntComboBox_AddItem(Items, Item, AObject);
-end;
-
-procedure TTntCustomDBComboBox.CopySelection(Destination: TCustomListControl);
-begin
- TntComboBox_CopySelection(Items, ItemIndex, Destination);
-end;
-
-procedure TTntCustomDBComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomDBComboBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{$IFDEF DELPHI_7} // fix for Delphi 7 only
-function TTntCustomDBComboBox.GetItemsClass: TCustomComboBoxStringsClass;
-begin
- Result := TD7PatchedComboBoxStrings;
-end;
-{$ENDIF}
-
-{ TTntDBComboBox }
-
-function TTntDBComboBox.GetFieldValue: Variant;
-begin
- Result := GetWideText(Field);
-end;
-
-procedure TTntDBComboBox.SetFieldValue(const Value: Variant);
-begin
- SetWideText(Field, Value);
-end;
-
-procedure TTntDBComboBox.SetComboValue(const Value: Variant);
-var
- I: Integer;
- Redraw: Boolean;
- OldValue: WideString;
- NewValue: WideString;
-begin
- OldValue := VarToWideStr(GetComboValue);
- NewValue := VarToWideStr(Value);
-
- if NewValue <> OldValue then
- begin
- if Style <> csDropDown then
- begin
- Redraw := (Style <> csSimple) and HandleAllocated;
- if Redraw then Items.BeginUpdate;
- try
- if NewValue = '' then I := -1 else I := Items.IndexOf(NewValue);
- ItemIndex := I;
- finally
- Items.EndUpdate;
- end;
- if I >= 0 then Exit;
- end;
- if Style in [csDropDown, csSimple] then Text := NewValue;
- end;
-end;
-
-function TTntDBComboBox.GetComboValue: Variant;
-var
- I: Integer;
-begin
- if Style in [csDropDown, csSimple] then Result := Text else
- begin
- I := ItemIndex;
- if I < 0 then Result := '' else Result := Items[I];
- end;
-end;
-
-{ TTntDBCheckBox }
-
-procedure TTntDBCheckBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'BUTTON');
-end;
-
-procedure TTntDBCheckBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDBCheckBox.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self);
-end;
-
-function TTntDBCheckBox.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntDBCheckBox.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntDBCheckBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntDBCheckBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntDBCheckBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntDBCheckBox.Toggle;
-var
- FDataLink: TDataLink;
-begin
- inherited;
- FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
- FDataLink.UpdateRecord;
-end;
-
-procedure TTntDBCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntDBCheckBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntDBRichEdit }
-
-constructor TTntDBRichEdit.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- inherited ReadOnly := True;
- FAutoDisplay := True;
- FDataLink := TFieldDataLink.Create;
- FDataLink.Control := Self;
- FDataLink.OnDataChange := DataChange;
- FDataLink.OnEditingChange := EditingChange;
- FDataLink.OnUpdateData := UpdateData;
-end;
-
-destructor TTntDBRichEdit.Destroy;
-begin
- FDataLink.Free;
- FDataLink := nil;
- inherited Destroy;
-end;
-
-procedure TTntDBRichEdit.Loaded;
-begin
- inherited Loaded;
- if (csDesigning in ComponentState) then
- DataChange(Self)
-end;
-
-procedure TTntDBRichEdit.Notification(AComponent: TComponent; Operation: TOperation);
-begin
- inherited;
- if (Operation = opRemove) and (FDataLink <> nil) and
- (AComponent = DataSource) then DataSource := nil;
-end;
-
-function TTntDBRichEdit.UseRightToLeftAlignment: Boolean;
-begin
- Result := DBUseRightToLeftAlignment(Self, Field);
-end;
-
-procedure TTntDBRichEdit.BeginEditing;
-begin
- if not FDataLink.Editing then
- try
- if FieldIsBlobLike(Field) then
- FDataSave := Field.AsString{TNT-ALLOW AsString};
- FDataLink.Edit;
- finally
- FDataSave := '';
- end;
-end;
-
-procedure TTntDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
-begin
- inherited KeyDown(Key, Shift);
- if FMemoLoaded then
- begin
- if (Key = VK_DELETE) or (Key = VK_BACK) or
- ((Key = VK_INSERT) and (ssShift in Shift)) or
- (((Key = Ord('V')) or (Key = Ord('X'))) and (ssCtrl in Shift)) then
- BeginEditing;
- end;
-end;
-
-procedure TTntDBRichEdit.KeyPress(var Key: AnsiChar);
-begin
- inherited KeyPress(Key);
- if FMemoLoaded then
- begin
- if (Key in [#32..#255]) and (Field <> nil) and
- not Field.IsValidChar(Key) then
- begin
- MessageBeep(0);
- Key := #0;
- end;
- case Key of
- ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
- BeginEditing;
- #27:
- FDataLink.Reset;
- end;
- end else
- begin
- if Key = #13 then LoadMemo;
- Key := #0;
- end;
-end;
-
-procedure TTntDBRichEdit.Change;
-begin
- if FMemoLoaded then
- FDataLink.Modified;
- FMemoLoaded := True;
- inherited Change;
-end;
-
-procedure TTntDBRichEdit.CNNotify(var Message: TWMNotify);
-begin
- inherited;
- if Message.NMHdr^.code = EN_PROTECTED then
- Message.Result := 0 { allow the operation (otherwise the control might appear stuck) }
-end;
-
-function TTntDBRichEdit.GetDataSource: TDataSource;
-begin
- Result := FDataLink.DataSource;
-end;
-
-procedure TTntDBRichEdit.SetDataSource(Value: TDataSource);
-begin
- FDataLink.DataSource := Value;
- if Value <> nil then Value.FreeNotification(Self);
-end;
-
-function TTntDBRichEdit.GetDataField: WideString;
-begin
- Result := FDataLink.FieldName;
-end;
-
-procedure TTntDBRichEdit.SetDataField(const Value: WideString);
-begin
- FDataLink.FieldName := Value;
-end;
-
-function TTntDBRichEdit.GetReadOnly: Boolean;
-begin
- Result := FDataLink.ReadOnly;
-end;
-
-procedure TTntDBRichEdit.SetReadOnly(Value: Boolean);
-begin
- FDataLink.ReadOnly := Value;
-end;
-
-function TTntDBRichEdit.GetField: TField;
-begin
- Result := FDataLink.Field;
-end;
-
-procedure TTntDBRichEdit.InternalLoadMemo;
-var
- Stream: TStringStream{TNT-ALLOW TStringStream};
-begin
- if PlainText then
- Text := GetAsWideString(Field)
- else begin
- Stream := TStringStream{TNT-ALLOW TStringStream}.Create(Field.AsString{TNT-ALLOW AsString});
- try
- Lines.LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
- end;
-end;
-
-procedure TTntDBRichEdit.LoadMemo;
-begin
- if not FMemoLoaded and Assigned(Field) and FieldIsBlobLike(Field) then
- begin
- try
- InternalLoadMemo;
- FMemoLoaded := True;
- except
- { Rich Edit Load failure }
- on E:EOutOfResources do
- Lines.Text := WideFormat('(%s)', [E.Message]);
- end;
- EditingChange(Self);
- end;
-end;
-
-procedure TTntDBRichEdit.DataChange(Sender: TObject);
-begin
- if Field <> nil then
- if FieldIsBlobLike(Field) then
- begin
- if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
- begin
- { Check if the data has changed since we read it the first time }
- if (FDataSave <> '') and (FDataSave = Field.AsString{TNT-ALLOW AsString}) then Exit;
- FMemoLoaded := False;
- LoadMemo;
- end else
- begin
- Text := WideFormat('(%s)', [Field.DisplayName]);
- FMemoLoaded := False;
- end;
- end else
- begin
- if FFocused and FDataLink.CanModify then
- Text := GetWideText(Field)
- else
- Text := GetWideDisplayText(Field);
- FMemoLoaded := True;
- end
- else
- begin
- if csDesigning in ComponentState then Text := Name else Text := '';
- FMemoLoaded := False;
- end;
- if HandleAllocated then
- RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
-end;
-
-procedure TTntDBRichEdit.EditingChange(Sender: TObject);
-begin
- inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
-end;
-
-procedure TTntDBRichEdit.InternalSaveMemo;
-var
- Stream: TStringStream{TNT-ALLOW TStringStream};
-begin
- if PlainText then
- SetAsWideString(Field, Text)
- else begin
- Stream := TStringStream{TNT-ALLOW TStringStream}.Create('');
- try
- Lines.SaveToStream(Stream);
- Field.AsString{TNT-ALLOW AsString} := Stream.DataString;
- finally
- Stream.Free;
- end;
- end;
-end;
-
-procedure TTntDBRichEdit.UpdateData(Sender: TObject);
-begin
- if FieldIsBlobLike(Field) then
- InternalSaveMemo
- else
- SetAsWideString(Field, Text);
-end;
-
-procedure TTntDBRichEdit.SetFocused(Value: Boolean);
-begin
- if FFocused <> Value then
- begin
- FFocused := Value;
- if not Assigned(Field) or not FieldIsBlobLike(Field) then
- FDataLink.Reset;
- end;
-end;
-
-procedure TTntDBRichEdit.CMEnter(var Message: TCMEnter);
-begin
- SetFocused(True);
- inherited;
-end;
-
-procedure TTntDBRichEdit.CMExit(var Message: TCMExit);
-begin
- try
- FDataLink.UpdateRecord;
- except
- SetFocus;
- raise;
- end;
- SetFocused(False);
- inherited;
-end;
-
-procedure TTntDBRichEdit.SetAutoDisplay(Value: Boolean);
-begin
- if FAutoDisplay <> Value then
- begin
- FAutoDisplay := Value;
- if Value then LoadMemo;
- end;
-end;
-
-procedure TTntDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
-begin
- if not FMemoLoaded then LoadMemo else inherited;
-end;
-
-procedure TTntDBRichEdit.WMCut(var Message: TMessage);
-begin
- BeginEditing;
- inherited;
-end;
-
-procedure TTntDBRichEdit.WMPaste(var Message: TMessage);
-begin
- BeginEditing;
- inherited;
-end;
-
-procedure TTntDBRichEdit.CMGetDataLink(var Message: TMessage);
-begin
- Message.Result := Integer(FDataLink);
-end;
-
-function TTntDBRichEdit.ExecuteAction(Action: TBasicAction): Boolean;
-begin
- Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
- FDataLink.ExecuteAction(Action);
-end;
-
-function TTntDBRichEdit.UpdateAction(Action: TBasicAction): Boolean;
-begin
- Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
- FDataLink.UpdateAction(Action);
-end;
-
-{ TTntDBMemo }
-
-constructor TTntDBMemo.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- inherited ReadOnly := True;
- ControlStyle := ControlStyle + [csReplicatable];
- FAutoDisplay := True;
- FDataLink := TFieldDataLink.Create;
- FDataLink.Control := Self;
- FDataLink.OnDataChange := DataChange;
- FDataLink.OnEditingChange := EditingChange;
- FDataLink.OnUpdateData := UpdateData;
- FPaintControl := TTntPaintControl.Create(Self, 'EDIT');
-end;
-
-destructor TTntDBMemo.Destroy;
-begin
- FPaintControl.Free;
- FDataLink.Free;
- FDataLink := nil;
- inherited Destroy;
-end;
-
-procedure TTntDBMemo.Loaded;
-begin
- inherited Loaded;
- if (csDesigning in ComponentState) then DataChange(Self);
-end;
-
-procedure TTntDBMemo.Notification(AComponent: TComponent;
- Operation: TOperation);
-begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (FDataLink <> nil) and
- (AComponent = DataSource) then DataSource := nil;
-end;
-
-function TTntDBMemo.UseRightToLeftAlignment: Boolean;
-begin
- Result := DBUseRightToLeftAlignment(Self, Field);
-end;
-
-procedure TTntDBMemo.KeyDown(var Key: Word; Shift: TShiftState);
-begin
- inherited KeyDown(Key, Shift);
- if FMemoLoaded then
- begin
- if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
- FDataLink.Edit;
- end;
-end;
-
-procedure TTntDBMemo.KeyPress(var Key: Char{TNT-ALLOW Char});
-begin
- inherited KeyPress(Key);
- if FMemoLoaded then
- begin
- if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
- not FDataLink.Field.IsValidChar(Key) then
- begin
- MessageBeep(0);
- Key := #0;
- end;
- case Key of
- ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
- FDataLink.Edit;
- #27:
- FDataLink.Reset;
- end;
- end else
- begin
- if Key = #13 then LoadMemo;
- Key := #0;
- end;
-end;
-
-procedure TTntDBMemo.Change;
-begin
- if FMemoLoaded then FDataLink.Modified;
- FMemoLoaded := True;
- inherited Change;
-end;
-
-function TTntDBMemo.GetDataSource: TDataSource;
-begin
- Result := FDataLink.DataSource;
-end;
-
-procedure TTntDBMemo.SetDataSource(Value: TDataSource);
-begin
- if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
- FDataLink.DataSource := Value;
- if Value <> nil then Value.FreeNotification(Self);
-end;
-
-function TTntDBMemo.GetDataField: WideString;
-begin
- Result := FDataLink.FieldName;
-end;
-
-procedure TTntDBMemo.SetDataField(const Value: WideString);
-begin
- FDataLink.FieldName := Value;
-end;
-
-function TTntDBMemo.GetReadOnly: Boolean;
-begin
- Result := FDataLink.ReadOnly;
-end;
-
-procedure TTntDBMemo.SetReadOnly(Value: Boolean);
-begin
- FDataLink.ReadOnly := Value;
-end;
-
-function TTntDBMemo.GetField: TField;
-begin
- Result := FDataLink.Field;
-end;
-
-procedure TTntDBMemo.LoadMemo;
-begin
- if not FMemoLoaded and Assigned(FDataLink.Field) and FieldIsBlobLike(FDataLink.Field) then
- begin
- try
- Lines.Text := GetAsWideString(FDataLink.Field);
- FMemoLoaded := True;
- except
- { Memo too large }
- on E:EInvalidOperation do
- Lines.Text := WideFormat('(%s)', [E.Message]);
- end;
- EditingChange(Self);
- end;
-end;
-
-procedure TTntDBMemo.DataChange(Sender: TObject);
-begin
- if FDataLink.Field <> nil then
- if FieldIsBlobLike(FDataLink.Field) then
- begin
- if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
- begin
- FMemoLoaded := False;
- LoadMemo;
- end else
- begin
- Text := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
- FMemoLoaded := False;
- EditingChange(Self);
- end;
- end else
- begin
- if FFocused and FDataLink.CanModify then
- Text := GetWideText(FDataLink.Field)
- else
- Text := GetWideDisplayText(FDataLink.Field);
- FMemoLoaded := True;
- end
- else
- begin
- if csDesigning in ComponentState then Text := Name else Text := '';
- FMemoLoaded := False;
- end;
- if HandleAllocated then
- RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
-end;
-
-procedure TTntDBMemo.EditingChange(Sender: TObject);
-begin
- inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
-end;
-
-procedure TTntDBMemo.UpdateData(Sender: TObject);
-begin
- SetAsWideString(FDataLink.Field, Text);
-end;
-
-procedure TTntDBMemo.SetFocused(Value: Boolean);
-begin
- if FFocused <> Value then
- begin
- FFocused := Value;
- if not Assigned(FDataLink.Field) or not FieldIsBlobLike(FDataLink.Field) then
- FDataLink.Reset;
- end;
-end;
-
-procedure TTntDBMemo.WndProc(var Message: TMessage);
-begin
- with Message do
- if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
- (Msg = CM_FONTCHANGED) then FPaintControl.DestroyHandle;
- inherited;
-end;
-
-procedure TTntDBMemo.CMEnter(var Message: TCMEnter);
-begin
- SetFocused(True);
- inherited;
-end;
-
-procedure TTntDBMemo.CMExit(var Message: TCMExit);
-begin
- try
- FDataLink.UpdateRecord;
- except
- SetFocus;
- raise;
- end;
- SetFocused(False);
- inherited;
-end;
-
-procedure TTntDBMemo.SetAutoDisplay(Value: Boolean);
-begin
- if FAutoDisplay <> Value then
- begin
- FAutoDisplay := Value;
- if Value then LoadMemo;
- end;
-end;
-
-procedure TTntDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
-begin
- if not FMemoLoaded then LoadMemo else inherited;
-end;
-
-procedure TTntDBMemo.WMCut(var Message: TMessage);
-begin
- FDataLink.Edit;
- inherited;
-end;
-
-procedure TTntDBMemo.WMUndo(var Message: TMessage);
-begin
- FDataLink.Edit;
- inherited;
-end;
-
-procedure TTntDBMemo.WMPaste(var Message: TMessage);
-begin
- FDataLink.Edit;
- inherited;
-end;
-
-procedure TTntDBMemo.CMGetDataLink(var Message: TMessage);
-begin
- Message.Result := Integer(FDataLink);
-end;
-
-procedure TTntDBMemo.WMPaint(var Message: TWMPaint);
-var
- S: WideString;
-begin
- if not (csPaintCopy in ControlState) then
- inherited
- else begin
- if FDataLink.Field <> nil then
- if FieldIsBlobLike(FDataLink.Field) then
- begin
- if FAutoDisplay then
- S := TntAdjustLineBreaks(GetAsWideString(FDataLink.Field)) else
- S := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
- end else
- S := GetWideDisplayText(FDataLink.Field);
- if (not Win32PlatformIsUnicode) then
- SendMessageA(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PAnsiChar(AnsiString(S))))
- else begin
- SendMessageW(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PWideChar(S)));
- end;
- SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Integer(Message.DC), 0);
- SendMessage(FPaintControl.Handle, WM_PAINT, Integer(Message.DC), 0);
- end;
-end;
-
-function TTntDBMemo.ExecuteAction(Action: TBasicAction): Boolean;
-begin
- Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
- FDataLink.ExecuteAction(Action);
-end;
-
-function TTntDBMemo.UpdateAction(Action: TBasicAction): Boolean;
-begin
- Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
- FDataLink.UpdateAction(Action);
-end;
-
-{ TTntDBRadioGroup }
-
-constructor TTntDBRadioGroup.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FDataLink := TFieldDataLink.Create;
- FDataLink.Control := Self;
- FDataLink.OnDataChange := DataChange;
- FDataLink.OnUpdateData := UpdateData;
- FValues := TTntStringList.Create;
-end;
-
-destructor TTntDBRadioGroup.Destroy;
-begin
- FDataLink.Free;
- FDataLink := nil;
- FValues.Free;
- inherited Destroy;
-end;
-
-procedure TTntDBRadioGroup.Notification(AComponent: TComponent;
- Operation: TOperation);
-begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (FDataLink <> nil) and
- (AComponent = DataSource) then DataSource := nil;
-end;
-
-function TTntDBRadioGroup.UseRightToLeftAlignment: Boolean;
-begin
- Result := inherited UseRightToLeftAlignment;
-end;
-
-procedure TTntDBRadioGroup.DataChange(Sender: TObject);
-begin
- if FDataLink.Field <> nil then
- Value := GetWideText(FDataLink.Field) else
- Value := '';
-end;
-
-procedure TTntDBRadioGroup.UpdateData(Sender: TObject);
-begin
- if FDataLink.Field <> nil then
- SetWideText(FDataLink.Field, Value);
-end;
-
-function TTntDBRadioGroup.GetDataSource: TDataSource;
-begin
- Result := FDataLink.DataSource;
-end;
-
-procedure TTntDBRadioGroup.SetDataSource(Value: TDataSource);
-begin
- FDataLink.DataSource := Value;
- if Value <> nil then Value.FreeNotification(Self);
-end;
-
-function TTntDBRadioGroup.GetDataField: WideString;
-begin
- Result := FDataLink.FieldName;
-end;
-
-procedure TTntDBRadioGroup.SetDataField(const Value: WideString);
-begin
- FDataLink.FieldName := Value;
-end;
-
-function TTntDBRadioGroup.GetReadOnly: Boolean;
-begin
- Result := FDataLink.ReadOnly;
-end;
-
-procedure TTntDBRadioGroup.SetReadOnly(Value: Boolean);
-begin
- FDataLink.ReadOnly := Value;
-end;
-
-function TTntDBRadioGroup.GetField: TField;
-begin
- Result := FDataLink.Field;
-end;
-
-function TTntDBRadioGroup.GetButtonValue(Index: Integer): WideString;
-begin
- if (Index < FValues.Count) and (FValues[Index] <> '') then
- Result := FValues[Index]
- else if Index < Items.Count then
- Result := Items[Index]
- else
- Result := '';
-end;
-
-procedure TTntDBRadioGroup.SetValue(const Value: WideString);
-var
- WasFocused: Boolean;
- I, Index: Integer;
-begin
- if FValue <> Value then
- begin
- FInSetValue := True;
- try
- WasFocused := (ItemIndex > -1) and (Buttons[ItemIndex].Focused);
- Index := -1;
- for I := 0 to Items.Count - 1 do
- if Value = GetButtonValue(I) then
- begin
- Index := I;
- Break;
- end;
- ItemIndex := Index;
- // Move the focus rect along with the selected index
- if WasFocused then
- Buttons[ItemIndex].SetFocus;
- finally
- FInSetValue := False;
- end;
- FValue := Value;
- Change;
- end;
-end;
-
-procedure TTntDBRadioGroup.CMExit(var Message: TCMExit);
-begin
- try
- FDataLink.UpdateRecord;
- except
- if ItemIndex >= 0 then
- (Controls[ItemIndex] as TTntRadioButton).SetFocus else
- (Controls[0] as TTntRadioButton).SetFocus;
- raise;
- end;
- inherited;
-end;
-
-procedure TTntDBRadioGroup.CMGetDataLink(var Message: TMessage);
-begin
- Message.Result := Integer(FDataLink);
-end;
-
-procedure TTntDBRadioGroup.Click;
-begin
- if not FInSetValue then
- begin
- inherited Click;
- if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex);
- if FDataLink.Editing then FDataLink.Modified;
- end;
-end;
-
-procedure TTntDBRadioGroup.SetItems(Value: TTntStrings);
-begin
- Items.Assign(Value);
- DataChange(Self);
-end;
-
-procedure TTntDBRadioGroup.SetValues(Value: TTntStrings);
-begin
- FValues.Assign(Value);
- DataChange(Self);
-end;
-
-procedure TTntDBRadioGroup.Change;
-begin
- if Assigned(FOnChange) then FOnChange(Self);
-end;
-
-procedure TTntDBRadioGroup.KeyPress(var Key: Char{TNT-ALLOW Char});
-begin
- inherited KeyPress(Key);
- case Key of
- #8, ' ': FDataLink.Edit;
- #27: FDataLink.Reset;
- end;
-end;
-
-function TTntDBRadioGroup.CanModify: Boolean;
-begin
- Result := FDataLink.Edit;
-end;
-
-function TTntDBRadioGroup.ExecuteAction(Action: TBasicAction): Boolean;
-begin
- Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
- DataLink.ExecuteAction(Action);
-end;
-
-function TTntDBRadioGroup.UpdateAction(Action: TBasicAction): Boolean;
-begin
- Result := inherited UpdateAction(Action) or (DataLink <> nil) and
- DataLink.UpdateAction(Action);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas deleted file mode 100644 index 2664bf7b5a..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBGrids.pas +++ /dev/null @@ -1,1175 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntDBGrids;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, TntClasses, Controls, Windows, Grids, DBGrids, Messages, DBCtrls, DB, TntStdCtrls;
-
-type
-{TNT-WARN TColumnTitle}
- TTntColumnTitle = class(TColumnTitle{TNT-ALLOW TColumnTitle})
- private
- FCaption: WideString;
- procedure SetInheritedCaption(const Value: AnsiString);
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function IsCaptionStored: Boolean;
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- procedure RestoreDefaults; override;
- function DefaultCaption: WideString;
- published
- property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
- end;
-
-{TNT-WARN TColumn}
-type
- TTntColumn = class(TColumn{TNT-ALLOW TColumn})
- private
- FWidePickList: TTntStrings;
- function GetWidePickList: TTntStrings;
- procedure SetWidePickList(const Value: TTntStrings);
- procedure HandlePickListChange(Sender: TObject);
- function GetTitle: TTntColumnTitle;
- procedure SetTitle(const Value: TTntColumnTitle);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- function CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle}; override;
- public
- destructor Destroy; override;
- property WidePickList: TTntStrings read GetWidePickList write SetWidePickList;
- published
-{TNT-WARN PickList}
- property PickList{TNT-ALLOW PickList}: TTntStrings read GetWidePickList write SetWidePickList;
- property Title: TTntColumnTitle read GetTitle write SetTitle;
- end;
-
- { TDBGridInplaceEdit adds support for a button on the in-place editor,
- which can be used to drop down a table-based lookup list, a stringlist-based
- pick list, or (if button style is esEllipsis) fire the grid event
- OnEditButtonClick. }
-
-type
- TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit} = class(TInplaceEditList)
- private
- {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
- FDataList: TDBLookupListBox; // 1st field - Delphi/BCB 6 TCustomDBGrid assumes this
- FUseDataList: Boolean; // 2nd field - Delphi/BCB 6 TCustomDBGrid assumes this
- {$ENDIF}
- {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
- FDataList: TDBLookupListBox; // 1st field - Delphi 7 TCustomDBGrid assumes this
- FUseDataList: Boolean; // 2nd field - Delphi 7 TCustomDBGrid assumes this
- {$ENDIF}
- {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
- FDataList: TDBLookupListBox; // 1st field - Delphi 9 TCustomDBGrid assumes this
- FUseDataList: Boolean; // 2nd field - Delphi 9 TCustomDBGrid assumes this
- {$ENDIF}
- {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
- FDataList: TDBLookupListBox; // 1st field - Delphi 10 TCustomDBGrid assumes this
- FUseDataList: Boolean; // 2nd field - Delphi 10 TCustomDBGrid assumes this
- {$ENDIF}
- FLookupSource: TDatasource;
- FWidePickListBox: TTntCustomListbox;
- function GetWidePickListBox: TTntCustomListbox;
- protected
- procedure CloseUp(Accept: Boolean); override;
- procedure DoEditButtonClick; override;
- procedure DropDown; override;
- procedure UpdateContents; override;
- property UseDataList: Boolean read FUseDataList;
- public
- constructor Create(Owner: TComponent); override;
- property DataList: TDBLookupListBox read FDataList;
- property WidePickListBox: TTntCustomListbox read GetWidePickListBox;
- end;
-
-type
-{TNT-WARN TDBGridInplaceEdit}
- TTntDBGridInplaceEdit = class(TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit})
- private
- FInDblClick: Boolean;
- FBlockSetText: Boolean;
- procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
- protected
- function GetText: WideString; virtual;
- procedure SetText(const Value: WideString); virtual;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure UpdateContents; override;
- procedure DblClick; override;
- public
- property Text: WideString read GetText write SetText;
- end;
-
-{TNT-WARN TDBGridColumns}
- TTntDBGridColumns = class(TDBGridColumns{TNT-ALLOW TDBGridColumns})
- private
- function GetColumn(Index: Integer): TTntColumn;
- procedure SetColumn(Index: Integer; const Value: TTntColumn);
- public
- function Add: TTntColumn;
- property Items[Index: Integer]: TTntColumn read GetColumn write SetColumn; default;
- end;
-
- TTntGridDataLink = class(TGridDataLink)
- private
- OriginalSetText: TFieldSetTextEvent;
- procedure GridUpdateFieldText(Sender: TField; const Text: AnsiString);
- protected
- procedure UpdateData; override;
- procedure RecordChanged(Field: TField); override;
- end;
-
-{TNT-WARN TCustomDBGrid}
- TTntCustomDBGrid = class(TCustomDBGrid{TNT-ALLOW TCustomDBGrid})
- private
- FEditText: WideString;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure WMChar(var Msg: TWMChar); message WM_CHAR;
- function GetColumns: TTntDBGridColumns;
- procedure SetColumns(const Value: TTntDBGridColumns);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure ShowEditorChar(Ch: WideChar); dynamic;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- function CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns}; override;
- property Columns: TTntDBGridColumns read GetColumns write SetColumns;
- function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
- function CreateDataLink: TGridDataLink; override;
- function GetEditText(ACol, ARow: Longint): WideString; reintroduce;
- procedure DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
- procedure SetEditText(ACol, ARow: Longint; const Value: AnsiString); override;
- public
- procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
- Column: TTntColumn; State: TGridDrawState); dynamic;
- procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
- State: TGridDrawState);
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TDBGrid}
- TTntDBGrid = class(TTntCustomDBGrid)
- public
- property Canvas;
- property SelectedRows;
- published
- property Align;
- property Anchors;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property Columns stored False; //StoreColumns;
- property Constraints;
- property Ctl3D;
- property DataSource;
- property DefaultDrawing;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property FixedColor;
- property Font;
- property ImeMode;
- property ImeName;
- property Options;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ReadOnly;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property TitleFont;
- property Visible;
- property OnCellClick;
- property OnColEnter;
- property OnColExit;
- property OnColumnMoved;
- property OnDrawDataCell; { obsolete }
- property OnDrawColumnCell;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEditButtonClick;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnMouseWheelDown;
- property OnMouseWheelUp;
- property OnStartDock;
- property OnStartDrag;
- property OnTitleClick;
- end;
-
-implementation
-
-uses
- SysUtils, TntControls, Math, Variants, Forms,
- TntGraphics, Graphics, TntDB, TntActnList, TntSysUtils, TntWindows;
-
-{ TTntColumnTitle }
-
-procedure TTntColumnTitle.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntColumnTitle.DefaultCaption: WideString;
-var
- Field: TField;
-begin
- Field := Column.Field;
- if Assigned(Field) then
- Result := Field.DisplayName
- else
- Result := Column.FieldName;
-end;
-
-function TTntColumnTitle.IsCaptionStored: Boolean;
-begin
- Result := (cvTitleCaption in Column.AssignedValues) and
- (FCaption <> DefaultCaption);
-end;
-
-procedure TTntColumnTitle.SetInheritedCaption(const Value: AnsiString);
-begin
- inherited Caption := Value;
-end;
-
-function TTntColumnTitle.GetCaption: WideString;
-begin
- if cvTitleCaption in Column.AssignedValues then
- Result := GetSyncedWideString(FCaption, inherited Caption)
- else
- Result := DefaultCaption;
-end;
-
-procedure TTntColumnTitle.SetCaption(const Value: WideString);
-begin
- if not (Column as TTntColumn).IsStored then
- inherited Caption := Value
- else begin
- if (cvTitleCaption in Column.AssignedValues) and (Value = FCaption) then Exit;
- SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
- end;
-end;
-
-procedure TTntColumnTitle.Assign(Source: TPersistent);
-begin
- inherited Assign(Source);
- if Source is TTntColumnTitle then
- begin
- if cvTitleCaption in TTntColumnTitle(Source).Column.AssignedValues then
- Caption := TTntColumnTitle(Source).Caption;
- end;
-end;
-
-procedure TTntColumnTitle.RestoreDefaults;
-begin
- FCaption := '';
- inherited;
-end;
-
-{ TTntColumn }
-
-procedure TTntColumn.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntColumn.CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle};
-begin
- Result := TTntColumnTitle.Create(Self);
-end;
-
-function TTntColumn.GetTitle: TTntColumnTitle;
-begin
- Result := (inherited Title) as TTntColumnTitle;
-end;
-
-procedure TTntColumn.SetTitle(const Value: TTntColumnTitle);
-begin
- inherited Title := Value;
-end;
-
-function TTntColumn.GetWidePickList: TTntStrings;
-begin
- if FWidePickList = nil then begin
- FWidePickList := TTntStringList.Create;
- TTntStringList(FWidePickList).OnChange := HandlePickListChange;
- end;
- Result := FWidePickList;
-end;
-
-procedure TTntColumn.SetWidePickList(const Value: TTntStrings);
-begin
- if Value = nil then
- begin
- FWidePickList.Free;
- FWidePickList := nil;
- (inherited PickList{TNT-ALLOW PickList}).Clear;
- Exit;
- end;
- WidePickList.Assign(Value);
-end;
-
-procedure TTntColumn.HandlePickListChange(Sender: TObject);
-begin
- inherited PickList{TNT-ALLOW PickList}.Assign(WidePickList);
-end;
-
-destructor TTntColumn.Destroy;
-begin
- inherited;
- FWidePickList.Free;
-end;
-
-{ TTntPopupListbox }
-type
- TTntPopupListbox = class(TTntCustomListbox)
- private
- FSearchText: WideString;
- FSearchTickCount: Longint;
- protected
- procedure CreateParams(var Params: TCreateParams); override;
- procedure CreateWnd; override;
- procedure WMChar(var Message: TWMChar); message WM_CHAR;
- procedure KeyPressW(var Key: WideChar);
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- end;
-
-procedure TTntPopupListbox.CreateParams(var Params: TCreateParams);
-begin
- inherited CreateParams(Params);
- with Params do
- begin
- Style := Style or WS_BORDER;
- ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
- AddBiDiModeExStyle(ExStyle);
- WindowClass.Style := CS_SAVEBITS;
- end;
-end;
-
-procedure TTntPopupListbox.CreateWnd;
-begin
- inherited CreateWnd;
- Windows.SetParent(Handle, 0);
- CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
-end;
-
-procedure TTntPopupListbox.WMChar(var Message: TWMChar);
-var
- Key: WideChar;
-begin
- Key := GetWideCharFromWMCharMsg(Message);
- KeyPressW(Key);
- SetWideCharForWMCharMsg(Message, Key);
- inherited;
-end;
-
-procedure TTntPopupListbox.KeypressW(var Key: WideChar);
-var
- TickCount: Integer;
-begin
- case Key of
- #8, #27: FSearchText := '';
- #32..High(WideChar):
- begin
- TickCount := GetTickCount;
- if TickCount - FSearchTickCount > 2000 then FSearchText := '';
- FSearchTickCount := TickCount;
- if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
- if IsWindowUnicode(Handle) then
- SendMessageW(Handle, LB_SelectString, WORD(-1), Longint(PWideChar(FSearchText)))
- else
- SendMessageA(Handle, LB_SelectString, WORD(-1), Longint(PAnsiChar(AnsiString(FSearchText))));
- Key := #0;
- end;
- end;
-end;
-
-procedure TTntPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited MouseUp(Button, Shift, X, Y);
- (Owner as TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}).CloseUp((X >= 0) and (Y >= 0) and
- (X < Width) and (Y < Height));
-end;
-
-{ TTntPopupDataList }
-type
- TTntPopupDataList = class(TPopupDataList)
- protected
- procedure Paint; override;
- end;
-
-procedure TTntPopupDataList.Paint;
-var
- FRecordIndex: Integer;
- FRecordCount: Integer;
- FKeySelected: Boolean;
- FKeyField: TField;
-
- procedure UpdateListVars;
- begin
- if ListActive then
- begin
- FRecordIndex := ListLink.ActiveRecord;
- FRecordCount := ListLink.RecordCount;
- FKeySelected := not VarIsNull(KeyValue) or
- not ListLink.DataSet.BOF;
- end else
- begin
- FRecordIndex := 0;
- FRecordCount := 0;
- FKeySelected := False;
- end;
-
- FKeyField := nil;
- if ListLink.Active and (KeyField <> '') then
- FKeyField := GetFieldProperty(ListLink.DataSet, Self, KeyField);
- end;
-
- function VarEquals(const V1, V2: Variant): Boolean;
- begin
- Result := False;
- try
- Result := V1 = V2;
- except
- end;
- end;
-
-var
- I, J, W, X, TxtWidth, TxtHeight, LastFieldIndex: Integer;
- S: WideString;
- R: TRect;
- Selected: Boolean;
- Field: TField;
- AAlignment: TAlignment;
-begin
- UpdateListVars;
- Canvas.Font := Font;
- TxtWidth := WideCanvasTextWidth(Canvas, '0');
- TxtHeight := WideCanvasTextHeight(Canvas, '0');
- LastFieldIndex := ListFields.Count - 1;
- if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
- Canvas.Pen.Color := clBtnFace else
- Canvas.Pen.Color := clBtnShadow;
- for I := 0 to RowCount - 1 do
- begin
- if Enabled then
- Canvas.Font.Color := Font.Color else
- Canvas.Font.Color := clGrayText;
- Canvas.Brush.Color := Color;
- Selected := not FKeySelected and (I = 0);
- R.Top := I * TxtHeight;
- R.Bottom := R.Top + TxtHeight;
- if I < FRecordCount then
- begin
- ListLink.ActiveRecord := I;
- if not VarIsNull(KeyValue) and
- VarEquals(FKeyField.Value, KeyValue) then
- begin
- Canvas.Font.Color := clHighlightText;
- Canvas.Brush.Color := clHighlight;
- Selected := True;
- end;
- R.Right := 0;
- for J := 0 to LastFieldIndex do
- begin
- Field := ListFields[J];
- if J < LastFieldIndex then
- W := Field.DisplayWidth * TxtWidth + 4 else
- W := ClientWidth - R.Right;
- S := GetWideDisplayText(Field);
- X := 2;
- AAlignment := Field.Alignment;
- if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
- case AAlignment of
- taRightJustify: X := W - WideCanvasTextWidth(Canvas, S) - 3;
- taCenter: X := (W - WideCanvasTextWidth(Canvas, S)) div 2;
- end;
- R.Left := R.Right;
- R.Right := R.Right + W;
- if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags;
- WideCanvasTextRect(Canvas, R, R.Left + X, R.Top, S);
- if J < LastFieldIndex then
- begin
- Canvas.MoveTo(R.Right, R.Top);
- Canvas.LineTo(R.Right, R.Bottom);
- Inc(R.Right);
- if R.Right >= ClientWidth then Break;
- end;
- end;
- end;
- R.Left := 0;
- R.Right := ClientWidth;
- if I >= FRecordCount then Canvas.FillRect(R);
- if Selected then
- Canvas.DrawFocusRect(R);
- end;
- if FRecordCount <> 0 then ListLink.ActiveRecord := FRecordIndex;
-end;
-
-//-----------------------------------------------------------------------------------------
-// TDBGridInplaceEdit - Delphi 6 and higher
-//-----------------------------------------------------------------------------------------
-
-constructor TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.Create(Owner: TComponent);
-begin
- inherited Create(Owner);
- FLookupSource := TDataSource.Create(Self);
-end;
-
-function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.GetWidePickListBox: TTntCustomListBox;
-var
- PopupListbox: TTntPopupListbox;
-begin
- if not Assigned(FWidePickListBox) then
- begin
- PopupListbox := TTntPopupListbox.Create(Self);
- PopupListbox.Visible := False;
- PopupListbox.Parent := Self;
- PopupListbox.OnMouseUp := ListMouseUp;
- PopupListbox.IntegralHeight := True;
- PopupListbox.ItemHeight := 11;
- FWidePickListBox := PopupListBox;
- end;
- Result := FWidePickListBox;
-end;
-
-procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.CloseUp(Accept: Boolean);
-var
- MasterField: TField;
- ListValue: Variant;
-begin
- if ListVisible then
- begin
- if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
- if ActiveList = DataList then
- ListValue := DataList.KeyValue
- else
- if WidePickListBox.ItemIndex <> -1 then
- ListValue := WidePickListBox.Items[WidePickListBox.ItemIndex];
- SetWindowPos(ActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
- SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
- ListVisible := False;
- if Assigned(FDataList) then
- FDataList.ListSource := nil;
- FLookupSource.Dataset := nil;
- Invalidate;
- if Accept then
- if ActiveList = DataList then
- with Grid as TTntCustomDBGrid, Columns[SelectedIndex].Field do
- begin
- MasterField := DataSet.FieldByName(KeyFields);
- if MasterField.CanModify and DataLink.Edit then
- MasterField.Value := ListValue;
- end
- else
- if (not VarIsNull(ListValue)) and EditCanModify then
- with Grid as TTntCustomDBGrid do
- SetWideText(Columns[SelectedIndex].Field, ListValue)
- end;
-end;
-
-procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DoEditButtonClick;
-begin
- (Grid as TTntCustomDBGrid).EditButtonClick;
-end;
-
-type TAccessTntCustomListbox = class(TTntCustomListbox);
-
-procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DropDown;
-var
- Column: TTntColumn;
- I, J, Y: Integer;
-begin
- if not ListVisible then
- begin
- with (Grid as TTntCustomDBGrid) do
- Column := Columns[SelectedIndex] as TTntColumn;
- if ActiveList = FDataList then
- with Column.Field do
- begin
- FDataList.Color := Color;
- FDataList.Font := Font;
- FDataList.RowCount := Column.DropDownRows;
- FLookupSource.DataSet := LookupDataSet;
- FDataList.KeyField := LookupKeyFields;
- FDataList.ListField := LookupResultField;
- FDataList.ListSource := FLookupSource;
- FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
- end
- else if ActiveList = WidePickListBox then
- begin
- WidePickListBox.Items.Assign(Column.WidePickList);
- DropDownRows := Column.DropDownRows;
- // this is needed as inherited doesn't know about our WidePickListBox
- if (DropDownRows > 0) and (WidePickListBox.Items.Count >= DropDownRows) then
- WidePickListBox.Height := DropDownRows * TAccessTntCustomListbox(WidePickListBox as TTntCustomListbox).ItemHeight + 4
- else
- WidePickListBox.Height := WidePickListBox.Items.Count * TAccessTntCustomListbox(WidePickListBox as TTntCustomListbox).ItemHeight + 4;
- if Text = '' then
- WidePickListBox.ItemIndex := -1
- else
- WidePickListBox.ItemIndex := WidePickListBox.Items.IndexOf(Text);
- J := WidePickListBox.ClientWidth;
- for I := 0 to WidePickListBox.Items.Count - 1 do
- begin
- Y := WideCanvasTextWidth(WidePickListBox.Canvas, WidePickListBox.Items[I]);
- if Y > J then J := Y;
- end;
- WidePickListBox.ClientWidth := J;
- end;
- end;
- inherited DropDown;
-end;
-
-procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.UpdateContents;
-var
- Column: TTntColumn;
-begin
- inherited UpdateContents;
- if EditStyle = esPickList then
- ActiveList := WidePickListBox;
- if FUseDataList then
- begin
- if FDataList = nil then
- begin
- FDataList := TTntPopupDataList.Create(Self);
- FDataList.Visible := False;
- FDataList.Parent := Self;
- FDataList.OnMouseUp := ListMouseUp;
- end;
- ActiveList := FDataList;
- end;
- with (Grid as TTntCustomDBGrid) do
- Column := Columns[SelectedIndex] as TTntColumn;
- Self.ReadOnly := Column.ReadOnly;
- Font.Assign(Column.Font);
- ImeMode := Column.ImeMode;
- ImeName := Column.ImeName;
-end;
-
-//-----------------------------------------------------------------------------------------
-
-{ TTntDBGridInplaceEdit }
-
-procedure TTntDBGridInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
-begin
- TntCustomEdit_CreateWindowHandle(Self, Params);
-end;
-
-function TTntDBGridInplaceEdit.GetText: WideString;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntDBGridInplaceEdit.SetText(const Value: WideString);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntDBGridInplaceEdit.WMSetText(var Message: TWMSetText);
-begin
- if (not FBlockSetText) then
- inherited;
-end;
-
-procedure TTntDBGridInplaceEdit.UpdateContents;
-var
- Grid: TTntCustomDBGrid;
-begin
- Grid := Self.Grid as TTntCustomDBGrid;
- EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
- Text := Grid.GetEditText(Grid.Col, Grid.Row);
- MaxLength := Grid.GetEditLimit;
-
- FBlockSetText := True;
- try
- inherited;
- finally
- FBlockSetText := False;
- end;
-end;
-
-procedure TTntDBGridInplaceEdit.DblClick;
-begin
- FInDblClick := True;
- try
- inherited;
- finally
- FInDblClick := False;
- end;
-end;
-
-{ TTntGridDataLink }
-
-procedure TTntGridDataLink.GridUpdateFieldText(Sender: TField; const Text: AnsiString);
-begin
- Sender.OnSetText := OriginalSetText;
- if Assigned(Sender) then
- SetWideText(Sender, (Grid as TTntCustomDBGrid).FEditText);
-end;
-
-procedure TTntGridDataLink.RecordChanged(Field: TField);
-var
- CField: TField;
-begin
- inherited;
- if Grid.HandleAllocated then begin
- CField := Grid.SelectedField;
- if ((Field = nil) or (CField = Field)) and
- (Assigned(CField) and (GetWideText(CField) <> (Grid as TTntCustomDBGrid).FEditText)) then
- begin
- with (Grid as TTntCustomDBGrid) do begin
- InvalidateEditor;
- if InplaceEditor <> nil then InplaceEditor.Deselect;
- end;
- end;
- end;
-end;
-
-procedure TTntGridDataLink.UpdateData;
-var
- Field: TField;
-begin
- Field := (Grid as TTntCustomDBGrid).SelectedField;
- // remember "set text"
- if Field <> nil then
- OriginalSetText := Field.OnSetText;
- try
- // redirect "set text" to self
- if Field <> nil then
- Field.OnSetText := GridUpdateFieldText;
- inherited; // clear modified !
- finally
- // redirect "set text" to field
- if Field <> nil then
- Field.OnSetText := OriginalSetText;
- // forget original "set text"
- OriginalSetText := nil;
- end;
-end;
-
-{ TTntDBGridColumns }
-
-function TTntDBGridColumns.Add: TTntColumn;
-begin
- Result := inherited Add as TTntColumn;
-end;
-
-function TTntDBGridColumns.GetColumn(Index: Integer): TTntColumn;
-begin
- Result := inherited Items[Index] as TTntColumn;
-end;
-
-procedure TTntDBGridColumns.SetColumn(Index: Integer; const Value: TTntColumn);
-begin
- inherited Items[Index] := Value;
-end;
-
-{ TTntCustomDBGrid }
-
-procedure TTntCustomDBGrid.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-type TAccessCustomGrid = class(TCustomGrid);
-
-procedure TTntCustomDBGrid.WMChar(var Msg: TWMChar);
-begin
- if (goEditing in TAccessCustomGrid(Self).Options)
- and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
- RestoreWMCharMsg(TMessage(Msg));
- ShowEditorChar(WideChar(Msg.CharCode));
- end else
- inherited;
-end;
-
-procedure TTntCustomDBGrid.ShowEditorChar(Ch: WideChar);
-begin
- ShowEditor;
- if InplaceEditor <> nil then begin
- if Win32PlatformIsUnicode then
- PostMessageW(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0)
- else
- PostMessageA(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0);
- end;
-end;
-
-procedure TTntCustomDBGrid.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomDBGrid.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomDBGrid.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomDBGrid.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-function TTntCustomDBGrid.CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns};
-begin
- Result := TTntDBGridColumns.Create(Self, TTntColumn);
-end;
-
-function TTntCustomDBGrid.GetColumns: TTntDBGridColumns;
-begin
- Result := inherited Columns as TTntDBGridColumns;
-end;
-
-procedure TTntCustomDBGrid.SetColumns(const Value: TTntDBGridColumns);
-begin
- inherited Columns := Value;
-end;
-
-function TTntCustomDBGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
-begin
- Result := TTntDBGridInplaceEdit.Create(Self);
-end;
-
-function TTntCustomDBGrid.CreateDataLink: TGridDataLink;
-begin
- Result := TTntGridDataLink.Create(Self);
-end;
-
-function TTntCustomDBGrid.GetEditText(ACol, ARow: Integer): WideString;
-var
- Field: TField;
-begin
- Field := GetColField(RawToDataColumn(ACol));
- if Field = nil then
- Result := ''
- else
- Result := GetWideText(Field);
- FEditText := Result;
-end;
-
-procedure TTntCustomDBGrid.SetEditText(ACol, ARow: Integer; const Value: AnsiString);
-begin
- if (InplaceEditor as TTntDBGridInplaceEdit).FInDblClick then
- FEditText := Value
- else
- FEditText := (InplaceEditor as TTntDBGridInplaceEdit).Text;
- inherited;
-end;
-
-//----------------- DRAW CELL PROCS --------------------------------------------------
-var
- DrawBitmap: TBitmap = nil;
-
-procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
- const Text: WideString; Alignment: TAlignment; ARightToLeft: Boolean);
-const
- AlignFlags : array [TAlignment] of Integer =
- ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
- DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
- DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
- RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
-var
- B, R: TRect;
- Hold, Left: Integer;
- I: TColorRef;
-begin
- I := ColorToRGB(ACanvas.Brush.Color);
- if GetNearestColor(ACanvas.Handle, I) = I then
- begin { Use ExtTextOutW for solid colors }
- { In BiDi, because we changed the window origin, the text that does not
- change alignment, actually gets its alignment changed. }
- if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
- ChangeBiDiModeAlignment(Alignment);
- case Alignment of
- taLeftJustify:
- Left := ARect.Left + DX;
- taRightJustify:
- Left := ARect.Right - WideCanvasTextWidth(ACanvas, Text) - 3;
- else { taCenter }
- Left := ARect.Left + (ARect.Right - ARect.Left) div 2
- - (WideCanvasTextWidth(ACanvas, Text) div 2);
- end;
- WideCanvasTextRect(ACanvas, ARect, Left, ARect.Top + DY, Text);
- end
- else begin { Use FillRect and Drawtext for dithered colors }
- DrawBitmap.Canvas.Lock;
- try
- with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
- begin { brush origin tics in painting / scrolling. }
- Width := Max(Width, Right - Left);
- Height := Max(Height, Bottom - Top);
- R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
- B := Rect(0, 0, Right - Left, Bottom - Top);
- end;
- with DrawBitmap.Canvas do
- begin
- Font := ACanvas.Font;
- Font.Color := ACanvas.Font.Color;
- Brush := ACanvas.Brush;
- Brush.Style := bsSolid;
- FillRect(B);
- SetBkMode(Handle, TRANSPARENT);
- if (ACanvas.CanvasOrientation = coRightToLeft) then
- ChangeBiDiModeAlignment(Alignment);
- Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), R,
- AlignFlags[Alignment] or RTL[ARightToLeft]);
- end;
- if (ACanvas.CanvasOrientation = coRightToLeft) then
- begin
- Hold := ARect.Left;
- ARect.Left := ARect.Right;
- ARect.Right := Hold;
- end;
- ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
- finally
- DrawBitmap.Canvas.Unlock;
- end;
- end;
-end;
-
-procedure TTntCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
- State: TGridDrawState);
-var
- Alignment: TAlignment;
- Value: WideString;
-begin
- Alignment := taLeftJustify;
- Value := '';
- if Assigned(Field) then
- begin
- Alignment := Field.Alignment;
- Value := GetWideDisplayText(Field);
- end;
- WriteText(Canvas, Rect, 2, 2, Value, Alignment,
- UseRightToLeftAlignmentForField(Field, Alignment));
-end;
-
-procedure TTntCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
- DataCol: Integer; Column: TTntColumn; State: TGridDrawState);
-var
- Value: WideString;
-begin
- Value := '';
- if Assigned(Column.Field) then
- Value := GetWideDisplayText(Column.Field);
- WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment,
- UseRightToLeftAlignmentForField(Column.Field, Column.Alignment));
-end;
-
-procedure TTntCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
-var
- FrameOffs: Byte;
-
- procedure DrawTitleCell(ACol, ARow: Integer; Column: TTntColumn; var AState: TGridDrawState);
- const
- ScrollArrows: array [Boolean, Boolean] of Integer =
- ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
- var
- MasterCol: TColumn{TNT-ALLOW TColumn};
- TitleRect, TxtRect, ButtonRect: TRect;
- I: Integer;
- InBiDiMode: Boolean;
- begin
- TitleRect := CalcTitleRect(Column, ARow, MasterCol);
-
- if MasterCol = nil then
- begin
- Canvas.FillRect(ARect);
- Exit;
- end;
-
- Canvas.Font := MasterCol.Title.Font;
- Canvas.Brush.Color := MasterCol.Title.Color;
- if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
- InflateRect(TitleRect, -1, -1);
- TxtRect := TitleRect;
- I := GetSystemMetrics(SM_CXHSCROLL);
- if ((TxtRect.Right - TxtRect.Left) > I) and MasterCol.Expandable then
- begin
- Dec(TxtRect.Right, I);
- ButtonRect := TitleRect;
- ButtonRect.Left := TxtRect.Right;
- I := SaveDC(Canvas.Handle);
- try
- Canvas.FillRect(ButtonRect);
- InflateRect(ButtonRect, -1, -1);
- IntersectClipRect(Canvas.Handle, ButtonRect.Left,
- ButtonRect.Top, ButtonRect.Right, ButtonRect.Bottom);
- InflateRect(ButtonRect, 1, 1);
- { DrawFrameControl doesn't draw properly when orienatation has changed.
- It draws as ExtTextOutW does. }
- InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
- if InBiDiMode then { stretch the arrows box }
- Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
- DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
- ScrollArrows[InBiDiMode, MasterCol.Expanded] or DFCS_FLAT);
- finally
- RestoreDC(Canvas.Handle, I);
- end;
- end;
- with (MasterCol.Title as TTntColumnTitle) do
- WriteText(Canvas, TxtRect, FrameOffs, FrameOffs, Caption, Alignment, IsRightToLeft);
- if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
- begin
- InflateRect(TitleRect, 1, 1);
- DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
- DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
- end;
- AState := AState - [gdFixed]; // prevent box drawing later
- end;
-
-var
- OldActive: Integer;
- Highlight: Boolean;
- Value: WideString;
- DrawColumn: TTntColumn;
-begin
- if csLoading in ComponentState then
- begin
- Canvas.Brush.Color := Color;
- Canvas.FillRect(ARect);
- Exit;
- end;
-
- if (gdFixed in AState) and (RawToDataColumn(ACol) < 0) then
- begin
- inherited;
- exit;
- end;
-
- Dec(ARow, FixedRows);
- ACol := RawToDataColumn(ACol);
-
- if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
- [dgRowLines, dgColLines]) then
- begin
- InflateRect(ARect, -1, -1);
- FrameOffs := 1;
- end
- else
- FrameOffs := 2;
-
- with Canvas do
- begin
- DrawColumn := Columns[ACol] as TTntColumn;
- if not DrawColumn.Showing then Exit;
- if not (gdFixed in AState) then
- begin
- Font := DrawColumn.Font;
- Brush.Color := DrawColumn.Color;
- end;
- if ARow < 0 then
- DrawTitleCell(ACol, ARow + FixedRows, DrawColumn, AState)
- else if (DataLink = nil) or not DataLink.Active then
- FillRect(ARect)
- else
- begin
- Value := '';
- OldActive := DataLink.ActiveRecord;
- try
- DataLink.ActiveRecord := ARow;
- if Assigned(DrawColumn.Field) then
- Value := GetWideDisplayText(DrawColumn.Field);
- Highlight := HighlightCell(ACol, ARow, Value, AState);
- if Highlight then
- begin
- Brush.Color := clHighlight;
- Font.Color := clHighlightText;
- end;
- if not Enabled then
- Font.Color := clGrayText;
- if DefaultDrawing then
- DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);
- if Columns.State = csDefault then
- DrawDataCell(ARect, DrawColumn.Field, AState);
- DrawColumnCell(ARect, ACol, DrawColumn, AState);
- finally
- DataLink.ActiveRecord := OldActive;
- end;
- if DefaultDrawing and (gdSelected in AState)
- and ((dgAlwaysShowSelection in Options) or Focused)
- and not (csDesigning in ComponentState)
- and not (dgRowSelect in Options)
- and (UpdateLock = 0)
- and (ValidParentForm(Self).ActiveControl = Self) then
- Windows.DrawFocusRect(Handle, ARect);
- end;
- end;
- if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
- [dgRowLines, dgColLines]) then
- begin
- InflateRect(ARect, 1, 1);
- DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
- DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
- end;
-end;
-
-procedure TTntCustomDBGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomDBGrid.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-initialization
- DrawBitmap := TBitmap.Create;
-
-finalization
- DrawBitmap.Free;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBLogDlg.dfm b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBLogDlg.dfm deleted file mode 100644 index fd0a07196b..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBLogDlg.dfm +++ /dev/null @@ -1,108 +0,0 @@ -object TntLoginDialog: TTntLoginDialog
- Left = 307
- Top = 131
- ActiveControl = Password
- BorderStyle = bsDialog
- Caption = 'Database Login'
- ClientHeight = 147
- ClientWidth = 273
- Color = clBtnFace
- ParentFont = True
-
- Position = poScreenCenter
- OnShow = FormShow
- PixelsPerInch = 96
- TextHeight = 13
- object OKButton: TTntButton
- Left = 109
- Top = 114
- Width = 75
- Height = 25
- Caption = '&OK'
- Default = True
- ModalResult = 1
- TabOrder = 0
- end
- object CancelButton: TTntButton
- Left = 190
- Top = 114
- Width = 75
- Height = 25
- Cancel = True
- Caption = 'Cancel'
- ModalResult = 2
- TabOrder = 1
- end
- object Panel: TTntPanel
- Left = 8
- Top = 7
- Width = 257
- Height = 98
- BevelInner = bvRaised
- BevelOuter = bvLowered
- TabOrder = 2
- object Label3: TTntLabel
- Left = 10
- Top = 6
- Width = 50
- Height = 13
- Caption = 'Database:'
- end
- object DatabaseName: TTntLabel
- Left = 91
- Top = 6
- Width = 3
- Height = 13
- end
- object Bevel: TTntBevel
- Left = 1
- Top = 24
- Width = 254
- Height = 9
- Shape = bsTopLine
- end
- object Panel1: TTntPanel
- Left = 2
- Top = 31
- Width = 253
- Height = 65
- Align = alBottom
- BevelOuter = bvNone
- TabOrder = 0
- object Label1: TTntLabel
- Left = 8
- Top = 8
- Width = 56
- Height = 13
- Caption = '&User Name:'
- FocusControl = UserName
- end
- object Label2: TTntLabel
- Left = 8
- Top = 36
- Width = 50
- Height = 13
- Caption = '&Password:'
- FocusControl = Password
- end
- object UserName: TTntEdit
- Left = 86
- Top = 5
- Width = 153
- Height = 21
- MaxLength = 31
- TabOrder = 0
- end
- object Password: TTntEdit
- Left = 86
- Top = 33
- Width = 153
- Height = 21
- MaxLength = 31
- PasswordCharW = #9679
- TabOrder = 1
- PasswordChar_UTF7 = '+Jc8'
- end
- end
- end
-end
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBLogDlg.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBLogDlg.pas deleted file mode 100644 index c8747e2f2a..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBLogDlg.pas +++ /dev/null @@ -1,133 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntDBLogDlg;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- SysUtils, Windows, Messages, Classes, Graphics,
- TntForms, TntStdCtrls, TntExtCtrls, StdCtrls, ExtCtrls, Controls;
-
-type
- TTntLoginDialog = class(TTntForm)
- Panel: TTntPanel;
- Bevel: TTntBevel;
- DatabaseName: TTntLabel;
- OKButton: TTntButton;
- CancelButton: TTntButton;
- Panel1: TTntPanel;
- Label1: TTntLabel;
- Label2: TTntLabel;
- Label3: TTntLabel;
- Password: TTntEdit;
- UserName: TTntEdit;
- procedure FormShow(Sender: TObject);
- end;
-
-{TNT-WARN LoginDialog}
-function TntLoginDialog(const ADatabaseName: WideString;
- var AUserName, APassword: WideString): Boolean;
-
-{TNT-WARN LoginDialogEx}
-function TntLoginDialogEx(const ADatabaseName: WideString;
- var AUserName, APassword: WideString; NameReadOnly: Boolean): Boolean;
-
-{TNT-WARN RemoteLoginDialog}
-function TntRemoteLoginDialog(var AUserName, APassword: WideString): Boolean;
-
-implementation
-
-{$R *.dfm}
-
-uses
- Forms, VDBConsts;
-
-function TntLoginDialog(const ADatabaseName: WideString;
- var AUserName, APassword: WideString): Boolean;
-begin
- with TTntLoginDialog.Create(Application) do
- try
- DatabaseName.Caption := ADatabaseName;
- UserName.Text := AUserName;
- Result := False;
- if AUserName = '' then ActiveControl := UserName;
- if ShowModal = mrOk then
- begin
- AUserName := UserName.Text;
- APassword := Password.Text;
- Result := True;
- end;
- finally
- Free;
- end;
-end;
-
-function TntLoginDialogEx(const ADatabaseName: WideString;
- var AUserName, APassword: WideString; NameReadOnly: Boolean): Boolean;
-begin
- with TTntLoginDialog.Create(Application) do
- try
- DatabaseName.Caption := ADatabaseName;
- UserName.Text := AUserName;
- Result := False;
- if NameReadOnly then
- UserName.Enabled := False
- else
- if AUserName = '' then ActiveControl := UserName;
- if ShowModal = mrOk then
- begin
- AUserName := UserName.Text;
- APassword := Password.Text;
- Result := True;
- end;
- finally
- Free;
- end;
-end;
-
-function TntRemoteLoginDialog(var AUserName, APassword: WideString): Boolean;
-begin
- with TTntLoginDialog.Create(Application) do
- try
- Caption := SRemoteLogin;
- Bevel.Visible := False;
- DatabaseName.Visible := False;
- Label3.Visible := False;
- Panel.Height := Panel.Height - Bevel.Top;
- OKButton.Top := OKButton.Top - Bevel.Top;
- CancelButton.Top := CancelButton.Top - Bevel.Top;
- Height := Height - Bevel.Top;
- UserName.Text := AUserName;
- Result := False;
- if AUserName = '' then ActiveControl := UserName;
- if ShowModal = mrOk then
- begin
- AUserName := UserName.Text;
- APassword := Password.Text;
- Result := True;
- end;
- finally
- Free;
- end;
-end;
-
-{ TTntLoginDialog }
-
-procedure TTntLoginDialog.FormShow(Sender: TObject);
-begin
- if (DatabaseName.Width + DatabaseName.Left) >= Panel.ClientWidth then
- DatabaseName.Width := (Panel.ClientWidth - DatabaseName.Left) - 5;
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDialogs.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDialogs.pas deleted file mode 100644 index 0c06d07f7d..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDialogs.pas +++ /dev/null @@ -1,981 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntDialogs;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: TFindDialog and TReplaceDialog. }
-{ TODO: Property editor for TTntOpenDialog.Filter }
-
-uses
- Classes, Messages, CommDlg, Windows, Dialogs,
- TntClasses, TntForms, TntSysUtils;
-
-type
-{TNT-WARN TIncludeItemEvent}
- TIncludeItemEventW = procedure (const OFN: TOFNotifyExW; var Include: Boolean) of object;
-
-{TNT-WARN TOpenDialog}
- TTntOpenDialog = class(TOpenDialog{TNT-ALLOW TOpenDialog})
- private
- FDefaultExt: WideString;
- FFileName: TWideFileName;
- FFilter: WideString;
- FInitialDir: WideString;
- FTitle: WideString;
- FFiles: TTntStrings;
- FOnIncludeItem: TIncludeItemEventW;
- function GetDefaultExt: WideString;
- procedure SetInheritedDefaultExt(const Value: AnsiString);
- procedure SetDefaultExt(const Value: WideString);
- function GetFileName: TWideFileName;
- procedure SetFileName(const Value: TWideFileName);
- function GetFilter: WideString;
- procedure SetInheritedFilter(const Value: AnsiString);
- procedure SetFilter(const Value: WideString);
- function GetInitialDir: WideString;
- procedure SetInheritedInitialDir(const Value: AnsiString);
- procedure SetInitialDir(const Value: WideString);
- function GetTitle: WideString;
- procedure SetInheritedTitle(const Value: AnsiString);
- procedure SetTitle(const Value: WideString);
- function GetFiles: TTntStrings;
- private
- FProxiedOpenFilenameA: TOpenFilenameA;
- protected
- FAllowDoCanClose: Boolean;
- procedure DefineProperties(Filer: TFiler); override;
- function CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
- function DoCanClose: Boolean; override;
- procedure GetFileNamesW(var OpenFileName: TOpenFileNameW);
- procedure DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean); override;
- procedure WndProc(var Message: TMessage); override;
- function DoExecuteW(Func: Pointer; ParentWnd: HWND): Bool; overload;
- function DoExecuteW(Func: Pointer): Bool; overload;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Execute: Boolean; override;
- {$IFDEF COMPILER_9_UP}
- function Execute(ParentWnd: HWND): Boolean; override;
- {$ENDIF}
- property Files: TTntStrings read GetFiles;
- published
- property DefaultExt: WideString read GetDefaultExt write SetDefaultExt;
- property FileName: TWideFileName read GetFileName write SetFileName;
- property Filter: WideString read GetFilter write SetFilter;
- property InitialDir: WideString read GetInitialDir write SetInitialDir;
- property Title: WideString read GetTitle write SetTitle;
- property OnIncludeItem: TIncludeItemEventW read FOnIncludeItem write FOnIncludeItem;
- end;
-
-{TNT-WARN TSaveDialog}
- TTntSaveDialog = class(TTntOpenDialog)
- public
- function Execute: Boolean; override;
- {$IFDEF COMPILER_9_UP}
- function Execute(ParentWnd: HWND): Boolean; override;
- {$ENDIF}
- end;
-
-{ Message dialog }
-
-{TNT-WARN CreateMessageDialog}
-function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons): TTntForm;overload;
-function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm; overload;
-
-{TNT-WARN MessageDlg}
-function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
-function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;
-
-{TNT-WARN MessageDlgPos}
-function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer; overload;
-function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; DefaultButton: TMsgDlgBtn): Integer; overload;
-
-{TNT-WARN MessageDlgPosHelp}
-function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
- const HelpFileName: WideString): Integer; overload;
-function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
- const HelpFileName: WideString; DefaultButton: TMsgDlgBtn): Integer; overload;
-
-{TNT-WARN ShowMessage}
-procedure WideShowMessage(const Msg: WideString);
-{TNT-WARN ShowMessageFmt}
-procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
-{TNT-WARN ShowMessagePos}
-procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
-
-{ Input dialog }
-
-{TNT-WARN InputQuery}
-function WideInputQuery(const ACaption, APrompt: WideString;
- var Value: WideString): Boolean;
-{TNT-WARN InputBox}
-function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
-
-{TNT-WARN PromptForFileName}
-function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
- const ADefaultExt: WideString = ''; const ATitle: WideString = '';
- const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
-
-function GetModalParentWnd: HWND;
-
-implementation
-
-uses
- Controls, Forms, Types, SysUtils, Graphics, Consts, Math,
- TntWindows, TntStdCtrls, TntClipBrd, TntExtCtrls,
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
-
-function GetModalParentWnd: HWND;
-begin
- {$IFDEF COMPILER_9}
- Result := Application.ActiveFormHandle;
- {$ELSE}
- Result := 0;
- {$ENDIF}
- {$IFDEF COMPILER_10_UP}
- if Application.ModalPopupMode <> pmNone then
- begin
- Result := Application.ActiveFormHandle;
- end;
- {$ENDIF}
- if Result = 0 then begin
- Result := Application.Handle;
- end;
-end;
-
-var
- ProxyExecuteDialog: TTntOpenDialog;
-
-function ProxyGetOpenFileNameA(var OpenFile: TOpenFilename): Bool; stdcall;
-begin
- ProxyExecuteDialog.FProxiedOpenFilenameA := OpenFile;
- Result := False; { as if user hit "Cancel". }
-end;
-
-{ TTntOpenDialog }
-
-constructor TTntOpenDialog.Create(AOwner: TComponent);
-begin
- inherited;
- FFiles := TTntStringList.Create;
-end;
-
-destructor TTntOpenDialog.Destroy;
-begin
- FreeAndNil(FFiles);
- inherited;
-end;
-
-procedure TTntOpenDialog.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntOpenDialog.GetDefaultExt: WideString;
-begin
- Result := GetSyncedWideString(FDefaultExt, inherited DefaultExt);
-end;
-
-procedure TTntOpenDialog.SetInheritedDefaultExt(const Value: AnsiString);
-begin
- inherited DefaultExt := Value;
-end;
-
-procedure TTntOpenDialog.SetDefaultExt(const Value: WideString);
-begin
- SetSyncedWideString(Value, FDefaultExt, inherited DefaultExt, SetInheritedDefaultExt);
-end;
-
-function TTntOpenDialog.GetFileName: TWideFileName;
-var
- Path: array[0..MAX_PATH] of WideChar;
-begin
- if Win32PlatformIsUnicode and NewStyleControls and (Handle <> 0) then begin
- // get filename from handle
- SendMessageW(GetParent(Handle), CDM_GETFILEPATH, SizeOf(Path), Integer(@Path));
- Result := Path;
- end else
- Result := GetSyncedWideString(WideString(FFileName), inherited FileName);
-end;
-
-procedure TTntOpenDialog.SetFileName(const Value: TWideFileName);
-begin
- FFileName := Value;
- inherited FileName := Value;
-end;
-
-function TTntOpenDialog.GetFilter: WideString;
-begin
- Result := GetSyncedWideString(FFilter, inherited Filter);
-end;
-
-procedure TTntOpenDialog.SetInheritedFilter(const Value: AnsiString);
-begin
- inherited Filter := Value;
-end;
-
-procedure TTntOpenDialog.SetFilter(const Value: WideString);
-begin
- SetSyncedWideString(Value, FFilter, inherited Filter, SetInheritedFilter);
-end;
-
-function TTntOpenDialog.GetInitialDir: WideString;
-begin
- Result := GetSyncedWideString(FInitialDir, inherited InitialDir);
-end;
-
-procedure TTntOpenDialog.SetInheritedInitialDir(const Value: AnsiString);
-begin
- inherited InitialDir := Value;
-end;
-
-procedure TTntOpenDialog.SetInitialDir(const Value: WideString);
-
- function RemoveTrailingPathDelimiter(const Value: WideString): WideString;
- var
- L: Integer;
- begin
- // remove trailing path delimiter (except 'C:\')
- L := Length(Value);
- if (L > 1) and WideIsPathDelimiter(Value, L) and not WideIsDelimiter(':', Value, L - 1) then
- Dec(L);
- Result := Copy(Value, 1, L);
- end;
-
-begin
- SetSyncedWideString(RemoveTrailingPathDelimiter(Value), FInitialDir,
- inherited InitialDir, SetInheritedInitialDir);
-end;
-
-function TTntOpenDialog.GetTitle: WideString;
-begin
- Result := GetSyncedWideString(FTitle, inherited Title)
-end;
-
-procedure TTntOpenDialog.SetInheritedTitle(const Value: AnsiString);
-begin
- inherited Title := Value;
-end;
-
-procedure TTntOpenDialog.SetTitle(const Value: WideString);
-begin
- SetSyncedWideString(Value, FTitle, inherited Title, SetInheritedTitle);
-end;
-
-function TTntOpenDialog.GetFiles: TTntStrings;
-begin
- if (not Win32PlatformIsUnicode) then
- FFiles.Assign(inherited Files);
- Result := FFiles;
-end;
-
-function TTntOpenDialog.DoCanClose: Boolean;
-begin
- if FAllowDoCanClose then
- Result := inherited DoCanClose
- else
- Result := True;
-end;
-
-function TTntOpenDialog.CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
-begin
- GetFileNamesW(OpenFileName);
- FAllowDoCanClose := True;
- try
- Result := DoCanClose;
- finally
- FAllowDoCanClose := False;
- end;
- FFiles.Clear;
- inherited Files.Clear;
-end;
-
-procedure TTntOpenDialog.DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean);
-begin
- // CDN_INCLUDEITEM -> DoIncludeItem() is only be available on Windows 2000 +
- // Therefore, just cast OFN as a TOFNotifyExW, since that's what it really is.
- if Win32PlatformIsUnicode and Assigned(FOnIncludeItem) then
- FOnIncludeItem(TOFNotifyExW(OFN), Include)
-end;
-
-procedure TTntOpenDialog.WndProc(var Message: TMessage);
-begin
- Message.Result := 0;
- if (Message.Msg = WM_INITDIALOG) and not (ofOldStyleDialog in Options) then begin
- { If not ofOldStyleDialog then DoShow on CDN_INITDONE, not WM_INITDIALOG }
- Exit;
- end;
- if Win32PlatformIsUnicode
- and (Message.Msg = WM_NOTIFY) then begin
- case (POFNotify(Message.LParam)^.hdr.code) of
- CDN_FILEOK:
- if not CanCloseW(POFNotifyW(Message.LParam)^.lpOFN^) then
- begin
- Message.Result := 1;
- SetWindowLong(Handle, DWL_MSGRESULT, Message.Result);
- Exit;
- end;
- end;
- end;
- inherited WndProc(Message);
-end;
-
-function TTntOpenDialog.DoExecuteW(Func: Pointer): Bool;
-begin
- Result := DoExecuteW(Func, GetModalParentWnd);
-end;
-
-function TTntOpenDialog.DoExecuteW(Func: Pointer; ParentWnd: HWND): Bool;
-var
- OpenFilename: TOpenFilenameW;
-
- function GetResNamePtr(var ScopedStringStorage: WideString; lpszName: PAnsiChar): PWideChar;
- // duplicated from TntTrxResourceUtils.pas
- begin
- if Tnt_Is_IntResource(PWideChar(lpszName)) then
- Result := PWideChar(lpszName)
- else begin
- ScopedStringStorage := lpszName;
- Result := PWideChar(ScopedStringStorage);
- end;
- end;
-
- function AllocFilterStr(const S: WideString): WideString;
- var
- P: PWideChar;
- begin
- Result := '';
- if S <> '' then
- begin
- Result := S + #0#0; // double null terminators (an additional zero added in case Description/Filter pair not even.)
- P := WStrScan(PWideChar(Result), '|');
- while P <> nil do
- begin
- P^ := #0;
- Inc(P);
- P := WStrScan(P, '|');
- end;
- end;
- end;
-
-var
- TempTemplate, TempFilter, TempFilename, TempExt: WideString;
-begin
- FFiles.Clear;
-
- // 1. Init inherited dialog defaults.
- // 2. Populate OpenFileName record with ansi defaults
- ProxyExecuteDialog := Self;
- try
- DoExecute(@ProxyGetOpenFileNameA);
- finally
- ProxyExecuteDialog := nil;
- end;
- OpenFileName := TOpenFilenameW(FProxiedOpenFilenameA);
-
- with OpenFilename do
- begin
- if not IsWindow(hWndOwner) then begin
- hWndOwner := ParentWnd;
- end;
- // Filter (PChar -> PWideChar)
- TempFilter := AllocFilterStr(Filter);
- lpstrFilter := PWideChar(TempFilter);
- // FileName (PChar -> PWideChar)
- SetLength(TempFilename, nMaxFile + 2);
- lpstrFile := PWideChar(TempFilename);
- FillChar(lpstrFile^, (nMaxFile + 2) * SizeOf(WideChar), 0);
- WStrLCopy(lpstrFile, PWideChar(FileName), nMaxFile);
- // InitialDir (PChar -> PWideChar)
- if (InitialDir = '') and ForceCurrentDirectory then
- lpstrInitialDir := '.'
- else
- lpstrInitialDir := PWideChar(InitialDir);
- // Title (PChar -> PWideChar)
- lpstrTitle := PWideChar(Title);
- // DefaultExt (PChar -> PWideChar)
- TempExt := DefaultExt;
- if (TempExt = '') and (Flags and OFN_EXPLORER = 0) then
- begin
- TempExt := WideExtractFileExt(Filename);
- Delete(TempExt, 1, 1);
- end;
- if TempExt <> '' then
- lpstrDefExt := PWideChar(TempExt);
- // resource template (PChar -> PWideChar)
- lpTemplateName := GetResNamePtr(TempTemplate, Template);
- // start modal dialog
- Result := TaskModalDialog(Func, OpenFileName);
- if Result then
- begin
- GetFileNamesW(OpenFilename);
- if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
- Options := Options + [ofExtensionDifferent]
- else
- Options := Options - [ofExtensionDifferent];
- if (Flags and OFN_READONLY) <> 0 then
- Options := Options + [ofReadOnly]
- else
- Options := Options - [ofReadOnly];
- FilterIndex := nFilterIndex;
- end;
- end;
-end;
-
-procedure TTntOpenDialog.GetFileNamesW(var OpenFileName: TOpenFileNameW);
-var
- Separator: WideChar;
-
- procedure ExtractFileNamesW(P: PWideChar);
- var
- DirName, FileName: TWideFileName;
- FileList: TWideStringDynArray;
- i: integer;
- begin
- FileList := ExtractStringsFromStringArray(P, Separator);
- if Length(FileList) = 0 then
- FFiles.Add('')
- else begin
- DirName := FileList[0];
- if Length(FileList) = 1 then
- FFiles.Add(DirName)
- else begin
- // prepare DirName
- if WideLastChar(DirName) <> WideString(PathDelim) then
- DirName := DirName + PathDelim;
- // add files
- for i := 1 {second item} to High(FileList) do begin
- FileName := FileList[i];
- // prepare FileName
- if (FileName[1] <> PathDelim)
- and ((Length(FileName) <= 3) or (FileName[2] <> DriveDelim) or (FileName[3] <> PathDelim))
- then
- FileName := DirName + FileName;
- // add to list
- FFiles.Add(FileName);
- end;
- end;
- end;
- end;
-
-var
- P: PWideChar;
-begin
- Separator := #0;
- if (ofAllowMultiSelect in Options) and
- ((ofOldStyleDialog in Options) or not NewStyleControls) then
- Separator := ' ';
- with OpenFileName do
- begin
- if ofAllowMultiSelect in Options then
- begin
- ExtractFileNamesW(lpstrFile);
- FileName := FFiles[0];
- end else
- begin
- P := lpstrFile;
- FileName := ExtractStringFromStringArray(P, Separator);
- FFiles.Add(FileName);
- end;
- end;
-
- // Sync inherited Files
- inherited Files.Assign(FFiles);
-end;
-
-function TTntOpenDialog.Execute: Boolean;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := DoExecute(@GetOpenFileNameA)
- else
- Result := DoExecuteW(@GetOpenFileNameW);
-end;
-
-{$IFDEF COMPILER_9_UP}
-function TTntOpenDialog.Execute(ParentWnd: HWND): Boolean;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := DoExecute(@GetOpenFileNameA, ParentWnd)
- else
- Result := DoExecuteW(@GetOpenFileNameW, ParentWnd);
-end;
-{$ENDIF}
-
-{ TTntSaveDialog }
-
-function TTntSaveDialog.Execute: Boolean;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := DoExecute(@GetSaveFileNameA)
- else
- Result := DoExecuteW(@GetSaveFileNameW);
-end;
-
-{$IFDEF COMPILER_9_UP}
-function TTntSaveDialog.Execute(ParentWnd: HWND): Boolean;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := DoExecute(@GetSaveFileNameA, ParentWnd)
- else
- Result := DoExecuteW(@GetSaveFileNameW, ParentWnd);
-end;
-{$ENDIF}
-
-{ Message dialog }
-
-function GetAveCharSize(Canvas: TCanvas): TPoint;
-var
- I: Integer;
- Buffer: array[0..51] of WideChar;
- tm: TTextMetric;
-begin
- for I := 0 to 25 do Buffer[I] := WideChar(I + Ord('A'));
- for I := 0 to 25 do Buffer[I + 26] := WideChar(I + Ord('a'));
- GetTextMetrics(Canvas.Handle, tm);
- GetTextExtentPointW(Canvas.Handle, Buffer, 52, TSize(Result));
- Result.X := (Result.X div 26 + 1) div 2;
- Result.Y := tm.tmHeight;
-end;
-
-type
- TTntMessageForm = class(TTntForm)
- private
- Message: TTntLabel;
- procedure HelpButtonClick(Sender: TObject);
- protected
- procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- function GetFormText: WideString;
- public
- constructor CreateNew(AOwner: TComponent); reintroduce;
- end;
-
-constructor TTntMessageForm.CreateNew(AOwner: TComponent);
-var
- NonClientMetrics: TNonClientMetrics;
-begin
- inherited CreateNew(AOwner);
- NonClientMetrics.cbSize := sizeof(NonClientMetrics);
- if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
- Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
-end;
-
-procedure TTntMessageForm.HelpButtonClick(Sender: TObject);
-begin
- Application.HelpContext(HelpContext);
-end;
-
-procedure TTntMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
-begin
- if (Shift = [ssCtrl]) and (Key = Word('C')) then
- begin
- Beep;
- TntClipboard.AsWideText := GetFormText;
- end;
-end;
-
-function TTntMessageForm.GetFormText: WideString;
-var
- DividerLine, ButtonCaptions: WideString;
- I: integer;
-begin
- DividerLine := StringOfChar('-', 27) + sLineBreak;
- for I := 0 to ComponentCount - 1 do
- if Components[I] is TTntButton then
- ButtonCaptions := ButtonCaptions + TTntButton(Components[I]).Caption +
- StringOfChar(' ', 3);
- ButtonCaptions := Tnt_WideStringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
- Result := DividerLine + Caption + sLineBreak + DividerLine + Message.Caption + sLineBreak
- + DividerLine + ButtonCaptions + sLineBreak + DividerLine;
-end;
-
-function GetMessageCaption(MsgType: TMsgDlgType): WideString;
-begin
- case MsgType of
- mtWarning: Result := SMsgDlgWarning;
- mtError: Result := SMsgDlgError;
- mtInformation: Result := SMsgDlgInformation;
- mtConfirmation: Result := SMsgDlgConfirm;
- mtCustom: Result := '';
- else
- raise ETntInternalError.Create('Unexpected MsgType in GetMessageCaption.');
- end;
-end;
-
-function GetButtonCaption(MsgDlgBtn: TMsgDlgBtn): WideString;
-begin
- case MsgDlgBtn of
- mbYes: Result := SMsgDlgYes;
- mbNo: Result := SMsgDlgNo;
- mbOK: Result := SMsgDlgOK;
- mbCancel: Result := SMsgDlgCancel;
- mbAbort: Result := SMsgDlgAbort;
- mbRetry: Result := SMsgDlgRetry;
- mbIgnore: Result := SMsgDlgIgnore;
- mbAll: Result := SMsgDlgAll;
- mbNoToAll: Result := SMsgDlgNoToAll;
- mbYesToAll: Result := SMsgDlgYesToAll;
- mbHelp: Result := SMsgDlgHelp;
- else
- raise ETntInternalError.Create('Unexpected MsgDlgBtn in GetButtonCaption.');
- end;
-end;
-
-var
- IconIDs: array[TMsgDlgType] of PAnsiChar = (IDI_EXCLAMATION, IDI_HAND,
- IDI_ASTERISK, IDI_QUESTION, nil);
- ButtonNames: array[TMsgDlgBtn] of WideString = (
- 'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
- 'YesToAll', 'Help');
- ModalResults: array[TMsgDlgBtn] of Integer = (
- mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
- mrYesToAll, 0);
-
-function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm;
-const
- mcHorzMargin = 8;
- mcVertMargin = 8;
- mcHorzSpacing = 10;
- mcVertSpacing = 10;
- mcButtonWidth = 50;
- mcButtonHeight = 14;
- mcButtonSpacing = 4;
-var
- DialogUnits: TPoint;
- HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
- ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
- IconTextWidth, IconTextHeight, X, ALeft: Integer;
- B, CancelButton: TMsgDlgBtn;
- IconID: PAnsiChar;
- ATextRect: TRect;
- ThisButtonWidth: integer;
- LButton: TTntButton;
-begin
- Result := TTntMessageForm.CreateNew(Application);
- with Result do
- begin
- BorderStyle := bsDialog; // By doing this first, it will work on WINE.
- BiDiMode := Application.BiDiMode;
- Canvas.Font := Font;
- KeyPreview := True;
- Position := poDesigned;
- OnKeyDown := TTntMessageForm(Result).CustomKeyDown;
- DialogUnits := GetAveCharSize(Canvas);
- HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
- VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
- HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
- VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
- ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
- for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
- begin
- if B in Buttons then
- begin
- ATextRect := Rect(0,0,0,0);
- Tnt_DrawTextW(Canvas.Handle,
- PWideChar(GetButtonCaption(B)), -1,
- ATextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
- DrawTextBiDiModeFlagsReadingOnly);
- with ATextRect do ThisButtonWidth := Right - Left + 8;
- if ThisButtonWidth > ButtonWidth then
- ButtonWidth := ThisButtonWidth;
- end;
- end;
- ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
- ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
- SetRect(ATextRect, 0, 0, Screen.Width div 2, 0);
- Tnt_DrawTextW(Canvas.Handle, PWideChar(Msg), Length(Msg) + 1, ATextRect,
- DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
- DrawTextBiDiModeFlagsReadingOnly);
- IconID := IconIDs[DlgType];
- IconTextWidth := ATextRect.Right;
- IconTextHeight := ATextRect.Bottom;
- if IconID <> nil then
- begin
- Inc(IconTextWidth, 32 + HorzSpacing);
- if IconTextHeight < 32 then IconTextHeight := 32;
- end;
- ButtonCount := 0;
- for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
- if B in Buttons then Inc(ButtonCount);
- ButtonGroupWidth := 0;
- if ButtonCount <> 0 then
- ButtonGroupWidth := ButtonWidth * ButtonCount +
- ButtonSpacing * (ButtonCount - 1);
- ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
- ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
- VertMargin * 2;
- Left := (Screen.Width div 2) - (Width div 2);
- Top := (Screen.Height div 2) - (Height div 2);
- if DlgType <> mtCustom then
- Caption := GetMessageCaption(DlgType)
- else
- Caption := TntApplication.Title;
- if IconID <> nil then
- with TTntImage.Create(Result) do
- begin
- Name := 'Image';
- Parent := Result;
- Picture.Icon.Handle := LoadIcon(0, IconID);
- SetBounds(HorzMargin, VertMargin, 32, 32);
- end;
- TTntMessageForm(Result).Message := TTntLabel.Create(Result);
- with TTntMessageForm(Result).Message do
- begin
- Name := 'Message';
- Parent := Result;
- WordWrap := True;
- Caption := Msg;
- BoundsRect := ATextRect;
- BiDiMode := Result.BiDiMode;
- ALeft := IconTextWidth - ATextRect.Right + HorzMargin;
- if UseRightToLeftAlignment then
- ALeft := Result.ClientWidth - ALeft - Width;
- SetBounds(ALeft, VertMargin,
- ATextRect.Right, ATextRect.Bottom);
- end;
- if mbCancel in Buttons then CancelButton := mbCancel else
- if mbNo in Buttons then CancelButton := mbNo else
- CancelButton := mbOk;
- X := (ClientWidth - ButtonGroupWidth) div 2;
- for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
- if B in Buttons then
- begin
- LButton := TTntButton.Create(Result);
- with LButton do
- begin
- Name := ButtonNames[B];
- Parent := Result;
- Caption := GetButtonCaption(B);
- ModalResult := ModalResults[B];
- if B = DefaultButton then
- begin
- Default := True;
- ActiveControl := LButton;
- end;
- if B = CancelButton then
- Cancel := True;
- SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
- ButtonWidth, ButtonHeight);
- Inc(X, ButtonWidth + ButtonSpacing);
- if B = mbHelp then
- OnClick := TTntMessageForm(Result).HelpButtonClick;
- end;
- end;
- end;
-end;
-
-function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons): TTntForm;
-var
- DefaultButton: TMsgDlgBtn;
-begin
- if mbOk in Buttons then DefaultButton := mbOk else
- if mbYes in Buttons then DefaultButton := mbYes else
- DefaultButton := mbRetry;
- Result := WideCreateMessageDialog(Msg, DlgType, Buttons, DefaultButton);
-end;
-
-function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer;
-begin
- Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '', DefaultButton);
-end;
-
-function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
-begin
- Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
-end;
-
-function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; DefaultButton: TMsgDlgBtn): Integer;
-begin
- Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '', DefaultButton);
-end;
-
-function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer;
-begin
- Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '');
-end;
-
-function _Internal_WideMessageDlgPosHelp(Dlg: TTntForm; HelpCtx: Longint; X, Y: Integer;
- const HelpFileName: WideString): Integer;
-begin
- with Dlg do
- try
- HelpContext := HelpCtx;
- HelpFile := HelpFileName;
- if X >= 0 then Left := X;
- if Y >= 0 then Top := Y;
- if (Y < 0) and (X < 0) then Position := poScreenCenter;
- Result := ShowModal;
- finally
- Free;
- end;
-end;
-
-function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
- const HelpFileName: WideString; DefaultButton: TMsgDlgBtn): Integer;
-begin
- Result := _Internal_WideMessageDlgPosHelp(
- WideCreateMessageDialog(Msg, DlgType, Buttons, DefaultButton), HelpCtx, X, Y, HelpFileName);
-end;
-
-function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
- Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
- const HelpFileName: WideString): Integer;
-begin
- Result := _Internal_WideMessageDlgPosHelp(
- WideCreateMessageDialog(Msg, DlgType, Buttons), HelpCtx, X, Y, HelpFileName);
-end;
-
-procedure WideShowMessage(const Msg: WideString);
-begin
- WideShowMessagePos(Msg, -1, -1);
-end;
-
-procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
-begin
- WideShowMessage(WideFormat(Msg, Params));
-end;
-
-procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
-begin
- WideMessageDlgPos(Msg, mtCustom, [mbOK], 0, X, Y);
-end;
-
-{ Input dialog }
-
-function WideInputQuery(const ACaption, APrompt: WideString; var Value: WideString): Boolean;
-var
- Form: TTntForm;
- Prompt: TTntLabel;
- Edit: TTntEdit;
- DialogUnits: TPoint;
- ButtonTop, ButtonWidth, ButtonHeight: Integer;
-begin
- Result := False;
- Form := TTntForm.Create(Application);
- with Form do begin
- try
- BorderStyle := bsDialog; // By doing this first, it will work on WINE.
- Canvas.Font := Font;
- DialogUnits := GetAveCharSize(Canvas);
- Caption := ACaption;
- ClientWidth := MulDiv(180, DialogUnits.X, 4);
- Position := poScreenCenter;
- Prompt := TTntLabel.Create(Form);
- with Prompt do
- begin
- Parent := Form;
- Caption := APrompt;
- Left := MulDiv(8, DialogUnits.X, 4);
- Top := MulDiv(8, DialogUnits.Y, 8);
- Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
- WordWrap := True;
- end;
- Edit := TTntEdit.Create(Form);
- with Edit do
- begin
- Parent := Form;
- Left := Prompt.Left;
- Top := Prompt.Top + Prompt.Height + 5;
- Width := MulDiv(164, DialogUnits.X, 4);
- MaxLength := 255;
- Text := Value;
- SelectAll;
- end;
- ButtonTop := Edit.Top + Edit.Height + 15;
- ButtonWidth := MulDiv(50, DialogUnits.X, 4);
- ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
- with TTntButton.Create(Form) do
- begin
- Parent := Form;
- Caption := SMsgDlgOK;
- ModalResult := mrOk;
- Default := True;
- SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
- ButtonHeight);
- end;
- with TTntButton.Create(Form) do
- begin
- Parent := Form;
- Caption := SMsgDlgCancel;
- ModalResult := mrCancel;
- Cancel := True;
- SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15, ButtonWidth,
- ButtonHeight);
- Form.ClientHeight := Top + Height + 13;
- end;
- if ShowModal = mrOk then
- begin
- Value := Edit.Text;
- Result := True;
- end;
- finally
- Form.Free;
- end;
- end;
-end;
-
-function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
-begin
- Result := ADefault;
- WideInputQuery(ACaption, APrompt, Result);
-end;
-
-function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
- const ADefaultExt: WideString = ''; const ATitle: WideString = '';
- const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
-var
- Dialog: TTntOpenDialog;
-begin
- if SaveDialog then
- begin
- Dialog := TTntSaveDialog.Create(nil);
- Dialog.Options := Dialog.Options + [ofOverwritePrompt];
- end
- else
- Dialog := TTntOpenDialog.Create(nil);
- with Dialog do
- try
- Title := ATitle;
- DefaultExt := ADefaultExt;
- if AFilter = '' then
- Filter := SDefaultFilter else
- Filter := AFilter;
- InitialDir := AInitialDir;
- FileName := AFileName;
- Result := Execute;
- if Result then
- AFileName := FileName;
- finally
- Free;
- end;
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtActns.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtActns.pas deleted file mode 100644 index cf1f342142..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtActns.pas +++ /dev/null @@ -1,1400 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntExtActns;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, TntActnList, ExtActns;
-
-type
-{TNT-WARN TCustomFileRun}
- TTntCustomFileRun = class(TCustomFileRun{TNT-ALLOW TCustomFileRun}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TFileRun}
- TTntFileRun = class(TFileRun{TNT-ALLOW TFileRun}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditAction}
- TTntRichEditAction = class(TRichEditAction{TNT-ALLOW TRichEditAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditBold}
- TTntRichEditBold = class(TRichEditBold{TNT-ALLOW TRichEditBold}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditItalic}
- TTntRichEditItalic = class(TRichEditItalic{TNT-ALLOW TRichEditItalic}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditUnderline}
- TTntRichEditUnderline = class(TRichEditUnderline{TNT-ALLOW TRichEditUnderline}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditStrikeOut}
- TTntRichEditStrikeOut = class(TRichEditStrikeOut{TNT-ALLOW TRichEditStrikeOut}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditBullets}
- TTntRichEditBullets = class(TRichEditBullets{TNT-ALLOW TRichEditBullets}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditAlignLeft}
- TTntRichEditAlignLeft = class(TRichEditAlignLeft{TNT-ALLOW TRichEditAlignLeft}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditAlignRight}
- TTntRichEditAlignRight = class(TRichEditAlignRight{TNT-ALLOW TRichEditAlignRight}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TRichEditAlignCenter}
- TTntRichEditAlignCenter = class(TRichEditAlignCenter{TNT-ALLOW TRichEditAlignCenter}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TTabAction}
- TTntTabAction = class(TTabAction{TNT-ALLOW TTabAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TPreviousTab}
- TTntPreviousTab = class(TPreviousTab{TNT-ALLOW TPreviousTab}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TNextTab}
- TTntNextTab = class(TNextTab{TNT-ALLOW TNextTab}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TOpenPicture}
- TTntOpenPicture = class(TOpenPicture{TNT-ALLOW TOpenPicture}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TSavePicture}
- TTntSavePicture = class(TSavePicture{TNT-ALLOW TSavePicture}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TURLAction}
- TTntURLAction = class(TURLAction{TNT-ALLOW TURLAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TBrowseURL}
- TTntBrowseURL = class(TBrowseURL{TNT-ALLOW TBrowseURL}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TDownLoadURL}
- TTntDownLoadURL = class(TDownLoadURL{TNT-ALLOW TDownLoadURL}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TSendMail}
- TTntSendMail = class(TSendMail{TNT-ALLOW TSendMail}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TListControlAction}
- TTntListControlAction = class(TListControlAction{TNT-ALLOW TListControlAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TListControlCopySelection}
- TTntListControlCopySelection = class(TListControlCopySelection{TNT-ALLOW TListControlCopySelection}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TListControlDeleteSelection}
- TTntListControlDeleteSelection = class(TListControlDeleteSelection{TNT-ALLOW TListControlDeleteSelection}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TListControlSelectAll}
- TTntListControlSelectAll = class(TListControlSelectAll{TNT-ALLOW TListControlSelectAll}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TListControlClearSelection}
- TTntListControlClearSelection = class(TListControlClearSelection{TNT-ALLOW TListControlClearSelection}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TListControlMoveSelection}
- TTntListControlMoveSelection = class(TListControlMoveSelection{TNT-ALLOW TListControlMoveSelection}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-implementation
-
-uses
- ActnList, TntStdActns, TntClasses;
-
-{TNT-IGNORE-UNIT}
-
-procedure TntExtActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-begin
- TntStdActn_AfterInherited_Assign(Action, Source);
- // TCustomFileRun
- if (Action is TCustomFileRun) and (Source is TCustomFileRun) then begin
- TCustomFileRun(Action).Browse := TCustomFileRun(Source).Browse;
- if TCustomFileRun(Source).BrowseDlg.Owner <> Source then
- TCustomFileRun(Action).BrowseDlg := TCustomFileRun(Source).BrowseDlg
- else begin
- { Carry over dialog properties. Currently TOpenDialog doesn't support Assign. }
- { TCustomFileRun(Action).BrowseDlg.Assign(TCustomFileRun(Source).BrowseDlg); }
- end;
- TCustomFileRun(Action).Directory := TCustomFileRun(Source).Directory;
- TCustomFileRun(Action).FileName := TCustomFileRun(Source).FileName;
- TCustomFileRun(Action).Operation := TCustomFileRun(Source).Operation;
- TCustomFileRun(Action).ParentControl := TCustomFileRun(Source).ParentControl;
- TCustomFileRun(Action).Parameters := TCustomFileRun(Source).Parameters;
- TCustomFileRun(Action).ShowCmd := TCustomFileRun(Source).ShowCmd;
- end;
- // TTabAction
- if (Action is TTabAction) and (Source is TTabAction) then begin
- TTabAction(Action).SkipHiddenTabs := TTabAction(Source).SkipHiddenTabs;
- TTabAction(Action).TabControl := TTabAction(Source).TabControl;
- TTabAction(Action).Wrap := TTabAction(Source).Wrap;
- TTabAction(Action).BeforeTabChange := TTabAction(Source).BeforeTabChange;
- TTabAction(Action).AfterTabChange := TTabAction(Source).AfterTabChange;
- TTabAction(Action).OnValidateTab := TTabAction(Source).OnValidateTab;
- end;
- // TNextTab
- if (Action is TNextTab) and (Source is TNextTab) then begin
- TNextTab(Action).LastTabCaption := TNextTab(Source).LastTabCaption;
- TNextTab(Action).OnFinish := TNextTab(Source).OnFinish;
- end;
- // TURLAction
- if (Action is TURLAction) and (Source is TURLAction) then begin
- TURLAction(Action).URL := TURLAction(Source).URL;
- end;
- // TBrowseURL
- if (Action is TBrowseURL) and (Source is TBrowseURL) then begin
- {$IFDEF COMPILER_7_UP}
- TBrowseURL(Action).BeforeBrowse := TBrowseURL(Source).BeforeBrowse;
- TBrowseURL(Action).AfterBrowse := TBrowseURL(Source).AfterBrowse;
- {$ENDIF}
- end;
- // TDownloadURL
- if (Action is TDownloadURL) and (Source is TDownloadURL) then begin
- TDownloadURL(Action).FileName := TDownloadURL(Source).FileName;
- {$IFDEF COMPILER_7_UP}
- TDownloadURL(Action).BeforeDownload := TDownloadURL(Source).BeforeDownload;
- TDownloadURL(Action).AfterDownload := TDownloadURL(Source).AfterDownload;
- {$ENDIF}
- TDownloadURL(Action).OnDownloadProgress := TDownloadURL(Source).OnDownloadProgress;
- end;
- // TSendMail
- if (Action is TSendMail) and (Source is TSendMail) then begin
- TSendMail(Action).Text := TSendMail(Source).Text;
- end;
- // TListControlAction
- if (Action is TListControlAction) and (Source is TListControlAction) then begin
- TListControlAction(Action).ListControl := TListControlAction(Source).ListControl;
- end;
- // TListControlCopySelection
- if (Action is TListControlCopySelection) and (Source is TListControlCopySelection) then begin
- TListControlCopySelection(Action).Destination := TListControlCopySelection(Source).Destination;
- end;
-end;
-
-//-------------------------
-// TNT EXT ACTNS
-//-------------------------
-
-{ TTntCustomFileRun }
-
-procedure TTntCustomFileRun.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntCustomFileRun.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomFileRun.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntCustomFileRun.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntCustomFileRun.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntCustomFileRun.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntFileRun }
-
-procedure TTntFileRun.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFileRun.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFileRun.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFileRun.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFileRun.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFileRun.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditAction }
-
-procedure TTntRichEditAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditBold }
-
-procedure TTntRichEditBold.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditBold.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditBold.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditBold.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditBold.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditBold.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditItalic }
-
-procedure TTntRichEditItalic.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditItalic.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditItalic.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditItalic.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditItalic.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditItalic.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditUnderline }
-
-procedure TTntRichEditUnderline.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditUnderline.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditUnderline.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditUnderline.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditUnderline.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditUnderline.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditStrikeOut }
-
-procedure TTntRichEditStrikeOut.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditStrikeOut.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditStrikeOut.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditStrikeOut.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditStrikeOut.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditStrikeOut.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditBullets }
-
-procedure TTntRichEditBullets.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditBullets.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditBullets.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditBullets.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditBullets.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditBullets.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditAlignLeft }
-
-procedure TTntRichEditAlignLeft.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditAlignLeft.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditAlignLeft.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditAlignLeft.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditAlignLeft.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditAlignLeft.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditAlignRight }
-
-procedure TTntRichEditAlignRight.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditAlignRight.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditAlignRight.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditAlignRight.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditAlignRight.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditAlignRight.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntRichEditAlignCenter }
-
-procedure TTntRichEditAlignCenter.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntRichEditAlignCenter.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntRichEditAlignCenter.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntRichEditAlignCenter.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntRichEditAlignCenter.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntRichEditAlignCenter.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntTabAction }
-
-procedure TTntTabAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntTabAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntTabAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntTabAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntTabAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntTabAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntPreviousTab }
-
-procedure TTntPreviousTab.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntPreviousTab.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntPreviousTab.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntPreviousTab.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntPreviousTab.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntPreviousTab.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntNextTab }
-
-procedure TTntNextTab.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntNextTab.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntNextTab.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntNextTab.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntNextTab.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntNextTab.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntOpenPicture }
-
-procedure TTntOpenPicture.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntOpenPicture.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntOpenPicture.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntOpenPicture.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntOpenPicture.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntOpenPicture.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntSavePicture }
-
-procedure TTntSavePicture.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntSavePicture.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSavePicture.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntSavePicture.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntSavePicture.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntSavePicture.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntURLAction }
-
-procedure TTntURLAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntURLAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntURLAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntURLAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntURLAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntURLAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntBrowseURL }
-
-procedure TTntBrowseURL.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntBrowseURL.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntBrowseURL.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntBrowseURL.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntBrowseURL.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntBrowseURL.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntDownLoadURL }
-
-procedure TTntDownLoadURL.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntDownLoadURL.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntDownLoadURL.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntDownLoadURL.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntDownLoadURL.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntDownLoadURL.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntSendMail }
-
-procedure TTntSendMail.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntSendMail.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSendMail.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntSendMail.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntSendMail.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntSendMail.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntListControlAction }
-
-procedure TTntListControlAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntListControlAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntListControlAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntListControlAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntListControlAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntListControlAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntListControlCopySelection }
-
-procedure TTntListControlCopySelection.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntListControlCopySelection.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntListControlCopySelection.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntListControlCopySelection.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntListControlCopySelection.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntListControlCopySelection.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntListControlDeleteSelection }
-
-procedure TTntListControlDeleteSelection.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntListControlDeleteSelection.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntListControlDeleteSelection.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntListControlDeleteSelection.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntListControlDeleteSelection.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntListControlDeleteSelection.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntListControlSelectAll }
-
-procedure TTntListControlSelectAll.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntListControlSelectAll.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntListControlSelectAll.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntListControlSelectAll.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntListControlSelectAll.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntListControlSelectAll.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntListControlClearSelection }
-
-procedure TTntListControlClearSelection.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntListControlClearSelection.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntListControlClearSelection.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntListControlClearSelection.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntListControlClearSelection.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntListControlClearSelection.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntListControlMoveSelection }
-
-procedure TTntListControlMoveSelection.Assign(Source: TPersistent);
-begin
- inherited;
- TntExtActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntListControlMoveSelection.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntListControlMoveSelection.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntListControlMoveSelection.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntListControlMoveSelection.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntListControlMoveSelection.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtCtrls.pas deleted file mode 100644 index 4789fa714a..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtCtrls.pas +++ /dev/null @@ -1,1062 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntExtCtrls;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, Messages, Controls, ExtCtrls, TntClasses, TntControls, TntStdCtrls, TntGraphics;
-
-type
-{TNT-WARN TShape}
- TTntShape = class(TShape{TNT-ALLOW TShape})
- 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;
-
-{TNT-WARN TPaintBox}
- TTntPaintBox = class(TPaintBox{TNT-ALLOW TPaintBox})
- 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;
-
-{TNT-WARN TImage}
- TTntImage = class(TImage{TNT-ALLOW TImage})
- private
- function GetHint: WideString;
- 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}
- TTntBevel = class(TBevel{TNT-ALLOW TBevel})
- 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;
-
-{TNT-WARN TCustomPanel}
- TTntCustomPanel = class(TCustomPanel{TNT-ALLOW TCustomPanel})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- protected
- procedure Paint; override;
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TPanel}
- TTntPanel = class(TTntCustomPanel)
- public
- property DockManager;
- published
- property Align;
- property Alignment;
- property Anchors;
- property AutoSize;
- property BevelEdges;
- property BevelInner;
- property BevelKind;
- property BevelOuter;
- property BevelWidth;
- property BiDiMode;
- property BorderWidth;
- property BorderStyle;
- property Caption;
- property Color;
- property Constraints;
- property Ctl3D;
- property UseDockManager default True;
- property DockSite;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property FullRepaint;
- property Font;
- property Locked;
- {$IFDEF COMPILER_10_UP}
- property Padding;
- {$ENDIF}
- property ParentBiDiMode;
- {$IFDEF COMPILER_7_UP}
- property ParentBackground;
- {$ENDIF}
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop;
- {$IFDEF COMPILER_9_UP}
- property VerticalAlignment;
- {$ENDIF}
- property Visible;
- {$IFDEF COMPILER_9_UP}
- property OnAlignInsertBefore;
- property OnAlignPosition;
- {$ENDIF}
- property OnCanResize;
- property OnClick;
- property OnConstrainedResize;
- property OnContextPopup;
- property OnDockDrop;
- property OnDockOver;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetSiteInfo;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnResize;
- property OnStartDock;
- property OnStartDrag;
- property OnUnDock;
- end;
-
-{TNT-WARN TCustomControlBar}
- TTntCustomControlBar = class(TCustomControlBar{TNT-ALLOW TCustomControlBar})
- private
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- 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;
-
-{TNT-WARN TControlBar}
- TTntControlBar = class(TTntCustomControlBar)
- public
- property Canvas;
- published
- property Align;
- property Anchors;
- property AutoDock;
- property AutoDrag;
- property AutoSize;
- property BevelEdges;
- property BevelInner;
- property BevelOuter;
- property BevelKind;
- property BevelWidth;
- property BorderWidth;
- property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
- property Constraints;
- {$IFDEF COMPILER_10_UP}
- property CornerEdge;
- {$ENDIF}
- property DockSite;
- property DragCursor;
- property DragKind;
- property DragMode;
- {$IFDEF COMPILER_10_UP}
- property DrawingStyle;
- {$ENDIF}
- property Enabled;
- {$IFDEF COMPILER_10_UP}
- property GradientDirection;
- property GradientEndColor;
- property GradientStartColor;
- {$ENDIF}
- {$IFDEF COMPILER_7_UP}
- property ParentBackground default True;
- {$ENDIF}
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property Picture;
- property PopupMenu;
- property RowSize;
- property RowSnap;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- {$IFDEF COMPILER_9_UP}
- property OnAlignInsertBefore;
- property OnAlignPosition;
- {$ENDIF}
- property OnBandDrag;
- property OnBandInfo;
- property OnBandMove;
- property OnBandPaint;
- {$IFDEF COMPILER_9_UP}
- property OnBeginBandMove;
- property OnEndBandMove;
- {$ENDIF}
- property OnCanResize;
- property OnClick;
- property OnConstrainedResize;
- property OnContextPopup;
- property OnDockDrop;
- property OnDockOver;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetSiteInfo;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnPaint;
- property OnResize;
- property OnStartDock;
- property OnStartDrag;
- 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, Graphics, Forms, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
- TntSysUtils, TntWindows, TntActnList;
-
-{ TTntShape }
-
-procedure TTntShape.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntShape.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntShape.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntShape.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntShape.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntShape.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntShape.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntPaintBox }
-
-procedure TTntPaintBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntPaintBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntPaintBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntPaintBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntPaintBox.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntPaintBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntPaintBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-type
-{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
- THackImage = class(TGraphicControl)
- protected
- FPicture: TPicture{TNT-ALLOW TPicture};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
- THackImage = class(TGraphicControl)
- protected
- FPicture: TPicture{TNT-ALLOW TPicture};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
- THackImage = class(TGraphicControl)
- private
- FPicture: TPicture{TNT-ALLOW TPicture};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
- 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;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntImage.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntImage.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntImage.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntImage.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntImage.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntImage.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntBevel }
-
-procedure TTntBevel.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntBevel.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntBevel.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntBevel.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntBevel.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntBevel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntBevel.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntCustomPanel }
-
-procedure TTntCustomPanel.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-procedure TTntCustomPanel.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomPanel.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self);
-end;
-
-function TTntCustomPanel.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntCustomPanel.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntCustomPanel.Paint;
-const
- Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
-var
- Rect: TRect;
- TopColor, BottomColor: TColor;
- FontHeight: Integer;
- Flags: Longint;
-
- procedure AdjustColors(Bevel: TPanelBevel);
- begin
- TopColor := clBtnHighlight;
- if Bevel = bvLowered then TopColor := clBtnShadow;
- BottomColor := clBtnShadow;
- if Bevel = bvLowered then BottomColor := clBtnHighlight;
- end;
-
-begin
- if (not Win32PlatformIsUnicode) then
- inherited
- else begin
- Rect := GetClientRect;
- if BevelOuter <> bvNone then
- begin
- AdjustColors(BevelOuter);
- Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
- end;
- {$IFDEF THEME_7_UP}
- if ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} and ParentBackground {$ENDIF} then
- InflateRect(Rect, -BorderWidth, -BorderWidth)
- else
- {$ENDIF}
- begin
- Frame3D(Canvas, Rect, Color, Color, BorderWidth);
- end;
- if BevelInner <> bvNone then
- begin
- AdjustColors(BevelInner);
- Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
- end;
- with Canvas do
- begin
- {$IFDEF THEME_7_UP}
- if not ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} or not ParentBackground {$ENDIF} then
- {$ENDIF}
- begin
- Brush.Color := Color;
- FillRect(Rect);
- end;
- Brush.Style := bsClear;
- Font := Self.Font;
- FontHeight := WideCanvasTextHeight(Canvas, 'W');
- with Rect do
- begin
- Top := ((Bottom + Top) - FontHeight) div 2;
- Bottom := Top + FontHeight;
- end;
- Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
- Flags := DrawTextBiDiModeFlags(Flags);
- Tnt_DrawTextW(Handle, PWideChar(Caption), -1, Rect, Flags);
- end;
- end;
-end;
-
-function TTntCustomPanel.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCustomPanel.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomPanel.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomPanel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomPanel.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntCustomControlBar }
-
-procedure TTntCustomControlBar.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-procedure TTntCustomControlBar.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomControlBar.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomControlBar.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomControlBar.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomControlBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomControlBar.GetActionLinkClass: TControlActionLinkClass;
-begin
- 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.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtDlgs.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtDlgs.pas deleted file mode 100644 index 528c4f9f8f..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntExtDlgs.pas +++ /dev/null @@ -1,317 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntExtDlgs;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, Windows, TntDialogs, TntExtCtrls, TntStdCtrls, TntButtons;
-
-type
-{TNT-WARN TOpenPictureDialog}
- TTntOpenPictureDialog = class(TTntOpenDialog)
- private
- FPicturePanel: TTntPanel;
- FPictureLabel: TTntLabel;
- FPreviewButton: TTntSpeedButton;
- FPaintPanel: TTntPanel;
- FImageCtrl: TTntImage;
- FSavedFilename: WideString;
- function IsFilterStored: Boolean;
- procedure PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
- protected
- procedure PreviewClick(Sender: TObject); virtual;
- procedure DoClose; override;
- procedure DoSelectionChange; override;
- procedure DoShow; override;
- property ImageCtrl: TTntImage read FImageCtrl;
- property PictureLabel: TTntLabel read FPictureLabel;
- published
- property Filter stored IsFilterStored;
- public
- constructor Create(AOwner: TComponent); override;
- function Execute: Boolean; override;
- {$IFDEF COMPILER_9_UP}
- function Execute(ParentWnd: HWND): Boolean; override;
- {$ENDIF}
- end;
-
-{TNT-WARN TSavePictureDialog}
- TTntSavePictureDialog = class(TTntOpenPictureDialog)
- public
- function Execute: Boolean; override;
- {$IFDEF COMPILER_9_UP}
- function Execute(ParentWnd: HWND): Boolean; override;
- {$ENDIF}
- end;
-
-implementation
-
-uses
- ExtDlgs, {ExtDlgs is needed for a linked resource} Dialogs, Consts, Messages,
- Graphics, Math, Controls, Forms, SysUtils, CommDlg, TntSysUtils, TntForms;
-
-{ TTntSilentPaintPanel }
-
-type
- TTntSilentPaintPanel = class(TTntPanel)
- protected
- procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
- end;
-
-procedure TTntSilentPaintPanel.WMPaint(var Msg: TWMPaint);
-begin
- try
- inherited;
- except
- Caption := SInvalidImage;
- end;
-end;
-
-{ TTntOpenPictureDialog }
-
-constructor TTntOpenPictureDialog.Create(AOwner: TComponent);
-begin
- inherited;
- Filter := GraphicFilter(TGraphic);
- FPicturePanel := TTntPanel.Create(Self);
- with FPicturePanel do
- begin
- Name := 'PicturePanel';
- Caption := '';
- SetBounds(204, 5, 169, 200);
- BevelOuter := bvNone;
- BorderWidth := 6;
- TabOrder := 1;
- FPictureLabel := TTntLabel.Create(Self);
- with FPictureLabel do
- begin
- Name := 'PictureLabel';
- Caption := '';
- SetBounds(6, 6, 157, 23);
- Align := alTop;
- AutoSize := False;
- Parent := FPicturePanel;
- end;
- FPreviewButton := TTntSpeedButton.Create(Self);
- with FPreviewButton do
- begin
- Name := 'PreviewButton';
- SetBounds(77, 1, 23, 22);
- Enabled := False;
- Glyph.LoadFromResourceName(FindClassHInstance(TOpenPictureDialog{TNT-ALLOW TOpenPictureDialog}), 'PREVIEWGLYPH');
- Hint := SPreviewLabel;
- ParentShowHint := False;
- ShowHint := True;
- OnClick := PreviewClick;
- Parent := FPicturePanel;
- end;
- FPaintPanel := TTntSilentPaintPanel.Create(Self);
- with FPaintPanel do
- begin
- Name := 'PaintPanel';
- Caption := '';
- SetBounds(6, 29, 157, 145);
- Align := alClient;
- BevelInner := bvRaised;
- BevelOuter := bvLowered;
- TabOrder := 0;
- FImageCtrl := TTntImage.Create(Self);
- Parent := FPicturePanel;
- with FImageCtrl do
- begin
- Name := 'PaintBox';
- Align := alClient;
- OnDblClick := PreviewClick;
- Parent := FPaintPanel;
- Proportional := True;
- Stretch := True;
- Center := True;
- IncrementalDisplay := True;
- end;
- end;
- end;
-end;
-
-procedure TTntOpenPictureDialog.DoClose;
-begin
- inherited;
- { Hide any hint windows left behind }
- Application.HideHint;
-end;
-
-procedure TTntOpenPictureDialog.DoSelectionChange;
-var
- FullName: WideString;
- ValidPicture: Boolean;
-
- function ValidFile(const FileName: WideString): Boolean;
- begin
- Result := WideFileGetAttr(FileName) <> $FFFFFFFF;
- end;
-
-begin
- FullName := FileName;
- if FullName <> FSavedFilename then
- begin
- FSavedFilename := FullName;
- ValidPicture := WideFileExists(FullName) and ValidFile(FullName);
- if ValidPicture then
- try
- FImageCtrl.Picture.LoadFromFile(FullName);
- FPictureLabel.Caption := WideFormat(SPictureDesc,
- [FImageCtrl.Picture.Width, FImageCtrl.Picture.Height]);
- FPreviewButton.Enabled := True;
- FPaintPanel.Caption := '';
- except
- ValidPicture := False;
- end;
- if not ValidPicture then
- begin
- FPictureLabel.Caption := SPictureLabel;
- FPreviewButton.Enabled := False;
- FImageCtrl.Picture := nil;
- FPaintPanel.Caption := srNone;
- end;
- end;
- inherited;
-end;
-
-procedure TTntOpenPictureDialog.DoShow;
-var
- PreviewRect, StaticRect: TRect;
-begin
- { Set preview area to entire dialog }
- GetClientRect(Handle, PreviewRect);
- StaticRect := GetStaticRect;
- { Move preview area to right of static area }
- PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
- Inc(PreviewRect.Top, 4);
- FPicturePanel.BoundsRect := PreviewRect;
- FPreviewButton.Left := FPaintPanel.BoundsRect.Right - FPreviewButton.Width - 2;
- FImageCtrl.Picture := nil;
- FSavedFilename := '';
- FPaintPanel.Caption := srNone;
- FPicturePanel.ParentWindow := Handle;
- inherited;
-end;
-
-function TTntOpenPictureDialog.Execute: Boolean;
-begin
- if NewStyleControls and not (ofOldStyleDialog in Options) then
- Template := 'DLGTEMPLATE' else
- Template := nil;
- Result := inherited Execute;
-end;
-
-{$IFDEF COMPILER_9_UP}
-function TTntOpenPictureDialog.Execute(ParentWnd: HWND): Boolean;
-begin
- if NewStyleControls and not (ofOldStyleDialog in Options) then
- Template := 'DLGTEMPLATE' else
- Template := nil;
- Result := inherited Execute(ParentWnd);
-end;
-{$ENDIF}
-
-function TTntOpenPictureDialog.IsFilterStored: Boolean;
-begin
- Result := not (Filter = GraphicFilter(TGraphic));
-end;
-
-procedure TTntOpenPictureDialog.PreviewClick(Sender: TObject);
-var
- PreviewForm: TTntForm;
- Panel: TTntPanel;
-begin
- PreviewForm := TTntForm.Create(Self);
- with PreviewForm do
- try
- Name := 'PreviewForm';
- BorderStyle := bsSizeToolWin; // By doing this first, it will work on WINE.
- Visible := False;
- Caption := SPreviewLabel;
- KeyPreview := True;
- Position := poScreenCenter;
- OnKeyPress := PreviewKeyPress;
- Panel := TTntPanel.Create(PreviewForm);
- with Panel do
- begin
- Name := 'Panel';
- Caption := '';
- Align := alClient;
- BevelOuter := bvNone;
- BorderStyle := bsSingle;
- BorderWidth := 5;
- Color := clWindow;
- Parent := PreviewForm;
- DoubleBuffered := True;
- with TTntImage.Create(PreviewForm) do
- begin
- Name := 'Image';
- Align := alClient;
- Stretch := True;
- Proportional := True;
- Center := True;
- Picture.Assign(FImageCtrl.Picture);
- Parent := Panel;
- end;
- end;
- if FImageCtrl.Picture.Width > 0 then
- begin
- ClientWidth := Min(Monitor.Width * 3 div 4,
- FImageCtrl.Picture.Width + (ClientWidth - Panel.ClientWidth)+ 10);
- ClientHeight := Min(Monitor.Height * 3 div 4,
- FImageCtrl.Picture.Height + (ClientHeight - Panel.ClientHeight) + 10);
- end;
- ShowModal;
- finally
- Free;
- end;
-end;
-
-procedure TTntOpenPictureDialog.PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
-begin
- if Key = Char{TNT-ALLOW Char}(VK_ESCAPE) then
- (Sender as TTntForm).Close;
-end;
-
-{ TSavePictureDialog }
-function TTntSavePictureDialog.Execute: Boolean;
-begin
- if NewStyleControls and not (ofOldStyleDialog in Options) then
- Template := 'DLGTEMPLATE' else
- Template := nil;
-
- if (not Win32PlatformIsUnicode) then
- Result := DoExecute(@GetSaveFileNameA)
- else
- Result := DoExecuteW(@GetSaveFileNameW);
-end;
-
-{$IFDEF COMPILER_9_UP}
-function TTntSavePictureDialog.Execute(ParentWnd: HWND): Boolean;
-begin
- if NewStyleControls and not (ofOldStyleDialog in Options) then
- Template := 'DLGTEMPLATE' else
- Template := nil;
-
- if (not Win32PlatformIsUnicode) then
- Result := DoExecute(@GetSaveFileNameA, ParentWnd)
- else
- Result := DoExecuteW(@GetSaveFileNameW, ParentWnd);
-end;
-{$ENDIF}
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntFileCtrl.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntFileCtrl.pas deleted file mode 100644 index 892bd801ae..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntFileCtrl.pas +++ /dev/null @@ -1,118 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntFileCtrl;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{$WARN UNIT_PLATFORM OFF}
-
-uses
- Classes, Windows, FileCtrl;
-
-{TNT-WARN SelectDirectory}
-function WideSelectDirectory(const Caption: WideString; const Root: WideString;
- var Directory: WideString): Boolean;
-
-implementation
-
-uses
- SysUtils, Forms, ActiveX, ShlObj, ShellApi, TntSysUtils, TntWindows;
-
-function SelectDirCB_W(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
-begin
- if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
- SendMessageW(Wnd, BFFM_SETSELECTIONW, Integer(True), lpdata);
- result := 0;
-end;
-
-function WideSelectDirectory(const Caption: WideString; const Root: WideString;
- var Directory: WideString): Boolean;
-{$IFNDEF COMPILER_7_UP}
-const
- BIF_NEWDIALOGSTYLE = $0040;
- BIF_USENEWUI = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;
-{$ENDIF}
-var
- WindowList: Pointer;
- BrowseInfo: TBrowseInfoW;
- Buffer: PWideChar;
- OldErrorMode: Cardinal;
- RootItemIDList, ItemIDList: PItemIDList;
- ShellMalloc: IMalloc;
- IDesktopFolder: IShellFolder;
- Eaten, Flags: LongWord;
- AnsiDirectory: AnsiString;
-begin
- if (not Win32PlatformIsUnicode) then begin
- AnsiDirectory := Directory;
- Result := SelectDirectory{TNT-ALLOW SelectDirectory}(Caption, Root, AnsiDirectory);
- Directory := AnsiDirectory;
- end else begin
- Result := False;
- if not WideDirectoryExists(Directory) then
- Directory := '';
- FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
- if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
- begin
- Buffer := ShellMalloc.Alloc(MAX_PATH * SizeOf(WideChar));
- try
- RootItemIDList := nil;
- if Root <> '' then
- begin
- SHGetDesktopFolder(IDesktopFolder);
- IDesktopFolder.ParseDisplayName(Application.Handle, nil,
- POleStr(Root), Eaten, RootItemIDList, Flags);
- end;
- with BrowseInfo do
- begin
- {$IFDEF COMPILER_9_UP}
- hWndOwner := Application.ActiveFormHandle;
- {$ELSE}
- hWndOwner := Application.Handle;
- {$ENDIF}
- pidlRoot := RootItemIDList;
- pszDisplayName := Buffer;
- lpszTitle := PWideChar(Caption);
- ulFlags := BIF_RETURNONLYFSDIRS;
- if Win32MajorVersion >= 5 then
- ulFlags := ulFlags or BIF_USENEWUI;
- if Directory <> '' then
- begin
- lpfn := SelectDirCB_W;
- lParam := Integer(PWideChar(Directory));
- end;
- end;
- WindowList := DisableTaskWindows(0);
- OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
- try
- ItemIDList := Tnt_ShBrowseForFolderW(BrowseInfo);
- finally
- SetErrorMode(OldErrorMode);
- EnableTaskWindows(WindowList);
- end;
- Result := ItemIDList <> nil;
- if Result then
- begin
- Tnt_ShGetPathFromIDListW(ItemIDList, Buffer);
- ShellMalloc.Free(ItemIDList);
- Directory := Buffer;
- end;
- finally
- ShellMalloc.Free(Buffer);
- end;
- end;
- end;
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntFormatStrUtils.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntFormatStrUtils.pas deleted file mode 100644 index 1149ec8f32..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntFormatStrUtils.pas +++ /dev/null @@ -1,503 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntFormatStrUtils;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-// this unit provides functions to work with format strings
-
-uses
- TntSysUtils;
-
-function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
-{$IFNDEF COMPILER_9_UP}
-function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
- const Args: array of const
- {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
-{$ENDIF}
-procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
-function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
-
-type
- EFormatSpecError = class(ETntGeneralError);
-
-implementation
-
-uses
- SysUtils, Math, TntClasses;
-
-resourcestring
- SInvalidFormatSpecifier = 'Invalid Format Specifier: %s';
- SMismatchedArgumentTypes = 'Argument types for index %d do not match. (%s <> %s)';
- SMismatchedArgumentCounts = 'Number of format specifiers do not match.';
-
-type
- TFormatSpecifierType = (fstInteger, fstFloating, fstPointer, fstString);
-
-function GetFormatSpecifierType(const FormatSpecifier: WideString): TFormatSpecifierType;
-var
- LastChar: WideChar;
-begin
- LastChar := TntWideLastChar(FormatSpecifier);
- case LastChar of
- 'd', 'D', 'u', 'U', 'x', 'X':
- result := fstInteger;
- 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'N', 'm', 'M':
- result := fstFloating;
- 'p', 'P':
- result := fstPointer;
- 's', 'S':
- result := fstString
- else
- raise ETntInternalError.CreateFmt('Internal Error: Unexpected format type (%s)', [LastChar]);
- end;
-end;
-
-type
- TFormatStrParser = class(TObject)
- private
- ParsedString: TBufferedWideString;
- PFormatString: PWideChar;
- LastIndex: Integer;
- ExplicitCount: Integer;
- ImplicitCount: Integer;
- procedure RaiseInvalidFormatSpecifier;
- function ParseChar(c: WideChar): Boolean;
- procedure ForceParseChar(c: WideChar);
- function ParseDigit: Boolean;
- function ParseInteger: Boolean;
- procedure ForceParseType;
- function PeekDigit: Boolean;
- function PeekIndexSpecifier(out Index: Integer): Boolean;
- public
- constructor Create(const _FormatString: WideString);
- destructor Destroy; override;
- function ParseFormatSpecifier: Boolean;
- end;
-
-constructor TFormatStrParser.Create(const _FormatString: WideString);
-begin
- inherited Create;
- PFormatString := PWideChar(_FormatString);
- ExplicitCount := 0;
- ImplicitCount := 0;
- LastIndex := -1;
- ParsedString := TBufferedWideString.Create;
-end;
-
-destructor TFormatStrParser.Destroy;
-begin
- FreeAndNil(ParsedString);
- inherited;
-end;
-
-procedure TFormatStrParser.RaiseInvalidFormatSpecifier;
-begin
- raise EFormatSpecError.CreateFmt(SInvalidFormatSpecifier, [ParsedString.Value + PFormatString]);
-end;
-
-function TFormatStrParser.ParseChar(c: WideChar): Boolean;
-begin
- result := False;
- if PFormatString^ = c then begin
- result := True;
- ParsedString.AddChar(c);
- Inc(PFormatString);
- end;
-end;
-
-procedure TFormatStrParser.ForceParseChar(c: WideChar);
-begin
- if not ParseChar(c) then
- RaiseInvalidFormatSpecifier;
-end;
-
-function TFormatStrParser.PeekDigit: Boolean;
-begin
- result := False;
- if (PFormatString^ <> #0)
- and (PFormatString^ >= '0')
- and (PFormatString^ <= '9') then
- result := True;
-end;
-
-function TFormatStrParser.ParseDigit: Boolean;
-begin
- result := False;
- if PeekDigit then begin
- result := True;
- ForceParseChar(PFormatString^);
- end;
-end;
-
-function TFormatStrParser.ParseInteger: Boolean;
-const
- MAX_INT_DIGITS = 6;
-var
- digitcount: integer;
-begin
- digitcount := 0;
- While ParseDigit do begin
- inc(digitcount);
- end;
- result := (digitcount > 0);
- if digitcount > MAX_INT_DIGITS then
- RaiseInvalidFormatSpecifier;
-end;
-
-procedure TFormatStrParser.ForceParseType;
-begin
- if PFormatString^ = #0 then
- RaiseInvalidFormatSpecifier;
-
- case PFormatString^ of
- 'd', 'u', 'x', 'e', 'f', 'g', 'n', 'm', 'p', 's',
- 'D', 'U', 'X', 'E', 'F', 'G', 'N', 'M', 'P', 'S':
- begin
- // do nothing
- end
- else
- RaiseInvalidFormatSpecifier;
- end;
- ForceParseChar(PFormatString^);
-end;
-
-function TFormatStrParser.PeekIndexSpecifier(out Index: Integer): Boolean;
-var
- SaveParsedString: WideString;
- SaveFormatString: PWideChar;
-begin
- SaveParsedString := ParsedString.Value;
- SaveFormatString := PFormatString;
- try
- ParsedString.Clear;
- Result := False;
- Index := -1;
- if ParseInteger then begin
- Index := StrToInt(ParsedString.Value);
- if ParseChar(':') then
- Result := True;
- end;
- finally
- ParsedString.Clear;
- ParsedString.AddString(SaveParsedString);
- PFormatString := SaveFormatString;
- end;
-end;
-
-function TFormatStrParser.ParseFormatSpecifier: Boolean;
-var
- ExplicitIndex: Integer;
-begin
- Result := False;
- // Parse entire format specifier
- ForceParseChar('%');
- if (PFormatString^ <> #0)
- and (not ParseChar(' '))
- and (not ParseChar('%')) then begin
- if PeekIndexSpecifier(ExplicitIndex) then begin
- Inc(ExplicitCount);
- LastIndex := Max(LastIndex, ExplicitIndex);
- end else begin
- Inc(ImplicitCount);
- Inc(LastIndex);
- ParsedString.AddString(IntToStr(LastIndex));
- ParsedString.AddChar(':');
- end;
- if ParseChar('*') then
- begin
- Inc(ImplicitCount);
- Inc(LastIndex);
- ParseChar(':');
- end else if ParseInteger then
- ParseChar(':');
- ParseChar('-');
- if ParseChar('*') then begin
- Inc(ImplicitCount);
- Inc(LastIndex);
- end else
- ParseInteger;
- if ParseChar('.') then begin
- if not ParseChar('*') then
- ParseInteger;
- end;
- ForceParseType;
- Result := True;
- end;
-end;
-
-//-----------------------------------
-
-function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
-var
- PosSpec: Integer;
-begin
- with TFormatStrParser.Create(_FormatString) do
- try
- // loop until no more '%'
- PosSpec := Pos('%', PFormatString);
- While PosSpec <> 0 do begin
- try
- // delete everything up until '%'
- ParsedString.AddBuffer(PFormatString, PosSpec - 1);
- Inc(PFormatString, PosSpec - 1);
- // parse format specifier
- ParseFormatSpecifier;
- finally
- PosSpec := Pos('%', PFormatString);
- end;
- end;
- if ((ExplicitCount = 0) and (ImplicitCount = 1)) {simple expression}
- or ((ExplicitCount > 0) and (ImplicitCount = 0)) {nothing converted} then
- result := _FormatString {original}
- else
- result := ParsedString.Value + PFormatString;
- finally
- Free;
- end;
-end;
-
-{$IFNDEF COMPILER_9_UP}
-function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
- const Args: array of const
- {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
-{ This function replaces floating point format specifiers with their actual formatted values.
- It also adds index specifiers so that the other format specifiers don't lose their place.
- The reason for this is that WideFormat doesn't correctly format floating point specifiers.
- See QC#4254. }
-var
- Parser: TFormatStrParser;
- PosSpec: Integer;
- Output: TBufferedWideString;
-begin
- Output := TBufferedWideString.Create;
- try
- Parser := TFormatStrParser.Create(_FormatString);
- with Parser do
- try
- // loop until no more '%'
- PosSpec := Pos('%', PFormatString);
- While PosSpec <> 0 do begin
- try
- // delete everything up until '%'
- Output.AddBuffer(PFormatString, PosSpec - 1);
- Inc(PFormatString, PosSpec - 1);
- // parse format specifier
- ParsedString.Clear;
- if (not ParseFormatSpecifier)
- or (GetFormatSpecifierType(ParsedString.Value) <> fstFloating) then
- Output.AddBuffer(ParsedString.BuffPtr, MaxInt)
- {$IFDEF COMPILER_7_UP}
- else if Assigned(FormatSettings) then
- Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args, FormatSettings^))
- {$ENDIF}
- else
- Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args));
- finally
- PosSpec := Pos('%', PFormatString);
- end;
- end;
- Output.AddString(PFormatString);
- finally
- Free;
- end;
- Result := Output.Value;
- finally
- Output.Free;
- end;
-end;
-{$ENDIF}
-
-procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);
-var
- PosSpec: Integer;
-begin
- with TFormatStrParser.Create(_FormatString) do
- try
- FormatArgs.Clear;
- // loop until no more '%'
- PosSpec := Pos('%', PFormatString);
- While PosSpec <> 0 do begin
- try
- // delete everything up until '%'
- Inc(PFormatString, PosSpec - 1);
- // add format specifier to list
- ParsedString.Clear;
- if ParseFormatSpecifier then
- FormatArgs.Add(ParsedString.Value);
- finally
- PosSpec := Pos('%', PFormatString);
- end;
- end;
- finally
- Free;
- end;
-end;
-
-function GetExplicitIndex(const FormatSpecifier: WideString): Integer;
-var
- IndexStr: WideString;
- PosColon: Integer;
-begin
- result := -1;
- PosColon := Pos(':', FormatSpecifier);
- if PosColon <> 0 then begin
- IndexStr := Copy(FormatSpecifier, 2, PosColon - 2);
- result := StrToInt(IndexStr);
- end;
-end;
-
-function GetMaxIndex(FormatArgs: TTntStrings): Integer;
-var
- i: integer;
- RunningIndex: Integer;
- ExplicitIndex: Integer;
-begin
- result := -1;
- RunningIndex := -1;
- for i := 0 to FormatArgs.Count - 1 do begin
- ExplicitIndex := GetExplicitIndex(FormatArgs[i]);
- if ExplicitIndex <> -1 then
- RunningIndex := ExplicitIndex
- else
- inc(RunningIndex);
- result := Max(result, RunningIndex);
- end;
-end;
-
-procedure UpdateTypeList(FormatArgs, TypeList: TTntStrings);
-var
- i: integer;
- f: WideString;
- SpecType: TFormatSpecifierType;
- ExplicitIndex: Integer;
- MaxIndex: Integer;
- RunningIndex: Integer;
-begin
- // set count of TypeList to accomodate maximum index
- MaxIndex := GetMaxIndex(FormatArgs);
- TypeList.Clear;
- for i := 0 to MaxIndex do
- TypeList.Add('');
-
- // for each arg...
- RunningIndex := -1;
- for i := 0 to FormatArgs.Count - 1 do begin
- f := FormatArgs[i];
- ExplicitIndex := GetExplicitIndex(f);
- SpecType := GetFormatSpecifierType(f);
-
- // determine running arg index
- if ExplicitIndex <> -1 then
- RunningIndex := ExplicitIndex
- else
- inc(RunningIndex);
-
- if TypeList[RunningIndex] <> '' then begin
- // already exists in list, check for compatibility
- if TypeList.Objects[RunningIndex] <> TObject(SpecType) then
- raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
- [RunningIndex, TypeList[RunningIndex], f]);
- end else begin
- // not in list so update it
- TypeList[RunningIndex] := f;
- TypeList.Objects[RunningIndex] := TObject(SpecType);
- end;
- end;
-end;
-
-procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
-var
- ArgList1: TTntStringList;
- ArgList2: TTntStringList;
- TypeList1: TTntStringList;
- TypeList2: TTntStringList;
- i: integer;
-begin
- ArgList1 := nil;
- ArgList2 := nil;
- TypeList1 := nil;
- TypeList2 := nil;
- try
- ArgList1 := TTntStringList.Create;
- ArgList2 := TTntStringList.Create;
- TypeList1 := TTntStringList.Create;
- TypeList2 := TTntStringList.Create;
-
- GetFormatArgs(FormatStr1, ArgList1);
- UpdateTypeList(ArgList1, TypeList1);
-
- GetFormatArgs(FormatStr2, ArgList2);
- UpdateTypeList(ArgList2, TypeList2);
-
- if TypeList1.Count <> TypeList2.Count then
- raise EFormatSpecError.Create(SMismatchedArgumentCounts + CRLF + CRLF + '> ' + FormatStr1 + CRLF + '> ' + FormatStr2);
-
- for i := 0 to TypeList1.Count - 1 do begin
- if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
- raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
- [i, TypeList1[i], TypeList2[i]]);
- end;
- end;
-
- finally
- ArgList1.Free;
- ArgList2.Free;
- TypeList1.Free;
- TypeList2.Free;
- end;
-end;
-
-function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
-var
- ArgList1: TTntStringList;
- ArgList2: TTntStringList;
- TypeList1: TTntStringList;
- TypeList2: TTntStringList;
- i: integer;
-begin
- ArgList1 := nil;
- ArgList2 := nil;
- TypeList1 := nil;
- TypeList2 := nil;
- try
- ArgList1 := TTntStringList.Create;
- ArgList2 := TTntStringList.Create;
- TypeList1 := TTntStringList.Create;
- TypeList2 := TTntStringList.Create;
-
- GetFormatArgs(FormatStr1, ArgList1);
- UpdateTypeList(ArgList1, TypeList1);
-
- GetFormatArgs(FormatStr2, ArgList2);
- UpdateTypeList(ArgList2, TypeList2);
-
- Result := (TypeList1.Count = TypeList2.Count);
- if Result then begin
- for i := 0 to TypeList1.Count - 1 do begin
- if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
- Result := False;
- break;
- end;
- end;
- end;
- finally
- ArgList1.Free;
- ArgList2.Free;
- TypeList1.Free;
- TypeList2.Free;
- end;
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntForms.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntForms.pas deleted file mode 100644 index 780005714e..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntForms.pas +++ /dev/null @@ -1,873 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntForms;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, Windows, Messages, Controls, Forms, TntControls;
-
-type
-{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;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TCustomFrame}
- TTntCustomFrame = class(TCustomFrame{TNT-ALLOW TCustomFrame})
- private
- function IsHintStored: Boolean;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- 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;
-
-{TNT-WARN TFrame}
- TTntFrame = class(TTntCustomFrame)
- published
- property Align;
- property Anchors;
- property AutoScroll;
- property AutoSize;
- property BiDiMode;
- property Constraints;
- property DockSite;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Color nodefault;
- property Ctl3D;
- property Font;
- {$IFDEF COMPILER_10_UP}
- property Padding;
- {$ENDIF}
- {$IFDEF COMPILER_7_UP}
- property ParentBackground default True;
- {$ENDIF}
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- {$IFDEF COMPILER_9_UP}
- property OnAlignInsertBefore;
- property OnAlignPosition;
- {$ENDIF}
- property OnCanResize;
- property OnClick;
- property OnConstrainedResize;
- property OnContextPopup;
- property OnDblClick;
- property OnDockDrop;
- property OnDockOver;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetSiteInfo;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnMouseWheelDown;
- property OnMouseWheelUp;
- property OnResize;
- property OnStartDock;
- property OnStartDrag;
- property OnUnDock;
- end;
-
-{TNT-WARN TForm}
- TTntForm = class(TForm{TNT-ALLOW TForm})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- 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;
- function CreateDockManager: IDockManager; override;
- public
- constructor Create(AOwner: TComponent); override;
- procedure DefaultHandler(var Message); override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- 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);
- function ApplicationMouseControlHint: WideString;
- 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;
-
-{TNT-WARN PeekMessage}
-{TNT-WARN PeekMessageA}
-{TNT-WARN PeekMessageW}
-procedure EnableManualPeekMessageWithRemove;
-procedure DisableManualPeekMessageWithRemove;
-
-type
- TFormProc = procedure (Form: TForm{TNT-ALLOW TForm});
-
-var
- TntApplication: TTntApplication;
-
-procedure InitTntEnvironment;
-
-implementation
-
-uses
- SysUtils, Consts, RTLConsts, Menus, FlatSB, StdActns,
- Graphics, TntSystem, TntSysUtils, TntMenus, TntActnList, TntStdActns, TntClasses;
-
-function IsWideCharAccel(CharCode: Word; const Caption: WideString): Boolean;
-var
- W: WideChar;
-begin
- W := KeyUnicode(CharCode);
- Result := WideSameText(W, WideGetHotKey(Caption));
-end;
-
-{ TTntScrollBox }
-
-procedure TTntScrollBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-procedure TTntScrollBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntScrollBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntScrollBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntScrollBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntScrollBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntScrollBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- 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);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-procedure TTntCustomFrame.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomFrame.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomFrame.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomFrame.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomFrame.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomFrame.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntForm }
-
-constructor TTntForm.Create(AOwner: TComponent);
-begin
- // standard construction technique (look at TForm.Create)
- GlobalNameSpace.BeginWrite;
- try
- CreateNew(AOwner);
- if (ClassType <> TTntForm) and not (csDesigning in ComponentState) then
- begin
- Include(FFormState, fsCreating);
- try
- if not InitInheritedComponent(Self, TTntForm) then
- raise EResNotFound.CreateFmt(SResNotFound, [ClassName]);
- finally
- Exclude(FFormState, fsCreating);
- end;
- if OldCreateOrder then DoCreate;
- end;
- finally
- GlobalNameSpace.EndWrite;
- end;
-end;
-
-procedure TTntForm.CreateWindowHandle(const Params: TCreateParams);
-var
- NewParams: TCreateParams;
- WideWinClassName: WideString;
-begin
- if (not Win32PlatformIsUnicode) then
- inherited
- else if (FormStyle = fsMDIChild) and not (csDesigning in ComponentState) then
- begin
- if (Application.MainForm = nil) or
- (Application.MainForm.ClientHandle = 0) then
- raise EInvalidOperation.Create(SNoMDIForm);
- RegisterUnicodeClass(Params, WideWinClassName);
- DefWndProc := @DefMDIChildProcW;
- WindowHandle := CreateMDIWindowW(PWideChar(WideWinClassName),
- nil, Params.style, Params.X, Params.Y, Params.Width, Params.Height,
- Application.MainForm.ClientHandle, hInstance, Longint(Params.Param));
- if WindowHandle = 0 then
- RaiseLastOSError;
- SubClassUnicodeControl(Self, Params.Caption);
- Include(FFormState, fsCreatedMDIChild);
- end else
- begin
- NewParams := Params;
- NewParams.ExStyle := NewParams.ExStyle and not WS_EX_LAYERED;
- CreateUnicodeHandle(Self, NewParams, '');
- Exclude(FFormState, fsCreatedMDIChild);
- end;
- 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;
-end;
-
-procedure TTntForm.DestroyWindowHandle;
-begin
- if Win32PlatformIsUnicode then
- UninitializeFlatSB(Handle); { Bug in VCL: Without this there might be a resource leak. }
- inherited;
-end;
-
-procedure TTntForm.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntForm.DefaultHandler(var Message);
-begin
- if (ClientHandle <> 0)
- and (Win32PlatformIsUnicode) then begin
- with TMessage(Message) do begin
- if (Msg = WM_SIZE) then
- Result := DefWindowProcW(Handle, Msg, wParam, lParam)
- else
- Result := DefFrameProcW(Handle, ClientHandle, Msg, wParam, lParam);
- if (Msg = WM_DESTROY) then
- Perform(TNT_WM_DESTROY, 0, 0); { This ensures that the control is Unsubclassed. }
- end;
- end else
- inherited DefaultHandler(Message);
-end;
-
-function TTntForm.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self);
-end;
-
-function TTntForm.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntForm.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value)
-end;
-
-function TTntForm.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntForm.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntForm.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntForm.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntForm.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-procedure 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.UpdateActions;
-begin
- inherited;
- TntApplication.DoIdle;
-end;
-
-procedure 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.WMWindowPosChanging(var Message: TMessage);
-begin
- inherited;
- // This message *sometimes* means that the Menu.BiDiMode changed.
- FixMenuBiDiProblem(Menu);
-end;
-
-function TTntForm.CreateDockManager: IDockManager;
-begin
- if (DockManager = nil) and DockSite and UseDockManager then
- HandleNeeded; // force TNT subclassing to occur first
- Result := inherited CreateDockManager;
-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
- // check to see if the hint has already been set on application.idle
- if Application.Hint = AnsiString(ApplicationMouseControlHint) then
- FHint := ApplicationMouseControlHint;
- // get the synced string
- 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(Value)));
- FTitle := '';
- end
- end else
- SetSyncedWideString(Value, FTitle, Application.Title, SetAnsiApplicationTitle);
-end;
-
-{$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} // verified against VCL source in 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} // verified against VCL source in 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}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
-type
- THackApplication = class(TComponent)
- protected
- FxxxxxxxxxHandle: HWnd;
- FxxxxxxxxxBiDiMode: TBiDiMode;
- FxxxxxxxxxBiDiKeyboard: AnsiString;
- FxxxxxxxxxNonBiDiKeyboard: AnsiString;
- FxxxxxxxxxObjectInstance: Pointer;
- FxxxxxxxxxMainForm: TForm{TNT-ALLOW TForm};
- FMouseControl: TControl;
- end;
-{$ENDIF}
-
-function TTntApplication.ApplicationMouseControlHint: WideString;
-var
- MouseControl: TControl;
-begin
- MouseControl := THackApplication(Application).FMouseControl;
- Result := WideGetLongHint(WideGetHint(MouseControl));
-end;
-
-procedure TTntApplication.DoIdle;
-begin
- // update TntApplication.Hint only when Ansi encodings are the same... (otherwise there are problems with action menus)
- if Application.Hint = AnsiString(ApplicationMouseControlHint) then
- Hint := ApplicationMouseControlHint;
-end;
-
-function TTntApplication.IsDlgMsg(var Msg: TMsg): Boolean;
-begin
- Result := False;
- if (Application.DialogHandle <> 0) then begin
- if IsWindowUnicode(Application.DialogHandle) then
- Result := IsDialogMessageW(Application.DialogHandle, Msg)
- else
- Result := IsDialogMessageA(Application.DialogHandle, Msg);
- end;
-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) 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 ((Application.DialogHandle = 0) 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).
-// Special thanks go to Francisco Leong for developing this solution.
-//
-// Example:
-// 1. Install "Turkic" language support.
-// 2. Add "Azeri (Latin)" as an input locale.
-// 3. In an EDIT, enter Shift+I. (You should see a capital "I" with dot.)
-// 4. In an EDIT, enter single quote (US Keyboard). (You should see an upturned "e".)
-//
-var
- ManualPeekMessageWithRemove: Integer = 0;
-
-procedure EnableManualPeekMessageWithRemove;
-begin
- Inc(ManualPeekMessageWithRemove);
-end;
-
-procedure DisableManualPeekMessageWithRemove;
-begin
- if (ManualPeekMessageWithRemove > 0) then
- Dec(ManualPeekMessageWithRemove);
-end;
-
-var
- NTGetMessageHook: HHOOK;
-
-function GetMessageForNT(Code: Integer; wParam: Integer; lParam: Integer): LRESULT; stdcall;
-var
- ThisMsg: PMSG;
-begin
- if (Code >= 0)
- and (wParam = PM_REMOVE)
- and (ManualPeekMessageWithRemove = 0) then
- begin
- ThisMsg := PMSG(lParam);
- 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 CreateGetMessageHookForNT;
-begin
- Assert(Win32Platform = VER_PLATFORM_WIN32_NT);
- NTGetMessageHook := SetWindowsHookExW(WH_GETMESSAGE, GetMessageForNT, 0, GetCurrentThreadID);
- if NTGetMessageHook = 0 then
- RaiseLastOSError;
-end;
-
-//---------------------------------------------------------------------------------------------
-// Tnt Environment Setup
-//---------------------------------------------------------------------------------------------
-
-procedure InitTntEnvironment;
-
- function GetDefaultFont: WideString;
-
- function RunningUnderIDE: Boolean;
- begin
- Result := ModuleIsPackage and
- ( WideSameText(WideExtractFileName(WideGetModuleFileName(0)), 'bds.exe')
- or 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.HandleException(nil);
- 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
- // Tnt Environment Setup
- InstallTntSystemUpdates;
- DefFontData.Name := GetDefaultFont;
- Forms.HintWindowClass := TntControls.TTntHintWindow;
-end;
-
-initialization
- TntApplication := TTntApplication.Create(nil);
- if Win32Platform = VER_PLATFORM_WIN32_NT then
- CreateGetMessageHookForNT;
-
-finalization
- if NTGetMessageHook <> 0 then begin
- UnhookWindowsHookEx(NTGetMessageHook) // no Win32Check, fails in too many cases, and doesn't matter
- end;
- FreeAndNil(TntApplication);
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntGraphics.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntGraphics.pas deleted file mode 100644 index 617b901f77..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntGraphics.pas +++ /dev/null @@ -1,142 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntGraphics;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Graphics, Windows;
-
-{TNT-WARN TextRect}
-procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
-{TNT-WARN TextOut}
-procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
-{TNT-WARN TextExtent}
-function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
-function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
-{TNT-WARN TextWidth}
-function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
-{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, TntSysUtils;
-
-type
- TAccessCanvas = class(TCanvas);
-
-procedure WideCanvasTextRect(Canvas: TCanvas; Rect: TRect; X, Y: Integer; const Text: WideString);
-var
- Options: Longint;
-begin
- with TAccessCanvas(Canvas) do begin
- Changing;
- RequiredState([csHandleValid, csFontValid, csBrushValid]);
- Options := ETO_CLIPPED or TextFlags;
- if Brush.Style <> bsClear then
- Options := Options or ETO_OPAQUE;
- if ((TextFlags and ETO_RTLREADING) <> 0) and
- (CanvasOrientation = coRightToLeft) then Inc(X, WideCanvasTextWidth(Canvas, Text) + 1);
- Windows.ExtTextOutW(Handle, X, Y, Options, @Rect, PWideChar(Text),
- Length(Text), nil);
- Changed;
- end;
-end;
-
-procedure WideCanvasTextOut(Canvas: TCanvas; X, Y: Integer; const Text: WideString);
-begin
- with TAccessCanvas(Canvas) do begin
- Changing;
- RequiredState([csHandleValid, csFontValid, csBrushValid]);
- if CanvasOrientation = coRightToLeft then Inc(X, WideCanvasTextWidth(Canvas, Text) + 1);
- Windows.ExtTextOutW(Handle, X, Y, TextFlags, nil, PWideChar(Text),
- Length(Text), nil);
- MoveTo(X + WideCanvasTextWidth(Canvas, Text), Y);
- Changed;
- end;
-end;
-
-function WideDCTextExtent(hDC: THandle; const Text: WideString): TSize;
-begin
- Result.cx := 0;
- Result.cy := 0;
- Windows.GetTextExtentPoint32W(hDC, PWideChar(Text), Length(Text), Result);
-end;
-
-function WideCanvasTextExtent(Canvas: TCanvas; const Text: WideString): TSize;
-begin
- with TAccessCanvas(Canvas) do begin
- RequiredState([csHandleValid, csFontValid]);
- Result := WideDCTextExtent(Handle, Text);
- end;
-end;
-
-function WideCanvasTextWidth(Canvas: TCanvas; const Text: WideString): Integer;
-begin
- Result := WideCanvasTextExtent(Canvas, Text).cX;
-end;
-
-function WideCanvasTextHeight(Canvas: TCanvas; const Text: WideString): Integer;
-begin
- Result := WideCanvasTextExtent(Canvas, Text).cY;
-end;
-
-{ TTntPicture }
-
-procedure TTntPicture.LoadFromFile(const Filename: WideString);
-var
- ShortName: WideString;
-begin
- ShortName := WideExtractShortPathName(Filename);
- if WideSameText(WideExtractFileExt(FileName), '.jpeg') // the short name ends with ".JPE"!
- or (ShortName = '') then // GetShortPathName failed
- inherited LoadFromFile(FileName)
- 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.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntGrids.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntGrids.pas deleted file mode 100644 index 8096cd445b..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntGrids.pas +++ /dev/null @@ -1,675 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntGrids;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, TntClasses, Grids, Windows, Controls, Messages;
-
-type
-{TNT-WARN TInplaceEdit}
- TTntInplaceEdit = class(TInplaceEdit{TNT-ALLOW TInplaceEdit})
- private
- function GetText: WideString;
- procedure SetText(const Value: WideString);
- protected
- procedure UpdateContents; override;
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- public
- property Text: WideString read GetText write SetText;
- end;
-
- TTntGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: WideString) of object;
- TTntSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: WideString) of object;
-
-{TNT-WARN TCustomDrawGrid}
- _TTntInternalCustomDrawGrid = class(TCustomDrawGrid{TNT-ALLOW TCustomDrawGrid})
- private
- FSettingEditText: Boolean;
- procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); dynamic; abstract;
- protected
- procedure SetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
- end;
-
- TTntCustomDrawGrid = class(_TTntInternalCustomDrawGrid)
- private
- FOnGetEditText: TTntGetEditEvent;
- FOnSetEditText: TTntSetEditEvent;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure WMChar(var Msg: TWMChar); message WM_CHAR;
- protected
- function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
- procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
- function GetEditText(ACol, ARow: Longint): WideString; reintroduce; virtual;
- procedure SetEditText(ACol, ARow: Longint; const Value: WideString); reintroduce; virtual;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure ShowEditorChar(Ch: WideChar); dynamic;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- property OnGetEditText: TTntGetEditEvent read FOnGetEditText write FOnGetEditText;
- property OnSetEditText: TTntSetEditEvent read FOnSetEditText write FOnSetEditText;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TDrawGrid}
- TTntDrawGrid = class(TTntCustomDrawGrid)
- published
- property Align;
- property Anchors;
- property BevelEdges;
- property BevelInner;
- property BevelKind;
- property BevelOuter;
- property BevelWidth;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property ColCount;
- property Constraints;
- property Ctl3D;
- property DefaultColWidth;
- property DefaultRowHeight;
- property DefaultDrawing;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property FixedColor;
- property FixedCols;
- property RowCount;
- property FixedRows;
- property Font;
- property GridLineWidth;
- property Options;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ScrollBars;
- property ShowHint;
- property TabOrder;
- property Visible;
- property VisibleColCount;
- property VisibleRowCount;
- property OnClick;
- property OnColumnMoved;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawCell;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetEditMask;
- property OnGetEditText;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheelDown;
- property OnMouseWheelUp;
- property OnRowMoved;
- property OnSelectCell;
- property OnSetEditText;
- property OnStartDock;
- property OnStartDrag;
- property OnTopLeftChanged;
- end;
-
- TTntStringGrid = class;
-
-{TNT-WARN TStringGridStrings}
- TTntStringGridStrings = class(TTntStrings)
- private
- FIsCol: Boolean;
- FColRowIndex: Integer;
- FGrid: TTntStringGrid;
- function GridAnsiStrings: TStrings{TNT-ALLOW TStrings};
- protected
- function Get(Index: Integer): WideString; override;
- procedure Put(Index: Integer; const S: WideString); override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetUpdateState(Updating: Boolean); override;
- public
- constructor Create(AGrid: TTntStringGrid; AIndex: Longint);
- function Add(const S: WideString): Integer; override;
- procedure Assign(Source: TPersistent); override;
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- procedure Insert(Index: Integer; const S: WideString); override;
- end;
-
-{TNT-WARN TStringGrid}
- _TTntInternalStringGrid = class(TStringGrid{TNT-ALLOW TStringGrid})
- private
- FSettingEditText: Boolean;
- procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); dynamic; abstract;
- protected
- procedure SetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
- end;
-
- TTntStringGrid = class(_TTntInternalStringGrid)
- private
- FCreatedRowStrings: TStringList{TNT-ALLOW TStringList};
- FCreatedColStrings: TStringList{TNT-ALLOW TStringList};
- FOnGetEditText: TTntGetEditEvent;
- FOnSetEditText: TTntSetEditEvent;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure WMChar(var Msg: TWMChar); message WM_CHAR;
- function GetCells(ACol, ARow: Integer): WideString;
- procedure SetCells(ACol, ARow: Integer; const Value: WideString);
- 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;
- procedure InternalSetEditText(ACol, ARow: Longint; const Value: string{TNT-ALLOW string}); override;
- function GetEditText(ACol, ARow: Longint): WideString; reintroduce; virtual;
- procedure SetEditText(ACol, ARow: Longint; const Value: WideString); reintroduce; virtual;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure ShowEditorChar(Ch: WideChar); dynamic;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property Cells[ACol, ARow: Integer]: WideString read GetCells write SetCells;
- 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;
- property OnSetEditText: TTntSetEditEvent read FOnSetEditText write FOnSetEditText;
- end;
-
-implementation
-
-uses
- SysUtils, TntSystem, TntGraphics, TntControls, TntStdCtrls, TntActnList, TntSysUtils;
-
-{ TBinaryCompareAnsiStringList }
-type
- TBinaryCompareAnsiStringList = class(TStringList{TNT-ALLOW TStringList})
- protected
- function CompareStrings(const S1, S2: string{TNT-ALLOW string}): Integer; override;
- end;
-
-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;
-
-{ TTntInplaceEdit }
-
-procedure TTntInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
-begin
- TntCustomEdit_CreateWindowHandle(Self, Params);
-end;
-
-function TTntInplaceEdit.GetText: WideString;
-begin
- if IsMasked then
- Result := inherited Text
- else
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntInplaceEdit.SetText(const Value: WideString);
-begin
- if IsMasked then
- inherited Text := Value
- else
- TntControl_SetText(Self, Value);
-end;
-
-type TAccessCustomGrid = class(TCustomGrid);
-
-procedure TTntInplaceEdit.UpdateContents;
-begin
- Text := '';
- with TAccessCustomGrid(Grid) do
- Self.EditMask := GetEditMask(Col, Row);
- if (Grid is TTntStringGrid) then
- with (Grid as TTntStringGrid) do
- Self.Text := GetEditText(Col, Row)
- else if (Grid is TTntCustomDrawGrid) then
- with (Grid as TTntCustomDrawGrid) do
- Self.Text := GetEditText(Col, Row)
- else
- with TAccessCustomGrid(Grid) do
- Self.Text := GetEditText(Col, Row);
- with TAccessCustomGrid(Grid) do
- Self.MaxLength := GetEditLimit;
-end;
-
-{ _TTntInternalCustomDrawGrid }
-
-procedure _TTntInternalCustomDrawGrid.SetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
-begin
- if FSettingEditText then
- inherited
- else
- InternalSetEditText(ACol, ARow, Value);
-end;
-
-
-{ TTntCustomDrawGrid }
-
-function TTntCustomDrawGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
-begin
- Result := TTntInplaceEdit.Create(Self);
-end;
-
-procedure TTntCustomDrawGrid.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-procedure TTntCustomDrawGrid.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomDrawGrid.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomDrawGrid.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomDrawGrid.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-function TTntCustomDrawGrid.GetEditText(ACol, ARow: Integer): WideString;
-begin
- Result := '';
- if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
-end;
-
-procedure TTntCustomDrawGrid.InternalSetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
-begin
- if not FSettingEditText then
- SetEditText(ACol, ARow, TntControl_GetText(InplaceEditor));
-end;
-
-procedure TTntCustomDrawGrid.SetEditText(ACol, ARow: Integer; const Value: WideString);
-begin
- if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
-end;
-
-procedure TTntCustomDrawGrid.WMChar(var Msg: TWMChar);
-begin
- if (goEditing in Options)
- and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
- RestoreWMCharMsg(TMessage(Msg));
- ShowEditorChar(WideChar(Msg.CharCode));
- end else
- inherited;
-end;
-
-procedure TTntCustomDrawGrid.ShowEditorChar(Ch: WideChar);
-begin
- ShowEditor;
- if InplaceEditor <> nil then begin
- if Win32PlatformIsUnicode then
- PostMessageW(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0)
- else
- PostMessageA(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0);
- end;
-end;
-
-procedure TTntCustomDrawGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomDrawGrid.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntStringGridStrings }
-
-procedure TTntStringGridStrings.Assign(Source: TPersistent);
-var
- UTF8Strings: TStringList{TNT-ALLOW TStringList};
- i: integer;
-begin
- UTF8Strings := TStringList{TNT-ALLOW TStringList}.Create;
- try
- if Source is TStrings{TNT-ALLOW TStrings} then begin
- 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]);
- 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
- GridAnsiStrings.Assign(Source);
- finally
- UTF8Strings.Free;
- end;
-end;
-
-function TTntStringGridStrings.GridAnsiStrings: TStrings{TNT-ALLOW TStrings};
-begin
- Assert(Assigned(FGrid));
- if FIsCol then
- Result := TStringGrid{TNT-ALLOW TStringGrid}(FGrid).Cols[FColRowIndex]
- else
- Result := TStringGrid{TNT-ALLOW TStringGrid}(FGrid).Rows[FColRowIndex];
-end;
-
-procedure TTntStringGridStrings.Clear;
-begin
- GridAnsiStrings.Clear;
-end;
-
-procedure TTntStringGridStrings.Delete(Index: Integer);
-begin
- GridAnsiStrings.Delete(Index);
-end;
-
-function TTntStringGridStrings.GetCount: Integer;
-begin
- Result := GridAnsiStrings.Count;
-end;
-
-function TTntStringGridStrings.Get(Index: Integer): WideString;
-begin
- Result := UTF8ToWideString(GridAnsiStrings[Index]);
-end;
-
-procedure TTntStringGridStrings.Put(Index: Integer; const S: WideString);
-begin
- GridAnsiStrings[Index] := WideStringToUTF8(S);
-end;
-
-procedure TTntStringGridStrings.Insert(Index: Integer; const S: WideString);
-begin
- GridAnsiStrings.Insert(Index, WideStringToUTF8(S));
-end;
-
-function TTntStringGridStrings.Add(const S: WideString): Integer;
-begin
- Result := GridAnsiStrings.Add(WideStringToUTF8(S));
-end;
-
-function TTntStringGridStrings.GetObject(Index: Integer): TObject;
-begin
- Result := GridAnsiStrings.Objects[Index];
-end;
-
-procedure TTntStringGridStrings.PutObject(Index: Integer; AObject: TObject);
-begin
- GridAnsiStrings.Objects[Index] := AObject;
-end;
-
-type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
-
-procedure TTntStringGridStrings.SetUpdateState(Updating: Boolean);
-begin
- TAccessStrings(GridAnsiStrings).SetUpdateState(Updating);
-end;
-
-constructor TTntStringGridStrings.Create(AGrid: TTntStringGrid; AIndex: Integer);
-begin
- inherited Create;
- FGrid := AGrid;
- if AIndex > 0 then begin
- FIsCol := False;
- FColRowIndex := AIndex - 1;
- end else begin
- FIsCol := True;
- FColRowIndex := -AIndex - 1;
- end;
-end;
-
-{ _TTntInternalStringGrid }
-
-procedure _TTntInternalStringGrid.SetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
-begin
- if FSettingEditText then
- inherited
- else
- InternalSetEditText(ACol, ARow, Value);
-end;
-
-{ TTntStringGrid }
-
-constructor TTntStringGrid.Create(AOwner: TComponent);
-begin
- inherited;
- FCreatedRowStrings := TBinaryCompareAnsiStringList.Create;
- FCreatedRowStrings.Sorted := True;
- FCreatedRowStrings.Duplicates := dupError;
- FCreatedColStrings := TBinaryCompareAnsiStringList.Create;
- FCreatedColStrings.Sorted := True;
- FCreatedColStrings.Duplicates := dupError;
-end;
-
-destructor TTntStringGrid.Destroy;
-var
- i: integer;
-begin
- for i := FCreatedColStrings.Count - 1 downto 0 do
- FCreatedColStrings.Objects[i].Free;
- for i := FCreatedRowStrings.Count - 1 downto 0 do
- FCreatedRowStrings.Objects[i].Free;
- FreeAndNil(FCreatedColStrings);
- FreeAndNil(FCreatedRowStrings);
- inherited;
-end;
-
-function TTntStringGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
-begin
- Result := TTntInplaceEdit.Create(Self);
-end;
-
-procedure TTntStringGrid.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-procedure TTntStringGrid.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntStringGrid.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntStringGrid.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntStringGrid.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-function TTntStringGrid.GetCells(ACol, ARow: Integer): WideString;
-begin
- Result := UTF8ToWideString(inherited Cells[ACol, ARow])
-end;
-
-procedure TTntStringGrid.SetCells(ACol, ARow: Integer; const Value: WideString);
-var
- UTF8Str: AnsiString;
-begin
- UTF8Str := WideStringToUTF8(Value);
- if inherited Cells[ACol, ARow] <> UTF8Str then
- inherited Cells[ACol, ARow] := UTF8Str;
-end;
-
-function TTntStringGrid.FindGridStrings(const IsCol: Boolean; const ListIndex: Integer): TTntStrings;
-var
- idx: integer;
- SrcStrings: TStrings{TNT-ALLOW TStrings};
- RCIndex: Integer;
-begin
- if IsCol then
- SrcStrings := FCreatedColStrings
- else
- SrcStrings := FCreatedRowStrings;
- Assert(Assigned(SrcStrings));
- idx := SrcStrings.IndexOf(IntToStr(ListIndex));
- if idx <> -1 then
- Result := SrcStrings.Objects[idx] as TTntStrings
- else begin
- if IsCol then RCIndex := -ListIndex - 1 else RCIndex := ListIndex + 1;
- Result := TTntStringGridStrings.Create(Self, RCIndex);
- SrcStrings.AddObject(IntToStr(ListIndex), Result);
- end;
-end;
-
-function TTntStringGrid.GetCols(Index: Integer): TTntStrings;
-begin
- Result := FindGridStrings(True, Index);
-end;
-
-function TTntStringGrid.GetRows(Index: Integer): TTntStrings;
-begin
- Result := FindGridStrings(False, Index);
-end;
-
-procedure TTntStringGrid.SetCols(Index: Integer; const Value: TTntStrings);
-begin
- FindGridStrings(True, Index).Assign(Value);
-end;
-
-procedure TTntStringGrid.SetRows(Index: Integer; const Value: TTntStrings);
-begin
- FindGridStrings(False, Index).Assign(Value);
-end;
-
-procedure TTntStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
-var
- SaveDefaultDrawing: Boolean;
-begin
- if DefaultDrawing then
- WideCanvasTextRect(Canvas, ARect, ARect.Left+2, ARect.Top+2, Cells[ACol, ARow]);
- SaveDefaultDrawing := DefaultDrawing;
- try
- DefaultDrawing := False;
- inherited DrawCell(ACol, ARow, ARect, AState);
- finally
- DefaultDrawing := SaveDefaultDrawing;
- end;
-end;
-
-function TTntStringGrid.GetEditText(ACol, ARow: Integer): WideString;
-begin
- Result := Cells[ACol, ARow];
- if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
-end;
-
-procedure TTntStringGrid.InternalSetEditText(ACol, ARow: Integer; const Value: string{TNT-ALLOW string});
-begin
- if not FSettingEditText then
- SetEditText(ACol, ARow, TntControl_GetText(InplaceEditor));
-end;
-
-procedure TTntStringGrid.SetEditText(ACol, ARow: Integer; const Value: WideString);
-begin
- FSettingEditText := True;
- try
- inherited SetEditText(ACol, ARow, WideStringToUTF8(Value));
- finally
- FSettingEditText := False;
- end;
- if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
-end;
-
-procedure TTntStringGrid.WMChar(var Msg: TWMChar);
-begin
- if (goEditing in Options)
- and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
- RestoreWMCharMsg(TMessage(Msg));
- ShowEditorChar(WideChar(Msg.CharCode));
- end else
- inherited;
-end;
-
-procedure TTntStringGrid.ShowEditorChar(Ch: WideChar);
-begin
- ShowEditor;
- if InplaceEditor <> nil then begin
- if Win32PlatformIsUnicode then
- PostMessageW(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0)
- else
- PostMessageA(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0);
- end;
-end;
-
-procedure TTntStringGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntStringGrid.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntIniFiles.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntIniFiles.pas deleted file mode 100644 index 7219950865..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntIniFiles.pas +++ /dev/null @@ -1,1011 +0,0 @@ -{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ }
-{ Portions created by Wild Hunter are }
-{ Copyright (c) 2003 Wild Hunter (raguotis@freemail.lt) }
-{ }
-{ Portions created by Stanley Xu are }
-{ Copyright (c) 1999-2006 Stanley Xu }
-{ (http://gosurfbrowser.com/?go=supportFeedback&ln=en) }
-{ }
-{ Portions created by Borland Software Corporation are }
-{ Copyright (c) 1995-2001 Borland Software Corporation }
-{ }
-{*****************************************************************************}
-
-unit TntIniFiles;
-
-{$R-,T-,H+,X+}
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, IniFiles,
- TntClasses;
-
-type
-
- TTntCustomIniFile = class({TCustomIniFile}TObject{TNT-ALLOW TObject})
- private
- FFileName: WideString;
- public
- constructor Create(const FileName: WideString);
- function SectionExists(const Section: WideString): Boolean;
- function ReadString(const Section, Ident, Default: WideString): WideString; virtual; abstract;
- procedure WriteString(const Section, Ident, Value: WideString); virtual; abstract;
- function ReadInteger(const Section, Ident: WideString; Default: Longint): Longint; virtual;
- procedure WriteInteger(const Section, Ident: WideString; Value: Longint); virtual;
- function ReadBool(const Section, Ident: WideString; Default: Boolean): Boolean; virtual;
- procedure WriteBool(const Section, Ident: WideString; Value: Boolean); virtual;
- function ReadBinaryStream(const Section, Name: WideString; Value: TStream): Integer; virtual;
- function ReadDate(const Section, Name: WideString; Default: TDateTime): TDateTime; virtual;
- function ReadDateTime(const Section, Name: WideString; Default: TDateTime): TDateTime; virtual;
- function ReadFloat(const Section, Name: WideString; Default: Double): Double; virtual;
- function ReadTime(const Section, Name: WideString; Default: TDateTime): TDateTime; virtual;
- procedure WriteBinaryStream(const Section, Name: WideString; Value: TStream); virtual;
- procedure WriteDate(const Section, Name: WideString; Value: TDateTime); virtual;
- procedure WriteDateTime(const Section, Name: WideString; Value: TDateTime); virtual;
- procedure WriteFloat(const Section, Name: WideString; Value: Double); virtual;
- procedure WriteTime(const Section, Name: WideString; Value: TDateTime); virtual;
- procedure ReadSection(const Section: WideString; Strings: TTntStrings); virtual; abstract;
- procedure ReadSections(Strings: TTntStrings); virtual; abstract;
- procedure ReadSectionValues(const Section: WideString; Strings: TTntStrings); virtual; abstract;
- procedure EraseSection(const Section: WideString); virtual; abstract;
- procedure DeleteKey(const Section, Ident: WideString); virtual; abstract;
- procedure UpdateFile; virtual; abstract;
- function ValueExists(const Section, Ident: WideString): Boolean;
- property FileName: WideString read FFileName;
- end;
-
- { TTntStringHash - used internally by TTntMemIniFile to optimize searches. }
-
- PPTntHashItem = ^PTntHashItem;
- PTntHashItem = ^TTntHashItem;
- TTntHashItem = record
- Next: PTntHashItem;
- Key: WideString;
- Value: Integer;
- end;
-
- TTntStringHash = class
- private
- Buckets: array of PTntHashItem;
- protected
- function Find(const Key: WideString): PPTntHashItem;
- function HashOf(const Key: WideString): Cardinal; virtual;
- public
- constructor Create(Size: Integer = 256);
- destructor Destroy; override;
- procedure Add(const Key: WideString; Value: Integer);
- procedure Clear;
- procedure Remove(const Key: WideString);
- function Modify(const Key: WideString; Value: Integer): Boolean;
- function ValueOf(const Key: WideString): Integer;
- end;
-
- { TTntHashedStringList - A TTntStringList that uses TTntStringHash to improve the
- speed of Find }
-
- TTntHashedStringList = class(TTntStringList)
- private
- FValueHash: TTntStringHash;
- FNameHash: TTntStringHash;
- FValueHashValid: Boolean;
- FNameHashValid: Boolean;
- procedure UpdateValueHash;
- procedure UpdateNameHash;
- protected
- procedure Changed; override;
- public
- destructor Destroy; override;
- function IndexOf(const S: WideString): Integer; override;
- function IndexOfName(const Name: WideString): Integer; override;
- end;
-
- { TTntMemIniFile - loads and entire ini file into memory and allows all
- operations to be performed on the memory image. The image can then
- be written out to the disk file }
-
- TTntMemIniFile = class(TTntCustomIniFile)
- private
- FSections: TTntStringList;
- function AddSection(const Section: WideString): TTntStrings;
- function GetCaseSensitive: Boolean;
- procedure SetCaseSensitive(Value: Boolean);
- procedure LoadValues;
- public
- constructor Create(const FileName: WideString); virtual;
- destructor Destroy; override;
- procedure Clear;
- procedure DeleteKey(const Section, Ident: WideString); override;
- procedure EraseSection(const Section: WideString); override;
- procedure GetStrings(List: TTntStrings);
- procedure ReadSection(const Section: WideString; Strings: TTntStrings); override;
- procedure ReadSections(Strings: TTntStrings); override;
- procedure ReadSectionValues(const Section: WideString; Strings: TTntStrings); override;
- function ReadString(const Section, Ident, Default: WideString): WideString; override;
- procedure Rename(const FileName: WideString; Reload: Boolean);
- procedure SetStrings(List: TTntStrings);
- procedure UpdateFile; override;
- procedure WriteString(const Section, Ident, Value: WideString); override;
- property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
- end;
-
-{$IFDEF MSWINDOWS}
- { TTntIniFile - Encapsulates the Windows INI file interface
- (Get/SetPrivateProfileXXX functions) }
-
- TTntIniFile = class(TTntCustomIniFile)
- private
- FAnsiIniFile: TIniFile; // For compatibility with Windows 95/98/Me
- public
- constructor Create(const FileName: WideString); virtual;
- destructor Destroy; override;
- function ReadString(const Section, Ident, Default: WideString): WideString; override;
- procedure WriteString(const Section, Ident, Value: WideString); override;
- procedure ReadSection(const Section: WideString; Strings: TTntStrings); override;
- procedure ReadSections(Strings: TTntStrings); override;
- procedure ReadSectionValues(const Section: WideString; Strings: TTntStrings); override;
- procedure EraseSection(const Section: WideString); override;
- procedure DeleteKey(const Section, Ident: WideString); override;
- procedure UpdateFile; override;
- end;
-{$ELSE}
- TTntIniFile = class(TTntMemIniFile)
- public
- destructor Destroy; override;
- end;
-{$ENDIF}
-
-
-implementation
-
-uses
- RTLConsts, SysUtils, TntSysUtils
-{$IFDEF COMPILER_9_UP} , WideStrUtils {$ELSE} , TntWideStrUtils {$ENDIF}
-{$IFDEF MSWINDOWS} , Windows {$ENDIF};
-
-{ TTntCustomIniFile }
-
-constructor TTntCustomIniFile.Create(const FileName: WideString);
-begin
- FFileName := FileName;
-end;
-
-function TTntCustomIniFile.SectionExists(const Section: WideString): Boolean;
-var
- S: TTntStrings;
-begin
- S := TTntStringList.Create;
- try
- ReadSection(Section, S);
- Result := S.Count > 0;
- finally
- S.Free;
- end;
-end;
-
-function TTntCustomIniFile.ReadInteger(const Section, Ident: WideString;
- Default: Longint): Longint;
-var
- IntStr: WideString;
-begin
- IntStr := ReadString(Section, Ident, '');
- if (Length(IntStr) > 2) and (IntStr[1] = WideChar('0')) and
- ((IntStr[2] = WideChar('X')) or (IntStr[2] = WideChar('x'))) then
- IntStr := WideString('$') + Copy(IntStr, 3, Maxint);
- Result := StrToIntDef(IntStr, Default);
-end;
-
-procedure TTntCustomIniFile.WriteInteger(const Section, Ident: WideString; Value: Longint);
-begin
- WriteString(Section, Ident, IntToStr(Value));
-end;
-
-function TTntCustomIniFile.ReadBool(const Section, Ident: WideString;
- Default: Boolean): Boolean;
-begin
- Result := ReadInteger(Section, Ident, Ord(Default)) <> 0;
-end;
-
-function TTntCustomIniFile.ReadDate(const Section, Name: WideString; Default: TDateTime): TDateTime;
-var
- DateStr: WideString;
-begin
- DateStr := ReadString(Section, Name, '');
- Result := Default;
- if DateStr <> '' then
- try
- Result := StrToDate(DateStr);
- except
- on EConvertError do
- else raise;
- end;
-end;
-
-function TTntCustomIniFile.ReadDateTime(const Section, Name: WideString; Default: TDateTime): TDateTime;
-var
- DateStr: WideString;
-begin
- DateStr := ReadString(Section, Name, '');
- Result := Default;
- if DateStr <> '' then
- try
- Result := StrToDateTime(DateStr);
- except
- on EConvertError do
- else raise;
- end;
-end;
-
-function TTntCustomIniFile.ReadFloat(const Section, Name: WideString; Default: Double): Double;
-var
- FloatStr: WideString;
-begin
- FloatStr := ReadString(Section, Name, '');
- Result := Default;
- if FloatStr <> '' then
- try
- Result := StrToFloat(FloatStr);
- except
- on EConvertError do
- else raise;
- end;
-end;
-
-function TTntCustomIniFile.ReadTime(const Section, Name: WideString; Default: TDateTime): TDateTime;
-var
- TimeStr: WideString;
-begin
- TimeStr := ReadString(Section, Name, '');
- Result := Default;
- if TimeStr <> '' then
- try
- Result := StrToTime(TimeStr);
- except
- on EConvertError do
- else raise;
- end;
-end;
-
-procedure TTntCustomIniFile.WriteDate(const Section, Name: WideString; Value: TDateTime);
-begin
- WriteString(Section, Name, DateToStr(Value));
-end;
-
-procedure TTntCustomIniFile.WriteDateTime(const Section, Name: WideString; Value: TDateTime);
-begin
- WriteString(Section, Name, DateTimeToStr(Value));
-end;
-
-procedure TTntCustomIniFile.WriteFloat(const Section, Name: WideString; Value: Double);
-begin
- WriteString(Section, Name, FloatToStr(Value));
-end;
-
-procedure TTntCustomIniFile.WriteTime(const Section, Name: WideString; Value: TDateTime);
-begin
- WriteString(Section, Name, TimeToStr(Value));
-end;
-
-procedure TTntCustomIniFile.WriteBool(const Section, Ident: WideString; Value: Boolean);
-const
- Values: array[Boolean] of WideString = ('0', '1');
-begin
- WriteString(Section, Ident, Values[Value]);
-end;
-
-function TTntCustomIniFile.ValueExists(const Section, Ident: WideString): Boolean;
-var
- S: TTntStrings;
-begin
- S := TTntStringList.Create;
- try
- ReadSection(Section, S);
- Result := S.IndexOf(Ident) > -1;
- finally
- S.Free;
- end;
-end;
-
-function TTntCustomIniFile.ReadBinaryStream(const Section, Name: WideString;
- Value: TStream): Integer;
-var
- Text: String; // Not Unicode: Due to HexToBin is not Unicode
- Stream: TMemoryStream;
- Pos: Integer;
-begin
- Text := ReadString(Section, Name, '');
- if Text <> '' then
- begin
- if Value is TMemoryStream then
- Stream := TMemoryStream(Value)
- else Stream := TMemoryStream.Create;
- try
- Pos := Stream.Position;
- Stream.SetSize(Stream.Size + Length(Text) div 2);
- HexToBin(PChar(Text), PChar(Integer(Stream.Memory) + Stream.Position), Length(Text) div 2);
- Stream.Position := Pos;
- if Value <> Stream then Value.CopyFrom(Stream, Length(Text) div 2);
- Result := Stream.Size - Pos;
- finally
- if Value <> Stream then Stream.Free;
- end;
- end else Result := 0;
-end;
-
-procedure TTntCustomIniFile.WriteBinaryStream(const Section, Name: WideString;
- Value: TStream);
-var
- Text: string; // Not Unicode: Due to BinToHex is not Unicode
- Stream: TMemoryStream;
-begin
- SetLength(Text, (Value.Size - Value.Position) * 2);
- if Length(Text) > 0 then
- begin
- if Value is TMemoryStream then
- Stream := TMemoryStream(Value)
- else Stream := TMemoryStream.Create;
- try
- if Stream <> Value then
- begin
- Stream.CopyFrom(Value, Value.Size - Value.Position);
- Stream.Position := 0;
- end;
- BinToHex(PChar(Integer(Stream.Memory) + Stream.Position), PChar(Text),
- Stream.Size - Stream.Position);
- finally
- if Value <> Stream then Stream.Free;
- end;
- end;
- WriteString(Section, Name, Text);
-end;
-
-{ TTntStringHash }
-
-procedure TTntStringHash.Add(const Key: WideString; Value: Integer);
-var
- Hash: Integer;
- Bucket: PTntHashItem;
-begin
- Hash := HashOf(Key) mod Cardinal(Length(Buckets));
- New(Bucket);
- Bucket^.Key := Key;
- Bucket^.Value := Value;
- Bucket^.Next := Buckets[Hash];
- Buckets[Hash] := Bucket;
-end;
-
-procedure TTntStringHash.Clear;
-var
- I: Integer;
- P, N: PTntHashItem;
-begin
- for I := 0 to Length(Buckets) - 1 do
- begin
- P := Buckets[I];
- while P <> nil do
- begin
- N := P^.Next;
- Dispose(P);
- P := N;
- end;
- Buckets[I] := nil;
- end;
-end;
-
-constructor TTntStringHash.Create(Size: Integer);
-begin
- inherited Create;
- SetLength(Buckets, Size);
-end;
-
-destructor TTntStringHash.Destroy;
-begin
- Clear;
- inherited;
-end;
-
-function TTntStringHash.Find(const Key: WideString): PPTntHashItem;
-var
- Hash: Integer;
-begin
- Hash := HashOf(Key) mod Cardinal(Length(Buckets));
- Result := @Buckets[Hash];
- while Result^ <> nil do
- begin
- if Result^.Key = Key then
- Exit
- else
- Result := @Result^.Next;
- end;
-end;
-
-function TTntStringHash.HashOf(const Key: WideString): Cardinal;
-var
- I: Integer;
-begin
- Result := 0;
- for I := 1 to Length(Key) do
- Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
- Ord(Key[I]); // Is it OK for WideChar?
-end;
-
-function TTntStringHash.Modify(const Key: WideString; Value: Integer): Boolean;
-var
- P: PTntHashItem;
-begin
- P := Find(Key)^;
- if P <> nil then
- begin
- Result := True;
- P^.Value := Value;
- end
- else
- Result := False;
-end;
-
-procedure TTntStringHash.Remove(const Key: WideString);
-var
- P: PTntHashItem;
- Prev: PPTntHashItem;
-begin
- Prev := Find(Key);
- P := Prev^;
- if P <> nil then
- begin
- Prev^ := P^.Next;
- Dispose(P);
- end;
-end;
-
-function TTntStringHash.ValueOf(const Key: WideString): Integer;
-var
- P: PTntHashItem;
-begin
- P := Find(Key)^;
- if P <> nil then
- Result := P^.Value else
- Result := -1;
-end;
-
-{ TTntHashedStringList }
-
-procedure TTntHashedStringList.Changed;
-begin
- inherited;
- FValueHashValid := False;
- FNameHashValid := False;
-end;
-
-destructor TTntHashedStringList.Destroy;
-begin
- FValueHash.Free;
- FNameHash.Free;
- inherited;
-end;
-
-function TTntHashedStringList.IndexOf(const S: WideString): Integer;
-begin
- UpdateValueHash;
- if not CaseSensitive then
- Result := FValueHash.ValueOf(WideUpperCase(S))
- else
- Result := FValueHash.ValueOf(S);
-end;
-
-function TTntHashedStringList.IndexOfName(const Name: WideString): Integer;
-begin
- UpdateNameHash;
- if not CaseSensitive then
- Result := FNameHash.ValueOf(WideUpperCase(Name))
- else
- Result := FNameHash.ValueOf(Name);
-end;
-
-procedure TTntHashedStringList.UpdateNameHash;
-var
- I: Integer;
- P: Integer;
- Key: WideString;
-begin
- if FNameHashValid then Exit;
- if FNameHash = nil then
- FNameHash := TTntStringHash.Create
- else
- FNameHash.Clear;
- for I := 0 to Count - 1 do
- begin
- Key := Get(I);
- P := Pos(NameValueSeparator, Key);
- if P <> 0 then
- begin
- if not CaseSensitive then
- Key := WideUpperCase(Copy(Key, 1, P - 1))
- else
- Key := Copy(Key, 1, P - 1);
- FNameHash.Add(Key, I);
- end;
- end;
- FNameHashValid := True;
-end;
-
-procedure TTntHashedStringList.UpdateValueHash;
-var
- I: Integer;
-begin
- if FValueHashValid then Exit;
- if FValueHash = nil then
- FValueHash := TTntStringHash.Create
- else
- FValueHash.Clear;
- for I := 0 to Count - 1 do
- if not CaseSensitive then
- FValueHash.Add(WideUpperCase(Self[I]), I)
- else
- FValueHash.Add(Self[I], I);
- FValueHashValid := True;
-end;
-
-{ TTntMemIniFile }
-
-constructor TTntMemIniFile.Create(const FileName: WideString);
-begin
- inherited Create(FileName);
- FSections := TTntHashedStringList.Create;
- FSections.NameValueSeparator := '=';
-{$IFDEF LINUX}
- FSections.CaseSensitive := True;
-{$ELSE}
- FSections.CaseSensitive := False;
-{$ENDIF}
- LoadValues;
-end;
-
-destructor TTntMemIniFile.Destroy;
-begin
- if FSections <> nil then Clear;
- FSections.Free;
- inherited;
-end;
-
-function TTntMemIniFile.AddSection(const Section: WideString): TTntStrings;
-begin
- Result := TTntHashedStringList.Create;
- try
- TTntHashedStringList(Result).CaseSensitive := CaseSensitive;
- FSections.AddObject(Section, Result);
- except
- Result.Free;
- raise;
- end;
-end;
-
-procedure TTntMemIniFile.Clear;
-var
- I: Integer;
-begin
- for I := 0 to FSections.Count - 1 do
- TObject(FSections.Objects[I]).Free;
- FSections.Clear;
-end;
-
-procedure TTntMemIniFile.DeleteKey(const Section, Ident: WideString);
-var
- I, J: Integer;
- Strings: TTntStrings;
-begin
- I := FSections.IndexOf(Section);
- if I >= 0 then
- begin
- Strings := TTntStrings(FSections.Objects[I]);
- J := Strings.IndexOfName(Ident);
- if J >= 0 then Strings.Delete(J);
- end;
-end;
-
-procedure TTntMemIniFile.EraseSection(const Section: WideString);
-var
- I: Integer;
-begin
- I := FSections.IndexOf(Section);
- if I >= 0 then
- begin
- TStrings(FSections.Objects[I]).Free;
- FSections.Delete(I);
- end;
-end;
-
-function TTntMemIniFile.GetCaseSensitive: Boolean;
-begin
- Result := FSections.CaseSensitive;
-end;
-
-procedure TTntMemIniFile.GetStrings(List: TTntStrings);
-var
- I, J: Integer;
- Strings: TTntStrings;
-begin
- List.BeginUpdate;
- try
- for I := 0 to FSections.Count - 1 do
- begin
- List.Add('[' + FSections[I] + ']');
- Strings := TTntStrings(FSections.Objects[I]);
- for J := 0 to Strings.Count - 1 do
- List.Add(Strings[J]);
- List.Add('');
- end;
- finally
- List.EndUpdate;
- end;
-end;
-
-procedure TTntMemIniFile.LoadValues;
-var
- List: TTntStringList;
-begin
- if (FileName <> '') and WideFileExists(FileName) then
- begin
- List := TTntStringList.Create;
- try
- List.LoadFromFile(FileName);
- SetStrings(List);
- finally
- List.Free;
- end;
- end else
- Clear;
-end;
-
-procedure TTntMemIniFile.ReadSection(const Section: WideString;
- Strings: TTntStrings);
-var
- I, J: Integer;
- SectionStrings: TTntStrings;
-begin
- Strings.BeginUpdate;
- try
- Strings.Clear;
- I := FSections.IndexOf(Section);
- if I >= 0 then
- begin
- SectionStrings := TTntStrings(FSections.Objects[I]);
- for J := 0 to SectionStrings.Count - 1 do
- Strings.Add(SectionStrings.Names[J]);
- end;
- finally
- Strings.EndUpdate;
- end;
-end;
-
-procedure TTntMemIniFile.ReadSections(Strings: TTntStrings);
-begin
- Strings.Assign(FSections);
-end;
-
-procedure TTntMemIniFile.ReadSectionValues(const Section: WideString;
- Strings: TTntStrings);
-var
- I: Integer;
-begin
- Strings.BeginUpdate;
- try
- Strings.Clear;
- I := FSections.IndexOf(Section);
- if I >= 0 then Strings.Assign(TTntStrings(FSections.Objects[I]));
- finally
- Strings.EndUpdate;
- end;
-end;
-
-function TTntMemIniFile.ReadString(const Section, Ident,
- Default: WideString): WideString;
-var
- I: Integer;
- Strings: TTntStrings;
-begin
- I := FSections.IndexOf(Section);
- if I >= 0 then
- begin
- Strings := TTntStrings(FSections.Objects[I]);
- I := Strings.IndexOfName(Ident);
- if I >= 0 then
- begin
- Result := Copy(Strings[I], Length(Ident) + 2, Maxint);
- Exit;
- end;
- end;
- Result := Default;
-end;
-
-procedure TTntMemIniFile.Rename(const FileName: WideString; Reload: Boolean);
-begin
- FFileName := FileName;
- if Reload then LoadValues;
-end;
-
-procedure TTntMemIniFile.SetCaseSensitive(Value: Boolean);
-var
- I: Integer;
-begin
- if Value <> FSections.CaseSensitive then
- begin
- FSections.CaseSensitive := Value;
- for I := 0 to FSections.Count - 1 do
- with TTntHashedStringList(FSections.Objects[I]) do
- begin
- CaseSensitive := Value;
- Changed;
- end;
- TTntHashedStringList(FSections).Changed;
- end;
-end;
-
-procedure TTntMemIniFile.SetStrings(List: TTntStrings);
-var
- I, J: Integer;
- S: WideString;
- Strings: TTntStrings;
-begin
- Clear;
- Strings := nil;
- for I := 0 to List.Count - 1 do
- begin
- S := Trim(List[I]);
- if (S <> '') and (S[1] <> ';') then
- if (S[1] = '[') and (S[Length(S)] = ']') then
- begin
- Delete(S, 1, 1);
- SetLength(S, Length(S)-1);
- Strings := AddSection(Trim(S));
- end
- else
- if Strings <> nil then
- begin
- J := Pos(FSections.NameValueSeparator, S);
- if J > 0 then // remove spaces before and after NameValueSeparator
- Strings.Add(Trim(Copy(S, 1, J-1)) + FSections.NameValueSeparator + TrimRight(Copy(S, J+1, MaxInt)) )
- else
- Strings.Add(S);
- end;
- end;
-end;
-
-procedure TTntMemIniFile.UpdateFile;
-var
- List: TTntStringList;
-begin
- List := TTntStringList.Create;
- try
- GetStrings(List);
- List.SaveToFile(FFileName);
- finally
- List.Free;
- end;
-end;
-
-procedure TTntMemIniFile.WriteString(const Section, Ident, Value: WideString);
-var
- I: Integer;
- S: WideString;
- Strings: TTntStrings;
-begin
- I := FSections.IndexOf(Section);
- if I >= 0 then
- Strings := TTntStrings(FSections.Objects[I]) else
- Strings := AddSection(Section);
- S := Ident + FSections.NameValueSeparator + Value;
- I := Strings.IndexOfName(Ident);
- if I >= 0 then Strings[I] := S else Strings.Add(S);
-end;
-
-
-
-{$IFDEF MSWINDOWS}
-{ TTntIniFile }
-
-constructor TTntIniFile.Create(const FileName: WideString);
-begin
- inherited Create(FileName);
- if (not Win32PlatformIsUnicode) then
- FAnsiIniFile := TIniFile.Create(FileName);
-end;
-
-destructor TTntIniFile.Destroy;
-begin
- UpdateFile; // flush changes to disk
- if (not Win32PlatformIsUnicode) then
- FAnsiIniFile.Free;
- inherited Destroy;
-end;
-
-function TTntIniFile.ReadString(const Section, Ident, Default: WideString): WideString;
-var
- Buffer: array[0..2047] of WideChar;
-begin
- if (not Win32PlatformIsUnicode) then
- { Windows 95/98/Me }
- Result := FAnsiIniFile.ReadString(Section, Ident, Default)
- else begin
- { Windows NT/2000/XP and later }
- GetPrivateProfileStringW(PWideChar(Section),
- PWideChar(Ident), PWideChar(Default), Buffer, Length(Buffer), PWideChar(FFileName));
- Result := WideString(Buffer);
- end;
-end;
-
-procedure TTntIniFile.WriteString(const Section, Ident, Value: WideString);
-begin
- if (not Win32PlatformIsUnicode) then
- { Windows 95/98/Me }
- FAnsiIniFile.WriteString(Section, Ident, Value)
- else begin
- { Windows NT/2000/XP and later }
- if not WritePrivateProfileStringW(PWideChar(Section), PWideChar(Ident),
- PWideChar(Value), PWideChar(FFileName)) then
- raise EIniFileException.CreateResFmt(@SIniFileWriteError, [FileName]);
- end;
-end;
-
-procedure TTntIniFile.ReadSections(Strings: TTntStrings);
-const
- BufSize = 16384 * SizeOf(WideChar);
-var
- Buffer, P: PWideChar;
-begin
- if (not Win32PlatformIsUnicode) then
- begin
- { Windows 95/98/Me }
- FAnsiIniFile.ReadSections(Strings.AnsiStrings);
- end else
- begin
- { Windows NT/2000/XP and later }
- GetMem(Buffer, BufSize);
- try
- Strings.BeginUpdate;
- try
- Strings.Clear;
- if GetPrivateProfileStringW(nil, nil, nil, Buffer, BufSize,
- PWideChar(FFileName)) <> 0 then
- begin
- P := Buffer;
- while P^ <> WideChar(#0) do
- begin
- Strings.Add(P);
- Inc(P, WStrLen(P) + 1);
- end;
- end;
- finally
- Strings.EndUpdate;
- end;
- finally
- FreeMem(Buffer, BufSize);
- end;
- end; {else}
-end;
-
-procedure TTntIniFile.ReadSection(const Section: WideString; Strings: TTntStrings);
-const
- BufSize = 16384 * SizeOf(WideChar);
-var
- Buffer, P: PWideChar;
-begin
- if (not Win32PlatformIsUnicode) then
- begin
- { Windows 95/98/Me }
- FAnsiIniFile.ReadSection(Section, Strings.AnsiStrings);
- end else
- begin
- { Windows NT/2000/XP and later }
- GetMem(Buffer, BufSize);
- try
- Strings.BeginUpdate;
- try
- Strings.Clear;
- if GetPrivateProfileStringW(PWideChar(Section), nil, nil, Buffer, BufSize,
- PWideChar(FFileName)) <> 0 then
- begin
- P := Buffer;
- while P^ <> #0 do
- begin
- Strings.Add(P);
- Inc(P, WStrLen(P) + 1);
- end;
- end;
- finally
- Strings.EndUpdate;
- end;
- finally
- FreeMem(Buffer, BufSize);
- end;
- end;
-end;
-
-procedure TTntIniFile.ReadSectionValues(const Section: WideString; Strings: TTntStrings);
-var
- KeyList: TTntStringList;
- I: Integer;
-begin
- if (not Win32PlatformIsUnicode) then
- begin
- { Windows 95/98/Me }
- FAnsiIniFile.ReadSectionValues(Section, Strings.AnsiStrings);
- end else
- begin
- { Windows NT/2000/XP and later }
- KeyList := TTntStringList.Create;
- try
- ReadSection(Section, KeyList);
- Strings.BeginUpdate;
- try
- Strings.Clear;
- for I := 0 to KeyList.Count - 1 do
- Strings.Add(KeyList[I] + '=' + ReadString(Section, KeyList[I], ''))
- finally
- Strings.EndUpdate;
- end;
- finally
- KeyList.Free;
- end;
- end; {if}
-end;
-
-procedure TTntIniFile.EraseSection(const Section: WideString);
-begin
- if (not Win32PlatformIsUnicode) then
- begin
- { Windows 95/98/Me }
- FAnsiIniFile.EraseSection(Section);
- end
- else begin
- { Windows NT/2000/XP and later }
- if not WritePrivateProfileStringW(PWideChar(Section), nil, nil,
- PWideChar(FFileName)) then
- raise EIniFileException.CreateResFmt(@SIniFileWriteError, [FileName]);
- end; {if}
-end;
-
-procedure TTntIniFile.DeleteKey(const Section, Ident: WideString);
-begin
- if (not Win32PlatformIsUnicode) then
- begin
- { Windows 95/98/Me }
- FAnsiIniFile.DeleteKey(Section, Ident);
- end
- else begin
- { Windows NT/2000/XP and later }
- WritePrivateProfileStringW(PWideChar(Section), PWideChar(Ident), nil,
- PWideChar(FFileName));
- end; {if}
-end;
-
-procedure TTntIniFile.UpdateFile;
-begin
- if (not Win32PlatformIsUnicode) then
- begin
- { Windows 95/98/Me }
- FAnsiIniFile.UpdateFile
- end
- else begin
- { Windows NT/2000/XP and later }
- WritePrivateProfileStringW(nil, nil, nil, PWideChar(FFileName));
- end; {if}
-end;
-
-{$ELSE}
-
-destructor TTntIniFile.Destroy;
-begin
- UpdateFile;
- inherited Destroy;
-end;
-
-{$ENDIF}
-
-
-
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntIniFilesEx.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntIniFilesEx.pas deleted file mode 100644 index 87ec613976..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntIniFilesEx.pas +++ /dev/null @@ -1,205 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Extended TTntMemIniFile (compatible with all versions) }
-{ }
-{ Copyright (c) 1999-2007 Stanley Xu }
-{ http://getgosurf.com/?go=supportFeedback&ln=en }
-{ }
-{*****************************************************************************}
-
-{*****************************************************************************}
-{ }
-{ BACKGROUND: }
-{ TTntMemIniFile buffers all changes to the INI file in memory. To write }
-{ the data from memory back to the associated INI file, call the }
-{ UpdateFile() method. However, the whole content of this INI file will }
-{ be overwritten. Even those sections that are not used. This will make }
-{ troubles, if two instances try to change the same file at the same }
-{ time, without some method of managing access the instances may well end }
-{ up overwriting each other's work. }
-{ }
-{ IDEA: }
-{ TTntMemIniFileEx implementes a simple idea: To check the timestamp }
-{ before each operation. If the file is modified, TTntMemIniFileEx will }
-{ reload the file to keep the content updated. }
-{ }
-{ CONCLUSION: }
-{ # TTntMemIniFileEx and TTntMemIniFile are ideal for read-only access. }
-{ For instance: To read localization files, etc. }
-{ # To perform mass WriteString() operations, please use the following }
-{ code. }
-{ BeginUpdate(); }
-{ try }
-{ for I := 0 to 10000 do }
-{ WriteString(...); }
-{ finally; }
-{ EndUpdate(); }
-{ UpdateFile; }
-{ end; }
-{ }
-{*****************************************************************************}
-
-unit TntIniFilesEx;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- TntClasses, TntIniFiles;
-
-type
- TTntMemIniFileEx = class(TTntMemIniFile)
- private
- FUpdateCount: Integer;
- FModified: Boolean;
- FLastAccessed: Integer;
- function FileRealLastAccessedTime: Integer;
- procedure GetLatestVersion;
- protected
- procedure LoadValues; // Extended
- public
- constructor Create(const FileName: WideString); override;
- procedure BeginUpdate; virtual;
- procedure EndUpdate; virtual;
- function ReadString(const Section, Ident, Default: WideString): WideString; override;
- procedure WriteString(const Section, Ident, Value: WideString); override;
- procedure ReadSection(const Section: WideString; Strings: TTntStrings); override;
- procedure ReadSections(Strings: TTntStrings); override;
- procedure ReadSectionValues(const Section: WideString; Strings: TTntStrings); override;
- procedure DeleteKey(const Section, Ident: WideString); override;
- procedure EraseSection(const Section: WideString); override;
- procedure UpdateFile; override;
- end;
-
-
-
-implementation
-
-uses
- SysUtils, TntSysUtils;
-
-
-{ TTntMemIniFileEx }
-
-function TTntMemIniFileEx.FileRealLastAccessedTime: Integer;
-var
- H: Integer; // file handle
-begin
- Result := 0;
- H := WideFileOpen(FileName, fmOpenWrite); //fmOpenRead (?)
- if H <> -1 then
- try
- Result := FileGetDate(H);
- finally
- FileClose(H);
- end;
-end;
-
-procedure TTntMemIniFileEx.GetLatestVersion;
-begin
- if FLastAccessed = FileRealLastAccessedTime then
- Exit;
-
- LoadValues;
- // FLastAccess will be updated in LoadValues(...)
-end;
-
-procedure TTntMemIniFileEx.LoadValues; // Copied from TntIniFiles.pas
-var
- List: TTntStringList;
-begin
- if (FileName <> '') and WideFileExists(FileName) then
- begin
- List := TTntStringList.Create;
- try
- List.LoadFromFile(FileName);
- FLastAccessed := FileRealLastAccessedTime; // Extra
- FModified := False; //
- SetStrings(List);
- finally
- List.Free;
- end;
- end else
- Clear;
-end;
-
-constructor TTntMemIniFileEx.Create(const FileName: WideString);
-begin
- inherited Create(FileName);
- FUpdateCount := 0;
-end;
-
-procedure TTntMemIniFileEx.BeginUpdate;
-begin
- Inc(FUpdateCount);
-end;
-
-procedure TTntMemIniFileEx.EndUpdate;
-begin
- Dec(FUpdateCount);
-end;
-
-function TTntMemIniFileEx.ReadString(const Section, Ident, Default: WideString): WideString;
-begin
- GetLatestVersion;
- Result := inherited ReadString(Section, Ident, Default);
-end;
-
-procedure TTntMemIniFileEx.WriteString(const Section, Ident, Value: WideString);
-begin
- GetLatestVersion;
- inherited WriteString(Section, Ident, Value);
- FModified := True;
- UpdateFile; // Flush changes to disk
-end;
-
-procedure TTntMemIniFileEx.ReadSection(const Section: WideString; Strings: TTntStrings);
-begin
- GetLatestVersion;
- inherited ReadSection(Section, Strings);
-end;
-
-procedure TTntMemIniFileEx.ReadSections(Strings: TTntStrings);
-begin
- GetLatestVersion;
- inherited ReadSections(Strings);
-end;
-
-procedure TTntMemIniFileEx.ReadSectionValues(const Section: WideString; Strings: TTntStrings);
-begin
- GetLatestVersion;
- inherited ReadSectionValues(Section, Strings);
-end;
-
-procedure TTntMemIniFileEx.DeleteKey(const Section, Ident: WideString);
-begin
- GetLatestVersion;
- inherited DeleteKey(Section, Ident);
- FModified := True;
- UpdateFile; // Flush changes to disk
-end;
-
-procedure TTntMemIniFileEx.EraseSection(const Section: WideString);
-begin
- GetLatestVersion;
- inherited EraseSection(Section);
- FModified := True;
- UpdateFile; // Flush changes to disk
-end;
-
-procedure TTntMemIniFileEx.UpdateFile;
-begin
- if not FModified or (FUpdateCount > 0) then
- Exit;
- inherited;
-end;
-
-
-
-
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntListActns.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntListActns.pas deleted file mode 100644 index 00601c0449..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntListActns.pas +++ /dev/null @@ -1,207 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntListActns;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, TntActnList, ListActns;
-
-type
-{TNT-WARN TCustomListAction}
- TTntCustomListAction = class(TCustomListAction{TNT-ALLOW TCustomListAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TStaticListAction}
- TTntStaticListAction = class(TStaticListAction{TNT-ALLOW TStaticListAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TVirtualListAction}
- TTntVirtualListAction = class(TVirtualListAction{TNT-ALLOW TVirtualListAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-implementation
-
-uses
- ActnList, TntClasses;
-
-{TNT-IGNORE-UNIT}
-
-type TAccessCustomListAction = class(TCustomListAction);
-
-procedure TntListActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-begin
- TntAction_AfterInherited_Assign(Action, Source);
- // TCustomListAction
- if (Action is TCustomListAction) and (Source is TCustomListAction) then begin
- TAccessCustomListAction(Action).Images := TAccessCustomListAction(Source).Images;
- TAccessCustomListAction(Action).OnGetItemCount := TAccessCustomListAction(Source).OnGetItemCount;
- TAccessCustomListAction(Action).OnItemSelected := TAccessCustomListAction(Source).OnItemSelected;
- TAccessCustomListAction(Action).Active := TAccessCustomListAction(Source).Active;
- TAccessCustomListAction(Action).ItemIndex := TAccessCustomListAction(Source).ItemIndex;
- end;
- // TStaticListAction
- if (Action is TStaticListAction) and (Source is TStaticListAction) then begin
- TStaticListAction(Action).Items := TStaticListAction(Source).Items;
- TStaticListAction(Action).OnGetItem := TStaticListAction(Source).OnGetItem;
- end;
- // TVirtualListAction
- if (Action is TVirtualListAction) and (Source is TVirtualListAction) then begin
- TVirtualListAction(Action).OnGetItem := TVirtualListAction(Source).OnGetItem;
- end;
-end;
-
-//-------------------------
-// TNT LIST ACTNS
-//-------------------------
-
-{ TTntCustomListAction }
-
-procedure TTntCustomListAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntListActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntCustomListAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomListAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntCustomListAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntCustomListAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntCustomListAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntStaticListAction }
-
-procedure TTntStaticListAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntListActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntStaticListAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntStaticListAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntStaticListAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntStaticListAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntStaticListAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntVirtualListAction }
-
-procedure TTntVirtualListAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntListActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntVirtualListAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntVirtualListAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntVirtualListAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntVirtualListAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntVirtualListAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas deleted file mode 100644 index 577764661c..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas +++ /dev/null @@ -1,1146 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntMenus;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Windows, Classes, Menus, Graphics, Messages;
-
-type
-{TNT-WARN TMenuItem}
- TTntMenuItem = class(TMenuItem{TNT-ALLOW TMenuItem})
- private
- FIgnoreMenuChanged: Boolean;
- FCaption: WideString;
- FHint: WideString;
- FKeyboardLayout: HKL;
- function GetCaption: WideString;
- procedure SetInheritedCaption(const Value: AnsiString);
- procedure SetCaption(const Value: WideString);
- function IsCaptionStored: Boolean;
- procedure UpdateMenuString(ParentMenu: TMenu);
- function GetAlignmentDrawStyle: Word;
- function MeasureItemTextWidth(ACanvas: TCanvas; const Text: WideString): Integer;
- 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;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure MenuChanged(Rebuild: Boolean); override;
- procedure AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
- 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); override;
- public
- procedure InitiateAction; override;
- procedure Loaded; override;
- function Find(ACaption: WideString): TMenuItem{TNT-ALLOW TMenuItem};
- published
- property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TMainMenu}
- 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}
-function WideNewSubMenu(const ACaption: WideString; hCtx: THelpContext;
- const AName: TComponentName; const Items: array of TTntMenuItem;
- AEnabled: Boolean): TTntMenuItem;
-{TNT-WARN NewItem}
-function WideNewItem(const ACaption: WideString; AShortCut: TShortCut;
- AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext;
- const AName: TComponentName): TTntMenuItem;
-
-function MessageToShortCut(Msg: TWMKeyDown): TShortCut;
-
-{TNT-WARN ShortCutToText}
-function WideShortCutToText(WordShortCut: Word): WideString;
-{TNT-WARN TextToShortCut}
-function WideTextToShortCut(Text: WideString): TShortCut;
-{TNT-WARN GetHotKey}
-function WideGetHotkey(const Text: WideString): WideString;
-{TNT-WARN StripHotkey}
-function WideStripHotkey(const Text: WideString): WideString;
-{TNT-WARN AnsiSameCaption}
-function WideSameCaption(const Text1, Text2: WideString): Boolean;
-
-function WideGetMenuItemCaption(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): 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
- 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;
- AEnabled: Boolean): TTntMenuItem;
-var
- I: Integer;
-begin
- Result := TTntMenuItem.Create(nil);
- for I := Low(Items) to High(Items) do
- Result.Add(Items[I]);
- Result.Caption := ACaption;
- Result.HelpContext := hCtx;
- Result.Name := AName;
- Result.Enabled := AEnabled;
-end;
-
-function WideNewItem(const ACaption: WideString; AShortCut: TShortCut;
- AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext;
- const AName: TComponentName): TTntMenuItem;
-begin
- Result := TTntMenuItem.Create(nil);
- with Result do
- begin
- Caption := ACaption;
- ShortCut := AShortCut;
- OnClick := AOnClick;
- HelpContext := hCtx;
- Checked := AChecked;
- Enabled := AEnabled;
- Name := AName;
- end;
-end;
-
-function MessageToShortCut(Msg: TWMKeyDown): TShortCut;
-var
- ShiftState: TShiftState;
-begin
- ShiftState := Forms.KeyDataToShiftState(TWMKeyDown(Msg).KeyData);
- Result := Menus.ShortCut(TWMKeyDown(Msg).CharCode, ShiftState);
-end;
-
-function WideGetSpecialName(WordShortCut: Word): WideString;
-var
- ScanCode: Integer;
- KeyName: array[0..255] of WideChar;
-begin
- Assert(Win32PlatformIsUnicode);
- Result := '';
- ScanCode := MapVirtualKeyW(WordRec(WordShortCut).Lo, 0) shl 16;
- if ScanCode <> 0 then
- begin
- GetKeyNameTextW(ScanCode, KeyName, SizeOf(KeyName));
- Result := KeyName;
- end;
-end;
-
-function WideGetKeyboardChar(Key: Word): WideChar;
-var
- LatinNumChar: WideChar;
-begin
- Assert(Win32PlatformIsUnicode);
- Result := WideChar(MapVirtualKeyW(Key, 2));
- if (Key in [$30..$39]) then
- begin
- // Check to see if "0" - "9" can be used if all that differs is shift state
- LatinNumChar := WideChar(Key - $30 + Ord('0'));
- if (Result <> LatinNumChar)
- and (Byte(Key) = WordRec(VkKeyScanW(LatinNumChar)).Lo) then // .Hi would be the shift state
- Result := LatinNumChar;
- end;
-end;
-
-function WideShortCutToText(WordShortCut: Word): WideString;
-var
- Name: WideString;
-begin
- if (not Win32PlatformIsUnicode)
- 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}(WordShortCut)
- else begin
- 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(WordShortCut);
- end;
- if Name <> '' then
- begin
- Result := '';
- 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 := '';
- end;
-end;
-
-{ This function is *very* slow. Use sparingly. Return 0 if no VK code was
- found for the text }
-
-function WideTextToShortCut(Text: WideString): TShortCut;
-
- { If the front of Text is equal to Front then remove the matching piece
- from Text and return True, otherwise return False }
-
- function CompareFront(var Text: WideString; const Front: WideString): Boolean;
- begin
- Result := (Pos(Front, Text) = 1);
- if Result then
- Delete(Text, 1, Length(Front));
- end;
-
-var
- Key: TShortCut;
- Shift: TShortCut;
-begin
- Result := 0;
- Shift := 0;
- while True do
- begin
- if CompareFront(Text, SmkcShift) then Shift := Shift or scShift
- else if CompareFront(Text, '^') then Shift := Shift or scCtrl
- else if CompareFront(Text, SmkcCtrl) then Shift := Shift or scCtrl
- else if CompareFront(Text, SmkcAlt) then Shift := Shift or scAlt
- else Break;
- end;
- if Text = '' then Exit;
- for Key := $08 to $255 do { Copy range from table in ShortCutToText }
- if WideSameText(Text, WideShortCutToText(Key)) then
- begin
- Result := Key or Shift;
- Exit;
- end;
-end;
-
-function WideGetHotkeyPos(const Text: WideString): Integer;
-var
- I, L: Integer;
-begin
- Result := 0;
- I := 1;
- L := Length(Text);
- while I <= L do
- begin
- if (Text[I] = cHotkeyPrefix) and (L - I >= 1) then
- begin
- Inc(I);
- if Text[I] <> cHotkeyPrefix then
- Result := I; // this might not be the last
- end;
- Inc(I);
- end;
-end;
-
-function WideGetHotkey(const Text: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideGetHotkeyPos(Text);
- if I = 0 then
- Result := ''
- else
- Result := Text[I];
-end;
-
-function WideStripHotkey(const Text: WideString): WideString;
-var
- I: Integer;
-begin
- Result := Text;
- I := 1;
- while I <= Length(Result) do
- 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 begin
- Delete(Result, I - 1, 4);
- Dec(I, 2);
- end else
- Delete(Result, I, 1);
- Inc(I);
- end;
-end;
-
-function WideSameCaption(const Text1, Text2: WideString): Boolean;
-begin
- 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
- Result := TTntMenuItem(MenuItem).Caption
- else
- Result := MenuItem.Caption;
-end;
-
-function WideGetMenuItemHint(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString;
-begin
- if MenuItem is TTntMenuItem then
- Result := TTntMenuItem(MenuItem).Hint
- else
- Result := MenuItem.Hint;
-end;
-
-procedure NoOwnerDrawTopLevelItems(Menu: TMainMenu{TNT-ALLOW TMainMenu});
-{If top-level items are created as owner-drawn, they will not appear as raised
-buttons when the mouse hovers over them. The VCL will often create top-level
-items as owner-drawn even when they don't need to be (owner-drawn state can be
-set on an item-by-item basis). This routine turns off the owner-drawn flag for
-top-level items if it appears unnecessary}
-
- function ItemHasValidImage(Item: TMenuItem{TNT-ALLOW TMenuItem}): boolean;
- var
- Images: TCustomImageList;
- begin
- Assert(Item <> nil, 'TNT Internal Error: ItemHasValidImage: item = nil');
- Images := Item.GetImageList;
- Result := (Assigned(Images) and (Item.ImageIndex >= 0) and (Item.ImageIndex < Images.Count))
- or (MenuItemHasBitmap(Item) and (not Item.Bitmap.Empty))
- end;
-
-var
- HM: HMenu;
- i: integer;
- Info: TMenuItemInfoA;
- Item: TMenuItem{TNT-ALLOW TMenuItem};
- Win98Plus: boolean;
-begin
- if Assigned(Menu) then begin
- Win98Plus:= (Win32MajorVersion > 4)
- or((Win32MajorVersion = 4) and (Win32MinorVersion > 0));
- if not Win98Plus then
- Exit; {exit if Windows 95 or NT 4.0}
- HM:= Menu.Handle;
- Info.cbSize:= sizeof(Info);
- for i := 0 to GetMenuItemCount(HM) - 1 do begin
- Info.fMask:= MIIM_FTYPE or MIIM_ID;
- if not GetMenuItemInfo(HM, i, true, Info) then
- Break;
- if Info.fType and MFT_OWNERDRAW <> 0 then begin
- Item:= Menu.FindItem(Info.wID, fkCommand);
- if not Assigned(Item) then
- continue;
- if Assigned(Item.OnDrawItem)
- or Assigned(Item.OnAdvancedDrawItem)
- or ItemHasValidImage(Item) then
- Continue;
- Info.fMask:= MIIM_FTYPE or MIIM_STRING;
- Info.fType:= (Info.fType and not MFT_OWNERDRAW) or MFT_STRING;
- if Win32PlatformIsUnicode and (Item is TTntMenuItem) then begin
- // Unicode
- TMenuItemInfoW(Info).dwTypeData:= PWideChar(TTntMenuItem(Item).Caption);
- SetMenuItemInfoW(HM, i, true, TMenuItemInfoW(Info));
- end else begin
- // Ansi
- Info.dwTypeData:= PAnsiChar(Item.Caption);
- SetMenuItemInfoA(HM, i, true, Info);
- end;
- end;
- end;
- end;
-end;
-
-{ TTntMenuItem's utility procs }
-
-procedure SyncHotKeyPosition(const Source: WideString; var Dest: WideString);
-var
- I: Integer;
- FarEastHotString: WideString;
-begin
- 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;
-
-procedure UpdateMenuItems(Items: TMenuItem{TNT-ALLOW TMenuItem}; ParentMenu: TMenu);
-var
- i: integer;
-begin
- if (Items.ComponentState * [csReading, csDestroying] = []) then begin
- for i := Items.Count - 1 downto 0 do
- UpdateMenuItems(Items[i], ParentMenu);
- if Items is TTntMenuItem then
- TTntMenuItem(Items).UpdateMenuString(ParentMenu);
- end;
-end;
-
-procedure FixMenuBiDiProblem(Menu: TMenu);
-var
- i: integer;
-begin
- // TMenu sometimes sets bidi on first visible item which can convert caption to ansi
- if (SysLocale.MiddleEast)
- and (Menu <> nil)
- and (Menu.Items.Count > 0) then
- begin
- for i := 0 to Menu.Items.Count - 1 do begin
- if Menu.Items[i].Visible then begin
- if (Menu.Items[i] is TTntMenuItem) then
- (Menu.Items[i] as TTntMenuItem).UpdateMenuString(Menu);
- break; // found first visible menu item!
- end;
- end;
- end;
-end;
-
-
-{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
-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;
- FxxxxCommand: Word;
- FxxxxHelpContext: THelpContext;
- FxxxxHint: AnsiString;
- FxxxxItems: TList;
- FxxxxShortCut: TShortCut;
- FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem};
- FMerged: TMenuItem{TNT-ALLOW TMenuItem};
- FMergedWith: TMenuItem{TNT-ALLOW TMenuItem};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
-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;
- FxxxxCommand: Word;
- FxxxxHelpContext: THelpContext;
- FxxxxHint: AnsiString;
- FxxxxItems: TList;
- FxxxxShortCut: TShortCut;
- FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem};
- FMerged: TMenuItem{TNT-ALLOW TMenuItem};
- FMergedWith: TMenuItem{TNT-ALLOW TMenuItem};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_9} // verified against VCL source in 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;
- FxxxxCommand: Word;
- FxxxxHelpContext: THelpContext;
- FxxxxHint: AnsiString;
- FxxxxItems: TList;
- FxxxxShortCut: TShortCut;
- FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem};
- FMerged: TMenuItem{TNT-ALLOW TMenuItem};
- FMergedWith: TMenuItem{TNT-ALLOW TMenuItem};
- end;
-{$ENDIF}
-{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
-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;
- FxxxxCommand: Word;
- FxxxxHelpContext: THelpContext;
- FxxxxHint: AnsiString;
- FxxxxItems: TList;
- FxxxxShortCut: TShortCut;
- FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem};
- FMerged: TMenuItem{TNT-ALLOW TMenuItem};
- FMergedWith: TMenuItem{TNT-ALLOW TMenuItem};
- end;
-{$ENDIF}
-
-function MenuItemHasBitmap(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): Boolean;
-begin
- Result := Assigned(THackMenuItem(MenuItem).FBitmap);
-end;
-
-{ TTntMenuItem }
-
-procedure TTntMenuItem.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-type TAccessActionlink = class(TActionLink);
-
-procedure TTntMenuItem.InitiateAction;
-begin
- if GetKeyboardLayout(0) <> FKeyboardLayout then
- MenuChanged(False);
- inherited;
-end;
-
-function TTntMenuItem.IsCaptionStored: Boolean;
-begin
- Result := (ActionLink = nil) or (not TAccessActionlink(ActionLink).IsCaptionLinked);
-end;
-
-procedure TTntMenuItem.SetInheritedCaption(const Value: AnsiString);
-begin
- inherited Caption := Value;
-end;
-
-function TTntMenuItem.GetCaption: WideString;
-begin
- if (AnsiString(FCaption) <> inherited Caption)
- and WideSameCaptionStr(AnsiString(FCaption), inherited Caption) then
- begin
- // only difference is hotkey position, update caption with new hotkey position
- SyncHotKeyPosition(inherited Caption, FCaption);
- end;
- Result := GetSyncedWideString(FCaption, (inherited Caption));
-end;
-
-procedure TTntMenuItem.SetCaption(const Value: WideString);
-begin
- GetCaption; // auto adjust for hot key changes
- 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;
- UpdateMenuString(GetParentMenu);
-end;
-
-procedure TTntMenuItem.MenuChanged(Rebuild: Boolean);
-begin
- if (not FIgnoreMenuChanged) then begin
- inherited;
- UpdateMenuItems(Self, GetParentMenu);
- FixMenuBiDiProblem(GetParentMenu);
- end;
-end;
-
-procedure TTntMenuItem.UpdateMenuString(ParentMenu: TMenu);
-var
- ParentHandle: THandle;
-
- function NativeMenuTypeIsString: Boolean;
- var
- MenuItemInfo: TMenuItemInfoW;
- Buffer: array[0..79] of WideChar;
- begin
- MenuItemInfo.cbSize := 44; // Required for Windows NT 4.0
- MenuItemInfo.fMask := MIIM_TYPE;
- MenuItemInfo.dwTypeData := Buffer; // ??
- MenuItemInfo.cch := Length(Buffer); // ??
- Result := GetMenuItemInfoW(ParentHandle, Command, False, MenuItemInfo)
- and ((MenuItemInfo.fType and (MFT_BITMAP or MFT_SEPARATOR or MFT_OWNERDRAW)) = 0)
- end;
-
- function NativeMenuString: WideString;
- var
- Len: Integer;
- begin
- Assert(Win32PlatformIsUnicode);
- Len := GetMenuStringW(ParentHandle, Command, nil, 0, MF_BYCOMMAND);
- if Len = 0 then
- Result := ''
- else begin
- SetLength(Result, Len + 1);
- Len := GetMenuStringW(ParentHandle, Command, PWideChar(Result), Len + 1, MF_BYCOMMAND);
- SetLength(Result, Len);
- end;
- end;
-
- procedure SetMenuString(const Value: WideString);
- var
- MenuItemInfo: TMenuItemInfoW;
- Buffer: array[0..79] of WideChar;
- begin
- MenuItemInfo.cbSize := 44; // Required for Windows NT 4.0
- MenuItemInfo.fMask := MIIM_TYPE;
- MenuItemInfo.dwTypeData := Buffer; // ??
- MenuItemInfo.cch := Length(Buffer); // ??
- if GetMenuItemInfoW(ParentHandle, Command, False, MenuItemInfo)
- and ((MenuItemInfo.fType and (MFT_BITMAP or MFT_SEPARATOR or MFT_OWNERDRAW)) = 0) then
- begin
- MenuItemInfo.dwTypeData := PWideChar(Value);
- MenuItemInfo.cch := Length(Value);
- Win32Check(SetMenuItemInfoW(ParentHandle, Command, False, MenuItemInfo));
- end;
- end;
-
- function SameEvent(A, B: TMenuMeasureItemEvent): Boolean;
- begin
- Result := @A = @B;
- end;
-
-var
- MenuCaption: WideString;
-begin
- FKeyboardLayout := GetKeyboardLayout(0);
- if Parent = nil then
- ParentHandle := 0
- else if (THackMenuItem(Self.Parent).FMergedWith <> nil) then
- ParentHandle := THackMenuItem(Self.Parent).FMergedWith.Handle
- else
- ParentHandle := Parent.Handle;
-
- if (Win32PlatformIsUnicode)
- and (Parent <> nil) and (ParentMenu <> nil)
- and (ComponentState * [csReading, csDestroying] = [])
- and (Visible)
- and (NativeMenuTypeIsString) then begin
- MenuCaption := Caption;
- if (Count = 0)
- and ((ShortCut <> scNone)
- and ((Parent = nil) or (Parent.Parent <> nil) or not (Parent.Owner is TMainMenu{TNT-ALLOW TMainMenu}))) then
- MenuCaption := MenuCaption + #9 + WideShortCutToText(ShortCut);
- if (NativeMenuString <> MenuCaption) then
- begin
- SetMenuString(MenuCaption);
- if ((Parent = ParentMenu.Items) or (THackMenuItem(Self.Parent).FMergedWith <> nil))
- and (ParentMenu is TMainMenu{TNT-ALLOW TMainMenu})
- and (ParentMenu.WindowHandle <> 0) then
- DrawMenuBar(ParentMenu.WindowHandle) {top level menu bar items}
- end;
- end;
-end;
-
-function TTntMenuItem.GetAlignmentDrawStyle: Word;
-const
- Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
-var
- ParentMenu: TMenu;
- Alignment: TPopupAlignment;
-begin
- ParentMenu := GetParentMenu;
- if ParentMenu is TMenu then
- Alignment := paLeft
- else if ParentMenu is TPopupMenu{TNT-ALLOW TPopupMenu} then
- Alignment := TPopupMenu{TNT-ALLOW TPopupMenu}(ParentMenu).Alignment
- else
- Alignment := paLeft;
- Result := Alignments[Alignment];
-end;
-
-procedure TTntMenuItem.AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
- State: TOwnerDrawState; TopLevel: Boolean);
-
- procedure DrawMenuText(BiDi: Boolean);
- var
- ImageList: TCustomImageList;
- DrawImage, DrawGlyph: Boolean;
- GlyphRect, SaveRect: TRect;
- DrawStyle: Longint;
- Selected: Boolean;
- Win98Plus: Boolean;
- Win2K: Boolean;
- begin
- ImageList := GetImageList;
- Selected := odSelected in State;
- Win98Plus := (Win32MajorVersion > 4) or
- ((Win32MajorVersion = 4) and (Win32MinorVersion > 0));
- Win2K := (Win32MajorVersion > 4) and (Win32Platform = VER_PLATFORM_WIN32_NT);
- with ACanvas do
- begin
- GlyphRect.Left := ARect.Left + 1;
- DrawImage := (ImageList <> nil) and ((ImageIndex > -1) and
- (ImageIndex < ImageList.Count) or Checked and ((not MenuItemHasBitmap(Self)) or
- Bitmap.Empty));
- if DrawImage or MenuItemHasBitmap(Self) and not Bitmap.Empty then
- begin
- DrawGlyph := True;
- if DrawImage then
- GlyphRect.Right := GlyphRect.Left + ImageList.Width
- else begin
- { Need to add BitmapWidth/Height properties for TMenuItem if we're to
- support them. Right now let's hardcode them to 16x16. }
- GlyphRect.Right := GlyphRect.Left + 16;
- end;
- { Draw background pattern brush if selected }
- if Checked then
- begin
- Inc(GlyphRect.Right);
- if not Selected then
- Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
- Inc(GlyphRect.Left);
- end;
- if Checked then
- Dec(GlyphRect.Right);
- end else begin
- if (ImageList <> nil) and (not TopLevel) then
- GlyphRect.Right := GlyphRect.Left + ImageList.Width
- else
- GlyphRect.Right := GlyphRect.Left;
- DrawGlyph := False;
- end;
- if BiDi then begin
- SaveRect := GlyphRect;
- GlyphRect.Left := ARect.Right - (SaveRect.Right - ARect.Left);
- GlyphRect.Right := ARect.Right - (SaveRect.Left - ARect.Left);
- end;
- with GlyphRect do begin
- Dec(Left);
- Inc(Right, 2);
- end;
- if Selected then begin
- if DrawGlyph then begin
- if BiDi then
- ARect.Right := GlyphRect.Left - 1
- else
- ARect.Left := GlyphRect.Right + 1;
- end;
- if not (Win98Plus and TopLevel) then
- Brush.Color := clHighlight;
- end;
- 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
- ARect.Right := GlyphRect.Left - 1
- else
- ARect.Left := GlyphRect.Right + 1;
- end;
- Inc(ARect.Left, 2);
- Dec(ARect.Right, 1);
- DrawStyle := DT_EXPANDTABS or DT_SINGLELINE or GetAlignmentDrawStyle;
- if Win2K and (odNoAccel in State) then
- DrawStyle := DrawStyle or DT_HIDEPREFIX;
- { Calculate vertical layout }
- SaveRect := ARect;
- if odDefault in State then
- Font.Style := [fsBold];
- DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle or DT_CALCRECT or DT_NOCLIP);
- if BiDi then begin
- { the DT_CALCRECT does not take into account alignment }
- ARect.Left := SaveRect.Left;
- ARect.Right := SaveRect.Right;
- end;
- OffsetRect(ARect, 0, ((SaveRect.Bottom - SaveRect.Top) - (ARect.Bottom - ARect.Top)) div 2);
- 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
- begin
- if BiDi then begin
- ARect.Left := 10;
- ARect.Right := ARect.Left + WideCanvasTextWidth(ACanvas, WideShortCutToText(ShortCut));
- end else begin
- ARect.Left := ARect.Right;
- ARect.Right := SaveRect.Right - 10;
- end;
- DoDrawText(ACanvas, WideShortCutToText(ShortCut), ARect, Selected, DT_RIGHT);
- end;
- end;
- end;
-
-var
- ParentMenu: TMenu;
- SaveCaption: WideString;
- SaveShortCut: TShortCut;
-begin
- ParentMenu := GetParentMenu;
- if (not Win32PlatformIsUnicode)
- or (Self.IsLine)
- or ( (ParentMenu <> nil) and (ParentMenu.OwnerDraw or (GetImageList <> nil))
- and (Assigned(OnAdvancedDrawItem) or Assigned(OnDrawItem)) ) then
- inherited
- else begin
- SaveCaption := Caption;
- SaveShortCut := ShortCut;
- try
- FIgnoreMenuChanged := True;
- try
- Caption := '';
- ShortCut := scNone;
- finally
- FIgnoreMenuChanged := False;
- end;
- inherited;
- finally
- FIgnoreMenuChanged := True;
- try
- Caption := SaveCaption;
- ShortCut := SaveShortcut;
- finally
- FIgnoreMenuChanged := False;
- end;
- end;
- DrawMenuText((ParentMenu <> nil) and (ParentMenu.IsRightToLeft))
- end;
-end;
-
-procedure TTntMenuItem.DoDrawText(ACanvas: TCanvas; const ACaption: WideString;
- var Rect: TRect; Selected: Boolean; Flags: Longint);
-var
- Text: WideString;
- ParentMenu: TMenu;
-begin
- if (not Win32PlatformIsUnicode)
- or (IsLine) then
- inherited DoDrawText(ACanvas, ACaption, Rect, Selected, Flags)
- else begin
- ParentMenu := GetParentMenu;
- if (ParentMenu <> nil) and (ParentMenu.IsRightToLeft) then
- begin
- if Flags and DT_LEFT = DT_LEFT then
- Flags := Flags and (not DT_LEFT) or DT_RIGHT
- else if Flags and DT_RIGHT = DT_RIGHT then
- Flags := Flags and (not DT_RIGHT) or DT_LEFT;
- Flags := Flags or DT_RTLREADING;
- end;
- Text := ACaption;
- if (Flags and DT_CALCRECT <> 0) and ((Text = '') or
- (Text[1] = cHotkeyPrefix) and (Text[2] = #0)) then Text := Text + ' ';
- with ACanvas do
- begin
- Brush.Style := bsClear;
- if Default then
- Font.Style := Font.Style + [fsBold];
- if not Enabled then
- begin
- if not Selected then
- begin
- OffsetRect(Rect, 1, 1);
- Font.Color := clBtnHighlight;
- 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;
- Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), Rect, Flags);
- end;
- end;
-end;
-
-function TTntMenuItem.MeasureItemTextWidth(ACanvas: TCanvas; const Text: WideString): Integer;
-var
- R: TRect;
-begin
- FillChar(R, SizeOf(R), 0);
- DoDrawText(ACanvas, Text, R, False,
- GetAlignmentDrawStyle or DT_EXPANDTABS or DT_SINGLELINE or DT_NOCLIP or DT_CALCRECT);
- Result := R.Right - R.Left;
-end;
-
-procedure TTntMenuItem.MeasureItem(ACanvas: TCanvas; var Width, Height: Integer);
-var
- SaveMeasureItemEvent: TMenuMeasureItemEvent;
-begin
- if (not Win32PlatformIsUnicode)
- or (Self.IsLine) then
- inherited
- else begin
- SaveMeasureItemEvent := inherited OnMeasureItem;
- try
- inherited OnMeasureItem := nil;
- inherited;
- Inc(Width, MeasureItemTextWidth(ACanvas, Caption));
- Dec(Width, MeasureItemTextWidth(ACanvas, inherited Caption));
- if ShortCut <> scNone then begin
- Inc(Width, MeasureItemTextWidth(ACanvas, WideShortCutToText(ShortCut)));
- Dec(Width, MeasureItemTextWidth(ACanvas, ShortCutToText{TNT-ALLOW ShortCutToText}(ShortCut)));
- end;
- finally
- inherited OnMeasureItem := SaveMeasureItemEvent;
- end;
- if Assigned(OnMeasureItem) then OnMeasureItem(Self, ACanvas, Width, Height);
- end;
-end;
-
-function TTntMenuItem.Find(ACaption: WideString): TMenuItem{TNT-ALLOW TMenuItem};
-var
- I: Integer;
-begin
- Result := nil;
- ACaption := WideStripHotkey(ACaption);
- for I := 0 to Count - 1 do
- if WideSameText(ACaption, WideStripHotkey(WideGetMenuItemCaption(Items[I]))) then
- begin
- Result := Items[I];
- System.Break;
- end;
-end;
-
-function TTntMenuItem.GetActionLinkClass: TMenuActionLinkClass;
-begin
- Result := TTntMenuActionLink;
-end;
-
-procedure TTntMenuItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- if (Sender is TCustomAction{TNT-ALLOW TCustomAction}) and Supports(Sender, ITntAction) then begin
- if not CheckDefaults or (Caption = '') then
- Caption := TntAction_GetCaption(TCustomAction{TNT-ALLOW TCustomAction}(Sender));
- if not CheckDefaults or (Hint = '') then
- Hint := TntAction_GetHint(TCustomAction{TNT-ALLOW TCustomAction}(Sender));
- end;
- inherited;
-end;
-
-{ 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;
- UpdateMenuItems(Items, Self);
- if (THackMenuItem(Items).FMerged <> nil) then begin
- UpdateMenuItems(THackMenuItem(Items).FMerged, Self);
- end;
-end;
-
-{ TTntPopupMenu }
-
-constructor TTntPopupMenu.Create(AOwner: TComponent);
-begin
- inherited;
- PopupList.Remove(Self);
- if TntPopupList <> nil then
- 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
- if TntPopupList <> nil then
- 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
- TntPopupList := TTntPopupList.Create;
- TntPopupList.SavedPopupList := Menus.PopupList;
-
-finalization
- FreeAndNil(TntPopupList);
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntRegistry.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntRegistry.pas deleted file mode 100644 index e3f445f92b..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntRegistry.pas +++ /dev/null @@ -1,148 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntRegistry;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Registry, Windows, TntClasses;
-
-{TNT-WARN TRegistry}
-type
- TTntRegistry = class(TRegistry{TNT-ALLOW TRegistry})
- private
- procedure WriteStringEx(dwType: DWORD; const Name, Value: WideString);
- public
- procedure GetKeyNames(Strings: TTntStrings);
- procedure GetValueNames(Strings: TTntStrings);
- function ReadString(const Name: WideString): WideString;
- procedure WriteString(const Name, Value: WideString);
- procedure WriteExpandString(const Name, Value: WideString);
- end;
-
-implementation
-
-uses
- RTLConsts, SysUtils, TntSysUtils;
-
-{ TTntRegistry }
-
-procedure TTntRegistry.GetKeyNames(Strings: TTntStrings);
-var
- Len: DWORD;
- I: Integer;
- Info: TRegKeyInfo;
- S: WideString;
-begin
- if (not Win32PlatformIsUnicode) then
- inherited GetKeyNames(Strings.AnsiStrings)
- else begin
- Strings.Clear;
- if GetKeyInfo(Info) then
- begin
- SetLength(S, (Info.MaxSubKeyLen + 1) * 2);
- for I := 0 to Info.NumSubKeys - 1 do
- begin
- Len := (Info.MaxSubKeyLen + 1) * 2;
- if RegEnumKeyExW(CurrentKey, I, PWideChar(S), Len, nil, nil, nil, nil) = ERROR_SUCCESS then
- Strings.Add(PWideChar(S));
- end;
- end;
- end;
-end;
-
-{$IFNDEF COMPILER_9_UP} // fix declaration for RegEnumValueW (lpValueName is a PWideChar)
-function RegEnumValueW(hKey: HKEY; dwIndex: DWORD; lpValueName: PWideChar;
- var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD;
- lpData: PByte; lpcbData: PDWORD): Longint; stdcall; external advapi32 name 'RegEnumValueW';
-{$ENDIF}
-
-procedure TTntRegistry.GetValueNames(Strings: TTntStrings);
-var
- Len: DWORD;
- I: Integer;
- Info: TRegKeyInfo;
- S: WideString;
-begin
- if (not Win32PlatformIsUnicode) then
- inherited GetValueNames(Strings.AnsiStrings)
- else begin
- Strings.Clear;
- if GetKeyInfo(Info) then
- begin
- SetLength(S, Info.MaxValueLen + 1);
- for I := 0 to Info.NumValues - 1 do
- begin
- Len := Info.MaxValueLen + 1;
- RegEnumValueW(CurrentKey, I, PWideChar(S), Len, nil, nil, nil, nil);
- Strings.Add(PWideChar(S));
- end;
- end;
- end;
-end;
-
-function TTntRegistry.ReadString(const Name: WideString): WideString;
-var
- DataType: Cardinal;
- BufSize: Cardinal;
-begin
- if (not Win32PlatformIsUnicode) then
- result := inherited ReadString(Name)
- else begin
- // get length and type
- DataType := REG_NONE;
- if RegQueryValueExW(CurrentKey, PWideChar(Name), nil,
- @DataType, nil, @BufSize) <> ERROR_SUCCESS then
- Result := ''
- else begin
- // check type
- if not (DataType in [REG_SZ, REG_EXPAND_SZ]) then
- raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
- if BufSize = 1 then
- BufSize := SizeOf(WideChar); // sometimes this occurs for single character values!
- SetLength(Result, BufSize div SizeOf(WideChar));
- if RegQueryValueExW(CurrentKey, PWideChar(Name), nil,
- @DataType, PByte(PWideChar(Result)), @BufSize) <> ERROR_SUCCESS then
- raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
- Result := PWideChar(Result);
- end
- end
-end;
-
-procedure TTntRegistry.WriteStringEx(dwType: DWORD; const Name, Value: WideString);
-begin
- Assert(dwType in [REG_SZ, REG_EXPAND_SZ]);
- if (not Win32PlatformIsUnicode) then begin
- if dwType = REG_SZ then
- inherited WriteString(Name, Value)
- else
- inherited WriteExpandString(Name, Value);
- end else begin
- if RegSetValueExW(CurrentKey, PWideChar(Name), 0, dwType,
- PWideChar(Value), (Length(Value) + 1) * SizeOf(WideChar)) <> ERROR_SUCCESS then
- raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
- end;
-end;
-
-procedure TTntRegistry.WriteString(const Name, Value: WideString);
-begin
- WriteStringEx(REG_SZ, Name, Value);
-end;
-
-procedure TTntRegistry.WriteExpandString(const Name, Value: WideString);
-begin
- WriteStringEx(REG_EXPAND_SZ, Name, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdActns.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdActns.pas deleted file mode 100644 index 118e806336..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdActns.pas +++ /dev/null @@ -1,1922 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntStdActns;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Classes, ActnList, TntActnList, StdActns, TntDialogs;
-
-type
-{TNT-WARN THintAction}
- TTntHintAction = class(THintAction{TNT-ALLOW THintAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- published
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TEditAction}
- TTntEditAction = class(TEditAction{TNT-ALLOW TEditAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TEditCut}
- TTntEditCut = class(TEditCut{TNT-ALLOW TEditCut}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TEditCopy}
- TTntEditCopy = class(TEditCopy{TNT-ALLOW TEditCopy}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TEditPaste}
- TTntEditPaste = class(TEditPaste{TNT-ALLOW TEditPaste}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TEditSelectAll}
- TTntEditSelectAll = class(TEditSelectAll{TNT-ALLOW TEditSelectAll}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TEditUndo}
- TTntEditUndo = class(TEditUndo{TNT-ALLOW TEditUndo}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TEditDelete}
- TTntEditDelete = class(TEditDelete{TNT-ALLOW TEditDelete}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- 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;
- end;
-
-{TNT-WARN TWindowAction}
- TTntWindowAction = class(TWindowAction{TNT-ALLOW TWindowAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TWindowClose}
- TTntWindowClose = class(TWindowClose{TNT-ALLOW TWindowClose}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TWindowCascade}
- TTntWindowCascade = class(TWindowCascade{TNT-ALLOW TWindowCascade}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TWindowTileHorizontal}
- TTntWindowTileHorizontal = class(TWindowTileHorizontal{TNT-ALLOW TWindowTileHorizontal}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TWindowTileVertical}
- TTntWindowTileVertical = class(TWindowTileVertical{TNT-ALLOW TWindowTileVertical}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TWindowMinimizeAll}
- TTntWindowMinimizeAll = class(TWindowMinimizeAll{TNT-ALLOW TWindowMinimizeAll}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TWindowArrange}
- TTntWindowArrange = class(TWindowArrange{TNT-ALLOW TWindowArrange}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN THelpAction}
- TTntHelpAction = class(THelpAction{TNT-ALLOW THelpAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN THelpContents}
- TTntHelpContents = class(THelpContents{TNT-ALLOW THelpContents}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN THelpTopicSearch}
- TTntHelpTopicSearch = class(THelpTopicSearch{TNT-ALLOW THelpTopicSearch}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN THelpOnHelp}
- TTntHelpOnHelp = class(THelpOnHelp{TNT-ALLOW THelpOnHelp}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN THelpContextAction}
- TTntHelpContextAction = class(THelpContextAction{TNT-ALLOW THelpContextAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TCommonDialogAction}
- TTntCommonDialogAction = class(TCommonDialogAction{TNT-ALLOW TCommonDialogAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TFileAction}
- TTntFileAction = class(TFileAction{TNT-ALLOW TFileAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TFileOpen}
- TTntFileOpen = class(TFileOpen{TNT-ALLOW TFileOpen}, ITntAction)
- private
- function GetCaption: WideString;
- 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;
-
-{TNT-WARN TFileOpenWith}
- TTntFileOpenWith = class(TFileOpenWith{TNT-ALLOW TFileOpenWith}, ITntAction)
- private
- function GetCaption: WideString;
- 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;
-
-{TNT-WARN TFileSaveAs}
- TTntFileSaveAs = class(TFileSaveAs{TNT-ALLOW TFileSaveAs}, ITntAction)
- private
- function GetCaption: WideString;
- 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;
-
-{TNT-WARN TFilePrintSetup}
- TTntFilePrintSetup = class(TFilePrintSetup{TNT-ALLOW TFilePrintSetup}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
- {$IFDEF COMPILER_7_UP}
-{TNT-WARN TFilePageSetup}
- TTntFilePageSetup = class(TFilePageSetup{TNT-ALLOW TFilePageSetup}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
- {$ENDIF}
-
-{TNT-WARN TFileExit}
- TTntFileExit = class(TFileExit{TNT-ALLOW TFileExit}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TSearchAction}
- TTntSearchAction = class(TSearchAction{TNT-ALLOW TSearchAction}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- public
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TSearchFind}
- TTntSearchFind = class(TSearchFind{TNT-ALLOW TSearchFind}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TSearchReplace}
- TTntSearchReplace = class(TSearchReplace{TNT-ALLOW TSearchReplace}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TSearchFindFirst}
- TTntSearchFindFirst = class(TSearchFindFirst{TNT-ALLOW TSearchFindFirst}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TSearchFindNext}
- TTntSearchFindNext = class(TSearchFindNext{TNT-ALLOW TSearchFindNext}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TFontEdit}
- TTntFontEdit = class(TFontEdit{TNT-ALLOW TFontEdit}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TColorSelect}
- TTntColorSelect = class(TColorSelect{TNT-ALLOW TColorSelect}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-{TNT-WARN TPrintDlg}
- TTntPrintDlg = class(TPrintDlg{TNT-ALLOW TPrintDlg}, ITntAction)
- private
- function GetCaption: WideString;
- procedure SetCaption(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: WideString read GetCaption write SetCaption;
- property Hint: WideString read GetHint write SetHint;
- end;
-
-procedure TntStdActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-
-implementation
-
-uses
- Dialogs, TntClasses;
-
-{TNT-IGNORE-UNIT}
-
-procedure TntStdActn_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
-begin
- TntAction_AfterInherited_Assign(Action, Source);
- // TCommonDialogAction
- if (Action is TCommonDialogAction) and (Source is TCommonDialogAction) then begin
- TCommonDialogAction(Action).BeforeExecute := TCommonDialogAction(Source).BeforeExecute;
- TCommonDialogAction(Action).OnAccept := TCommonDialogAction(Source).OnAccept;
- TCommonDialogAction(Action).OnCancel := TCommonDialogAction(Source).OnCancel;
- end;
- // TFileOpen
- if (Action is TFileOpen) and (Source is TFileOpen) then begin
- {$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 COMPILER_7_UP}
- TFileOpenWith(Action).AfterOpen := TFileOpenWith(Source).AfterOpen;
- {$ENDIF}
- end;
- // TSearchFindNext
- if (Action is TSearchFindNext) and (Source is TSearchFindNext) then begin
- TSearchFindNext(Action).SearchFind := TSearchFindNext(Source).SearchFind;
- end;
-end;
-
-//-------------------------
-// TNT STD ACTNS
-//-------------------------
-
-{ TTntHintAction }
-
-procedure TTntHintAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntHintAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntHintAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntHintAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntHintAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntHintAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntEditAction }
-
-procedure TTntEditAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntEditAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntEditAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntEditAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntEditAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntEditAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntEditCut }
-
-procedure TTntEditCut.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntEditCut.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntEditCut.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntEditCut.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntEditCut.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntEditCut.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntEditCopy }
-
-procedure TTntEditCopy.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntEditCopy.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntEditCopy.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntEditCopy.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntEditCopy.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntEditCopy.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntEditPaste }
-
-procedure TTntEditPaste.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntEditPaste.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntEditPaste.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntEditPaste.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntEditPaste.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntEditPaste.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntEditSelectAll }
-
-procedure TTntEditSelectAll.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntEditSelectAll.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntEditSelectAll.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntEditSelectAll.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntEditSelectAll.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntEditSelectAll.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntEditUndo }
-
-procedure TTntEditUndo.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntEditUndo.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntEditUndo.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntEditUndo.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntEditUndo.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntEditUndo.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntEditDelete }
-
-procedure TTntEditDelete.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntEditDelete.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntEditDelete.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntEditDelete.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntEditDelete.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntEditDelete.SetHint(const Value: WideString);
-begin
- 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);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntWindowAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntWindowAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntWindowAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntWindowAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntWindowAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntWindowClose }
-
-procedure TTntWindowClose.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntWindowClose.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntWindowClose.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntWindowClose.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntWindowClose.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntWindowClose.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntWindowCascade }
-
-procedure TTntWindowCascade.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntWindowCascade.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntWindowCascade.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntWindowCascade.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntWindowCascade.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntWindowCascade.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntWindowTileHorizontal }
-
-procedure TTntWindowTileHorizontal.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntWindowTileHorizontal.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntWindowTileHorizontal.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntWindowTileHorizontal.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntWindowTileHorizontal.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntWindowTileHorizontal.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntWindowTileVertical }
-
-procedure TTntWindowTileVertical.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntWindowTileVertical.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntWindowTileVertical.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntWindowTileVertical.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntWindowTileVertical.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntWindowTileVertical.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntWindowMinimizeAll }
-
-procedure TTntWindowMinimizeAll.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntWindowMinimizeAll.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntWindowMinimizeAll.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntWindowMinimizeAll.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntWindowMinimizeAll.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntWindowMinimizeAll.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntWindowArrange }
-
-procedure TTntWindowArrange.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntWindowArrange.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntWindowArrange.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntWindowArrange.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntWindowArrange.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntWindowArrange.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntHelpAction }
-
-procedure TTntHelpAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntHelpAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntHelpAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntHelpAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntHelpAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntHelpAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntHelpContents }
-
-procedure TTntHelpContents.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntHelpContents.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntHelpContents.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntHelpContents.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntHelpContents.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntHelpContents.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntHelpTopicSearch }
-
-procedure TTntHelpTopicSearch.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntHelpTopicSearch.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntHelpTopicSearch.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntHelpTopicSearch.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntHelpTopicSearch.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntHelpTopicSearch.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntHelpOnHelp }
-
-procedure TTntHelpOnHelp.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntHelpOnHelp.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntHelpOnHelp.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntHelpOnHelp.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntHelpOnHelp.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntHelpOnHelp.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntHelpContextAction }
-
-procedure TTntHelpContextAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntHelpContextAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntHelpContextAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntHelpContextAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntHelpContextAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntHelpContextAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntCommonDialogAction }
-
-procedure TTntCommonDialogAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntCommonDialogAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCommonDialogAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntCommonDialogAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntCommonDialogAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntCommonDialogAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntFileAction }
-
-procedure TTntFileAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFileAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFileAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFileAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFileAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFileAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntFileOpen }
-
-procedure TTntFileOpen.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFileOpen.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFileOpen.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFileOpen.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFileOpen.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFileOpen.SetHint(const Value: WideString);
-begin
- 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);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFileOpenWith.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFileOpenWith.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFileOpenWith.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFileOpenWith.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFileOpenWith.SetHint(const Value: WideString);
-begin
- 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);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFileSaveAs.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFileSaveAs.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFileSaveAs.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFileSaveAs.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFileSaveAs.SetHint(const Value: WideString);
-begin
- 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);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFilePrintSetup.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFilePrintSetup.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFilePrintSetup.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFilePrintSetup.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFilePrintSetup.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
- {$IFDEF COMPILER_7_UP}
-
-{ TTntFilePageSetup }
-
-procedure TTntFilePageSetup.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFilePageSetup.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFilePageSetup.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFilePageSetup.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFilePageSetup.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFilePageSetup.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
- {$ENDIF}
-
-{ TTntFileExit }
-
-procedure TTntFileExit.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFileExit.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFileExit.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFileExit.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFileExit.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFileExit.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntSearchAction }
-
-procedure TTntSearchAction.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntSearchAction.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSearchAction.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntSearchAction.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntSearchAction.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntSearchAction.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntSearchFind }
-
-procedure TTntSearchFind.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntSearchFind.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSearchFind.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntSearchFind.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntSearchFind.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntSearchFind.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntSearchReplace }
-
-procedure TTntSearchReplace.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntSearchReplace.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSearchReplace.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntSearchReplace.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntSearchReplace.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntSearchReplace.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntSearchFindFirst }
-
-procedure TTntSearchFindFirst.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntSearchFindFirst.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSearchFindFirst.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntSearchFindFirst.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntSearchFindFirst.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntSearchFindFirst.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntSearchFindNext }
-
-procedure TTntSearchFindNext.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntSearchFindNext.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntSearchFindNext.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntSearchFindNext.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntSearchFindNext.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntSearchFindNext.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntFontEdit }
-
-procedure TTntFontEdit.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntFontEdit.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntFontEdit.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntFontEdit.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntFontEdit.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntFontEdit.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntColorSelect }
-
-procedure TTntColorSelect.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntColorSelect.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntColorSelect.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntColorSelect.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntColorSelect.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntColorSelect.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-{ TTntPrintDlg }
-
-procedure TTntPrintDlg.Assign(Source: TPersistent);
-begin
- inherited;
- TntStdActn_AfterInherited_Assign(Self, Source);
-end;
-
-procedure TTntPrintDlg.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntPrintDlg.GetCaption: WideString;
-begin
- Result := TntAction_GetCaption(Self);
-end;
-
-procedure TTntPrintDlg.SetCaption(const Value: WideString);
-begin
- TntAction_SetCaption(Self, Value);
-end;
-
-function TTntPrintDlg.GetHint: WideString;
-begin
- Result := TntAction_GetHint(Self);
-end;
-
-procedure TTntPrintDlg.SetHint(const Value: WideString);
-begin
- TntAction_SetHint(Self, Value);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas deleted file mode 100644 index 09c7da4573..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas +++ /dev/null @@ -1,3215 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntStdCtrls;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: Implement TCustomListBox.KeyPress, OnDataFind. }
-
-uses
- Windows, Messages, Classes, Controls, TntControls, StdCtrls, Graphics,
- TntClasses, TntSysUtils;
-
-{TNT-WARN TCustomEdit}
-type
- TTntCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit})
- private
- 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;
- end;
-
-{TNT-WARN TEdit}
- TTntEdit = class(TTntCustomEdit)
- published
- property Align;
- property Anchors;
- property AutoSelect;
- property AutoSize;
- property BevelEdges;
- property BevelInner;
- property BevelKind default bkNone;
- property BevelOuter;
- property BevelWidth;
- property BiDiMode;
- property BorderStyle;
- property CharCase;
- property Color;
- property Constraints;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HideSelection;
- property ImeMode;
- property ImeName;
- property MaxLength;
- property OEMConvert;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PopupMenu;
- property ReadOnly;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
- property OnChange;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-type
- TTntCustomMemo = class;
-
- TTntMemoStrings = class(TTntStrings)
- protected
- FMemo: TCustomMemo{TNT-ALLOW TCustomMemo};
- FMemoLines: TStrings{TNT-ALLOW TStrings};
- FRichEditMode: Boolean;
- FLineBreakStyle: TTntTextLineBreakStyle;
- function Get(Index: Integer): WideString; override;
- function GetCount: Integer; override;
- function GetTextStr: 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;
- end;
-
-{TNT-WARN TCustomMemo}
- TTntCustomMemo = class(TCustomMemo{TNT-ALLOW TCustomMemo})
- private
- FLines: TTntStrings;
- procedure SetSelText(const Value: WideString);
- function GetText: WideString;
- procedure SetText(const Value: WideString);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure SetLines(const Value: TTntStrings); virtual;
- 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: TTntStrings read FLines write SetLines;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TMemo}
- TTntMemo = class(TTntCustomMemo)
- published
- property Align;
- property Alignment;
- property Anchors;
- property BevelEdges;
- property BevelInner;
- property BevelKind default bkNone;
- property BevelOuter;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property Constraints;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HideSelection;
- property ImeMode;
- property ImeName;
- property Lines;
- property MaxLength;
- property OEMConvert;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ReadOnly;
- property ScrollBars;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- property WantReturns;
- property WantTabs;
- property WordWrap;
- property OnChange;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- end;
-
- TTntComboBoxStrings = class(TTntStrings)
- protected
- function Get(Index: Integer): WideString; override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetUpdateState(Updating: Boolean); override;
- public
- ComboBox: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- function Add(const S: WideString): Integer; override;
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- function IndexOf(const S: WideString): Integer; override;
- procedure Insert(Index: Integer; const S: WideString); override;
- end;
-
-type
- TWMCharMsgHandler = procedure(var Message: TWMChar) of object;
-
-{$IFDEF DELPHI_7} // fix for Delphi 7 only
-{ TD7PatchedComboBoxStrings }
-type
- TD7PatchedComboBoxStrings = class(TCustomComboBoxStrings)
- protected
- function Get(Index: Integer): string{TNT-ALLOW string}; override;
- public
- function Add(const S: string{TNT-ALLOW string}): Integer; override;
- procedure Insert(Index: Integer; const S: string{TNT-ALLOW string}); override;
- 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},
- IWideCustomListControl)
- private
- FItems: TTntStrings;
- FSaveItems: TTntStrings;
- FSaveItemIndex: Integer;
- FFilter: WideString;
- FLastTime: Cardinal;
- function GetItems: TTntStrings;
- function GetSelStart: Integer;
- procedure SetSelStart(const Value: Integer);
- function GetSelLength: Integer;
- procedure SetSelLength(const Value: Integer);
- function GetSelText: WideString;
- procedure SetSelText(const Value: WideString);
- function GetText: WideString;
- procedure SetText(const Value: WideString);
- procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure WMChar(var Message: TWMChar); message WM_CHAR;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure DestroyWnd; override;
- function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
- function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
- procedure DoEditCharMsg(var Message: TWMChar); virtual;
- procedure CreateWnd; override;
- 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 DELPHI_7} // fix for Delphi 7 only
- function GetItemsClass: TCustomComboBoxStringsClass; override;
- {$ENDIF}
- procedure SetItems(const Value: TTntStrings); reintroduce; virtual;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure CopySelection(Destination: TCustomListControl); override;
- 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: TTntStrings read GetItems write SetItems;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TComboBox}
- TTntComboBox = class(TTntCustomComboBox)
- published
- property Align;
- property AutoComplete default True;
- {$IFDEF COMPILER_9_UP}
- property AutoCompleteDelay default 500;
- {$ENDIF}
- property AutoDropDown default False;
- {$IFDEF COMPILER_7_UP}
- property AutoCloseUp default False;
- {$ENDIF}
- property BevelEdges;
- property BevelInner;
- property BevelKind default bkNone;
- property BevelOuter;
- property Style; {Must be published before Items}
- property Anchors;
- property BiDiMode;
- property CharCase;
- property Color;
- property Constraints;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property DropDownCount;
- property Enabled;
- property Font;
- property ImeMode;
- property ImeName;
- property ItemHeight;
- property ItemIndex default -1;
- property MaxLength;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property Sorted;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
- property OnChange;
- property OnClick;
- property OnCloseUp;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawItem;
- property OnDropDown;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMeasureItem;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnSelect;
- property OnStartDock;
- property OnStartDrag;
- property Items; { Must be published after OnMeasureItem }
- end;
-
- TLBGetWideDataEvent = procedure(Control: TWinControl; Index: Integer;
- var Data: WideString) of object;
-
- TAccessCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox});
-
- TTntListBoxStrings = class(TTntStrings)
- private
- FListBox: TAccessCustomListBox;
- function GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- procedure SetListBox(const Value: TCustomListBox{TNT-ALLOW TCustomListBox});
- protected
- procedure Put(Index: Integer; const S: WideString); override;
- function Get(Index: Integer): WideString; override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetUpdateState(Updating: Boolean); override;
- public
- function Add(const S: WideString): Integer; override;
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- procedure Exchange(Index1, Index2: Integer); override;
- function IndexOf(const S: WideString): Integer; override;
- procedure Insert(Index: Integer; const S: WideString); override;
- procedure Move(CurIndex, NewIndex: Integer); override;
- property ListBox: TCustomListBox{TNT-ALLOW TCustomListBox} read GetListBox write SetListBox;
- end;
-
-{TNT-WARN TCustomListBox}
-type
- TTntCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox}, IWideCustomListControl)
- private
- FItems: TTntStrings;
- FSaveItems: TTntStrings;
- FSaveTopIndex: Integer;
- FSaveItemIndex: Integer;
- FOnData: TLBGetWideDataEvent;
- procedure SetItems(const Value: TTntStrings);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
- procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure CreateWnd; override;
- procedure DestroyWnd; override;
- procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
- property OnData: TLBGetWideDataEvent read FOnData write FOnData;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure CopySelection(Destination: TCustomListControl); override;
- procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
- property Items: TTntStrings read FItems write SetItems;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TListBox}
- TTntListBox = class(TTntCustomListBox)
- published
- property Style;
- property AutoComplete;
- {$IFDEF COMPILER_9_UP}
- property AutoCompleteDelay;
- {$ENDIF}
- property Align;
- property Anchors;
- property BevelEdges;
- property BevelInner;
- property BevelKind default bkNone;
- property BevelOuter;
- property BevelWidth;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property Columns;
- property Constraints;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property ExtendedSelect;
- property Font;
- property ImeMode;
- property ImeName;
- property IntegralHeight;
- property ItemHeight;
- property Items;
- property MultiSelect;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ScrollWidth;
- property ShowHint;
- property Sorted;
- property TabOrder;
- property TabStop;
- property TabWidth;
- property Visible;
- property OnClick;
- property OnContextPopup;
- property OnData;
- property OnDataFind;
- property OnDataObject;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawItem;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMeasureItem;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-{TNT-WARN TCustomLabel}
- TTntCustomLabel = class(TCustomLabel{TNT-ALLOW TCustomLabel})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- protected
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- function GetLabelText: WideString; reintroduce; virtual;
- procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TLabel}
- TTntLabel = class(TTntCustomLabel)
- published
- property Align;
- property Alignment;
- property Anchors;
- property AutoSize;
- property BiDiMode;
- property Caption;
- property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
- property Constraints;
- property DragCursor;
- property DragKind;
- property DragMode;
- {$IFDEF COMPILER_9_UP}
- property EllipsisPosition;
- {$ENDIF}
- property Enabled;
- property FocusControl;
- property Font;
- property ParentBiDiMode;
- property ParentColor;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowAccelChar;
- property ShowHint;
- property Transparent;
- property Layout;
- property Visible;
- property WordWrap;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseEnter;
- property OnMouseLeave;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-{TNT-WARN TButton}
- TTntButton = class(TButton{TNT-ALLOW TButton})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TCustomCheckBox}
- TTntCustomCheckBox = class(TCustomCheckBox{TNT-ALLOW TCustomCheckBox})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- public
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TCheckBox}
- TTntCheckBox = class(TTntCustomCheckBox)
- published
- property Action;
- property Align;
- property Alignment;
- property AllowGrayed;
- property Anchors;
- property BiDiMode;
- property Caption;
- property Checked;
- property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
- property Constraints;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property State;
- property TabOrder;
- property TabStop;
- property Visible;
- {$IFDEF COMPILER_7_UP}
- property WordWrap;
- {$ENDIF}
- property OnClick;
- property OnContextPopup;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-{TNT-WARN TRadioButton}
- TTntRadioButton = class(TRadioButton{TNT-ALLOW TRadioButton})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- published
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TScrollBar}
- TTntScrollBar = class(TScrollBar{TNT-ALLOW TScrollBar})
- private
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsHintStored: Boolean;
- protected
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TCustomGroupBox}
- TTntCustomGroupBox = class(TCustomGroupBox{TNT-ALLOW TCustomGroupBox})
- private
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- protected
- procedure Paint; override;
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TGroupBox}
- TTntGroupBox = class(TTntCustomGroupBox)
- published
- property Align;
- property Anchors;
- property BiDiMode;
- property Caption;
- property Color;
- property Constraints;
- property Ctl3D;
- property DockSite;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- {$IFDEF COMPILER_10_UP}
- property Padding;
- {$ENDIF}
- {$IFDEF COMPILER_7_UP}
- property ParentBackground default True;
- {$ENDIF}
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- {$IFDEF COMPILER_9_UP}
- property OnAlignInsertBefore;
- property OnAlignPosition;
- {$ENDIF}
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDockDrop;
- property OnDockOver;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetSiteInfo;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- property OnUnDock;
- end;
-
-{TNT-WARN TCustomStaticText}
- TTntCustomStaticText = class(TCustomStaticText{TNT-ALLOW TCustomStaticText})
- private
- procedure AdjustBounds;
- function GetCaption: TWideCaption;
- procedure SetCaption(const Value: TWideCaption);
- function GetHint: WideString;
- procedure SetHint(const Value: WideString);
- function IsCaptionStored: Boolean;
- function IsHintStored: Boolean;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- protected
- procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
- procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
- procedure Loaded; override;
- procedure SetAutoSize(AValue: boolean); override;
- procedure CreateWindowHandle(const Params: TCreateParams); override;
- procedure DefineProperties(Filer: TFiler); override;
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
- public
- constructor Create(AOwner: TComponent); override;
- published
- property Hint: WideString read GetHint write SetHint stored IsHintStored;
- end;
-
-{TNT-WARN TStaticText}
- TTntStaticText = class(TTntCustomStaticText)
- published
- property Align;
- property Alignment;
- property Anchors;
- property AutoSize;
- property BevelEdges;
- property BevelInner;
- property BevelKind default bkNone;
- property BevelOuter;
- property BiDiMode;
- property BorderStyle;
- property Caption;
- property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
- property Constraints;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property FocusControl;
- property Font;
- property ParentBiDiMode;
- property ParentColor;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowAccelChar;
- property ShowHint;
- property TabOrder;
- property TabStop;
- {$IFDEF COMPILER_7_UP}
- property Transparent;
- {$ENDIF}
- property Visible;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- {$IFDEF COMPILER_9_UP}
- property OnMouseActivate;
- {$ENDIF}
- property OnMouseDown;
- {$IFDEF COMPILER_10_UP}
- property OnMouseEnter;
- property OnMouseLeave;
- {$ENDIF}
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- end;
-
-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;
- var SavedText: WideString);
-function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- 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: TTntStrings; const Item: WideString; AObject: TObject);
-procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
- Destination: TCustomListControl);
-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);
-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; StartPos: Integer = -1): Integer;
-
-procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
-procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- 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);
-procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
- 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;
-
-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, ComStrs,
- RTLConsts, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
- TntForms, TntGraphics, TntActnList, TntWindows,
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
-
-{ TTntCustomEdit }
-
-procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
-var
- P: TCreateParams;
-begin
- if SysLocale.FarEast
- and (not Win32PlatformIsUnicode)
- and ((Params.Style and ES_READONLY) <> 0) then begin
- // Work around Far East Win95 API/IME bug.
- P := Params;
- P.Style := P.Style and (not ES_READONLY);
- CreateUnicodeHandle(Edit, P, 'EDIT');
- if Edit.HandleAllocated then
- SendMessage(Edit.Handle, EM_SETREADONLY, Ord(True), 0);
- end else
- 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 Win32PlatformIsUnicode then
- Result := Copy(TntControl_GetText(Edit), Edit.SelStart + 1, Edit.SelLength)
- else
- Result := Edit.SelText
-end;
-
-procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
-begin
- if Win32PlatformIsUnicode then
- SendMessageW(Edit.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value)))
- else
- 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;
- 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);
-end;
-
-procedure TTntCustomEdit.SetSelText(const Value: WideString);
-begin
- 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);
-end;
-
-procedure TTntCustomEdit.SetText(const Value: WideString);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntCustomEdit.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomEdit.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomEdit.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomEdit.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntMemoStrings }
-
-constructor TTntMemoStrings.Create;
-begin
- inherited;
- FLineBreakStyle := tlbsCRLF;
-end;
-
-function TTntMemoStrings.GetCount: Integer;
-begin
- Result := FMemoLines.Count;
-end;
-
-function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
-begin
- Assert(Win32PlatformIsUnicode);
- Result := SendMessageW(Handle, EM_LINEINDEX, Index, 0);
-end;
-
-function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
-begin
- Assert(Win32PlatformIsUnicode);
- if StartPos = -1 then
- StartPos := TntMemo_LineStart(Handle, Index);
- if StartPos < 0 then
- Result := 0
- else
- Result := SendMessageW(Handle, EM_LINELENGTH, StartPos, 0);
-end;
-
-function TTntMemoStrings.Get(Index: Integer): WideString;
-var
- Len: Integer;
-begin
- if (not IsWindowUnicode(FMemo.Handle)) then
- Result := FMemoLines[Index]
- else begin
- SetLength(Result, TntMemo_LineLength(FMemo.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(FMemo.Handle, EM_GETLINE, Index, Longint(PWideChar(Result)));
- SetLength(Result, Len);
- end;
- end;
-end;
-
-procedure TTntMemoStrings.Put(Index: Integer; const S: WideString);
-var
- StartPos: Integer;
-begin
- if (not IsWindowUnicode(FMemo.Handle)) then
- FMemoLines[Index] := S
- else begin
- StartPos := TntMemo_LineStart(FMemo.Handle, Index);
- if StartPos >= 0 then
- begin
- SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos + TntMemo_LineLength(FMemo.Handle, Index));
- SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(S)));
- end;
- end;
-end;
-
-procedure TTntMemoStrings.Insert(Index: Integer; const S: Widestring);
-
- function RichEditSelStartW: Integer;
- var
- CharRange: TCharRange;
- begin
- SendMessageW(FMemo.Handle, EM_EXGETSEL, 0, Longint(@CharRange));
- Result := CharRange.cpMin;
- end;
-
-var
- StartPos, LineLen: Integer;
- Line: WideString;
-begin
- if (not IsWindowUnicode(FMemo.Handle)) then
- FMemoLines.Insert(Index, S)
- else begin
- if Index >= 0 then
- begin
- StartPos := TntMemo_LineStart(FMemo.Handle, Index);
- if StartPos >= 0 then
- Line := S + CRLF
- else begin
- StartPos := TntMemo_LineStart(FMemo.Handle, Index - 1);
- LineLen := TntMemo_LineLength(FMemo.Handle, Index - 1);
- if LineLen = 0 then
- Exit;
- Inc(StartPos, LineLen);
- Line := CRLF + s;
- end;
- SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos);
-
- if (FRichEditMode)
- and (FLineBreakStyle <> tlbsCRLF) then begin
- Line := TntAdjustLineBreaks(Line, FLineBreakStyle);
- if Line = CR then
- Line := CRLF; { This helps a ReadOnly RichEdit 4.1 control to insert a blank line. }
- SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
- if Line = CRLF then
- Line := CR;
- end else
- SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
-
- if (FRichEditMode)
- and (RichEditSelStartW <> (StartPos + Length(Line))) then
- raise EOutOfResources.Create(sRichEditInsertError);
- end;
- end;
-end;
-
-procedure TTntMemoStrings.Delete(Index: Integer);
-begin
- FMemoLines.Delete(Index);
-end;
-
-procedure TTntMemoStrings.Clear;
-begin
- FMemoLines.Clear;
-end;
-
-type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
-
-procedure TTntMemoStrings.SetUpdateState(Updating: Boolean);
-begin
- TAccessStrings(FMemoLines).SetUpdateState(Updating);
-end;
-
-function TTntMemoStrings.GetTextStr: WideString;
-begin
- if (not FRichEditMode) then
- Result := TntControl_GetText(FMemo)
- else
- Result := inherited GetTextStr;
-end;
-
-procedure TTntMemoStrings.SetTextStr(const Value: WideString);
-var
- NewText: WideString;
-begin
- NewText := TntAdjustLineBreaks(Value, FLineBreakStyle);
- if NewText <> GetTextStr then begin
- FMemo.HandleNeeded;
- TntControl_SetText(FMemo, NewText);
- end;
-end;
-
-{ TTntCustomMemo }
-
-constructor TTntCustomMemo.Create(AOwner: TComponent);
-begin
- inherited;
- FLines := TTntMemoStrings.Create;
- TTntMemoStrings(FLines).FMemo := Self;
- TTntMemoStrings(FLines).FMemoLines := TCustomMemo{TNT-ALLOW TCustomMemo}(Self).Lines;
-end;
-
-destructor TTntCustomMemo.Destroy;
-begin
- FreeAndNil(FLines);
- inherited;
-end;
-
-procedure TTntCustomMemo.SetLines(const Value: TTntStrings);
-begin
- FLines.Assign(Value);
-end;
-
-procedure TTntCustomMemo.CreateWindowHandle(const Params: TCreateParams);
-begin
- TntCustomEdit_CreateWindowHandle(Self, Params);
-end;
-
-procedure TTntCustomMemo.DefineProperties(Filer: TFiler);
-begin
- inherited;
- 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);
-end;
-
-procedure TTntCustomMemo.SetSelText(const Value: WideString);
-begin
- TntCustomEdit_SetSelText(Self, Value);
-end;
-
-function TTntCustomMemo.GetText: WideString;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntCustomMemo.SetText(const Value: WideString);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntCustomMemo.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self);
-end;
-
-function TTntCustomMemo.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomMemo.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomMemo.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomMemo.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{$IFDEF DELPHI_7} // fix for Delphi 7 only
-function TD7PatchedComboBoxStrings.Get(Index: Integer): string{TNT-ALLOW string};
-var
- Len: Integer;
-begin
- Len := SendMessage(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
- if Len > 0 then
- begin
- SetLength(Result, Len);
- SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PChar{TNT-ALLOW PChar}(Result)));
- end
- else
- SetLength(Result, 0);
-end;
-
-function TD7PatchedComboBoxStrings.Add(const S: string{TNT-ALLOW string}): Integer;
-begin
- Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar{TNT-ALLOW PChar}(S)));
- if Result < 0 then
- raise EOutOfResources.Create(SInsertLineError);
-end;
-
-procedure TD7PatchedComboBoxStrings.Insert(Index: Integer; const S: string{TNT-ALLOW string});
-begin
- if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
- Longint(PChar{TNT-ALLOW PChar}(S))) < 0 then
- raise EOutOfResources.Create(SInsertLineError);
-end;
-{$ENDIF}
-
-{ TTntComboBoxStrings }
-
-function TTntComboBoxStrings.GetCount: Integer;
-begin
- Result := ComboBox.Items.Count;
-end;
-
-function TTntComboBoxStrings.Get(Index: Integer): WideString;
-var
- Len: Integer;
-begin
- if (not IsWindowUnicode(ComboBox.Handle)) then
- Result := ComboBox.Items[Index]
- else begin
- Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
- if Len = CB_ERR then
- Result := ''
- else begin
- SetLength(Result, Len + 1);
- Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PWideChar(Result)));
- if Len = CB_ERR then
- Result := ''
- else
- Result := PWideChar(Result);
- end;
- end;
-end;
-
-function TTntComboBoxStrings.GetObject(Index: Integer): TObject;
-begin
- Result := ComboBox.Items.Objects[Index];
-end;
-
-procedure TTntComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
-begin
- ComboBox.Items.Objects[Index] := AObject;
-end;
-
-function TTntComboBoxStrings.Add(const S: WideString): Integer;
-begin
- if (not IsWindowUnicode(ComboBox.Handle)) then
- Result := ComboBox.Items.Add(S)
- else begin
- Result := SendMessageW(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PWideChar(S)));
- if Result < 0 then
- raise EOutOfResources.Create(SInsertLineError);
- end;
-end;
-
-procedure TTntComboBoxStrings.Insert(Index: Integer; const S: WideString);
-begin
- if (not IsWindowUnicode(ComboBox.Handle)) then
- ComboBox.Items.Insert(Index, S)
- else begin
- if SendMessageW(ComboBox.Handle, CB_INSERTSTRING, Index, Longint(PWideChar(S))) < 0 then
- raise EOutOfResources.Create(SInsertLineError);
- end;
-end;
-
-procedure TTntComboBoxStrings.Delete(Index: Integer);
-begin
- ComboBox.Items.Delete(Index);
-end;
-
-procedure TTntComboBoxStrings.Clear;
-var
- S: WideString;
-begin
- S := TntControl_GetText(ComboBox);
- SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
- TntControl_SetText(ComboBox, S);
- ComboBox.Update;
-end;
-
-procedure TTntComboBoxStrings.SetUpdateState(Updating: Boolean);
-begin
- TAccessStrings(ComboBox.Items).SetUpdateState(Updating);
-end;
-
-function TTntComboBoxStrings.IndexOf(const S: WideString): Integer;
-begin
- if (not IsWindowUnicode(ComboBox.Handle)) then
- Result := ComboBox.Items.IndexOf(S)
- else
- Result := SendMessageW(ComboBox.Handle, CB_FINDSTRINGEXACT, -1, LongInt(PWideChar(S)));
-end;
-
-{ TTntCustomComboBox }
-
-type TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
-
-procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
-begin
- if (not Win32PlatformIsUnicode) then begin
- TAccessCustomComboBox(Combo).Text := PreInheritedAnsiText;
- end else begin
- with TAccessCustomComboBox(Combo) 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));
- end;
- if FSaveItems <> nil then
- begin
- Items.Assign(FSaveItems);
- FreeAndNil(FSaveItems);
- if FSaveItemIndex <> -1 then
- begin
- if Items.Count < FSaveItemIndex then FSaveItemIndex := Items.Count;
- SendMessage(Combo.Handle, CB_SETCURSEL, FSaveItemIndex, 0);
- end;
- end;
- TntControl_SetText(Combo, TntControl_GetStoredText(Combo, TAccessCustomComboBox(Combo).Text));
- end;
-end;
-
-procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
- var SavedText: WideString);
-begin
- Assert(not (csDestroyingHandle in Combo.ControlState));
- if (Win32PlatformIsUnicode) then begin
- SavedText := TntControl_GetText(Combo);
- if (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;
-end;
-
-function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
-
- procedure CallDefaultWindowProc;
- begin
- with Message do begin { call default wnd proc }
- if IsWindowUnicode(ComboWnd) then
- Result := CallWindowProcW(ComboProc, ComboWnd, Msg, WParam, LParam)
- else
- Result := CallWindowProcA(ComboProc, ComboWnd, Msg, WParam, LParam);
- end;
- end;
-
- function DoWideKeyPress(Message: TWMChar): Boolean;
- begin
- DoEditCharMsg(Message);
- Result := (Message.CharCode = 0);
- end;
-
-begin
- Result := False;
- try
- 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
- 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;
- 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 (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
- Application.HandleException(Combo);
- end;
-end;
-
-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;
- TAccessCustomComboBox(Combo).Select;
- 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
- StartPos: Integer;
-begin
- 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;
-begin
- 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);
-begin
- 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 else
- Combo.SelText := Value
-end;
-
-procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
-begin
- SaveAutoComplete := TAccessCustomComboBox(Combo).AutoComplete;
- TAccessCustomComboBox(Combo).AutoComplete := False;
-end;
-
-procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
-begin
- TAccessCustomComboBox(Combo).AutoComplete := SaveAutoComplete;
-end;
-
-procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
-var
- OldSelStart, OldSelLength: Integer;
- OldText: WideString;
-begin
- 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: TTntStrings; const Item: WideString; AObject: TObject);
-begin
- Items.AddObject(Item, AObject);
-end;
-
-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(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- StartPos: Integer; const Text: WideString): Integer;
-var
- ComboFindString: ITntComboFindString;
-begin
- 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(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PAnsiChar(AnsiString(Text))))
-end;
-
-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(Combo, -1, Text);
- if Match_1 <> CB_ERR then begin
- 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}; Items: TTntStrings;
- const SearchText: WideString; UniqueMatchOnly: Boolean; UseDataEntryCase: Boolean): Boolean;
-var
- Idx: Integer;
- ValueChange: Boolean;
-begin
- if UniqueMatchOnly then
- Idx := TntCombo_FindUniqueString(Combo, -1, SearchText)
- else
- Idx := TntCombo_FindString(Combo, -1, SearchText);
- Result := (Idx <> CB_ERR);
- if Result then begin
- if TAccessCustomComboBox(Combo).Style = csDropDown then
- ValueChange := not WideSameStr(TntControl_GetText(Combo), Items[Idx])
- else
- 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 else begin
- TntControl_SetText(Combo, Items[Idx]);
- 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};
- Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
-var
- Key: WideChar;
-begin
- 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;
- end;
- finally
- SetWideCharForWMCharMsg(Message, Key);
- end;
-end;
-
-procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
- Items: TTntStrings; var Message: TWMChar;
- AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
-var
- Key: WideChar;
- FindText: WideString;
-begin
- 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;
- end;
- finally
- SetWideCharForWMCharMsg(Message, Key);
- end;
-end;
-
-//--
-constructor TTntCustomComboBox.Create(AOwner: TComponent);
-begin
- inherited;
- FItems := TTntComboBoxStrings.Create;
- TTntComboBoxStrings(FItems).ComboBox := Self;
-end;
-
-destructor TTntCustomComboBox.Destroy;
-begin
- FreeAndNil(FItems);
- FreeAndNil(FSaveItems);
- inherited;
-end;
-
-procedure TTntCustomComboBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'COMBOBOX');
-end;
-
-procedure TTntCustomComboBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntCustomComboBox.CreateWnd;
-var
- PreInheritedAnsiText: AnsiString;
-begin
- PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
- inherited;
- TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
-end;
-
-procedure TTntCustomComboBox.DestroyWnd;
-var
- SavedText: WideString;
-begin
- if not (csDestroyingHandle in ControlState) then begin { avoid recursion when parent is TToolBar and system font changes. }
- TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex, SavedText);
- inherited;
- TntControl_SetStoredText(Self, SavedText);
- end;
-end;
-
-procedure TTntCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
-begin
- if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
- inherited;
-end;
-
-procedure TTntCustomComboBox.KeyPress(var Key: AnsiChar);
-var
- SaveAutoComplete: Boolean;
-begin
- TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
- try
- inherited;
- finally
- TntCombo_AfterKeyPress(Self, SaveAutoComplete);
- end;
-end;
-
-procedure TTntCustomComboBox.DoEditCharMsg(var Message: TWMChar);
-begin
- TntCombo_AutoCompleteKeyPress(Self, Items, Message,
- GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
-end;
-
-procedure TTntCustomComboBox.WMChar(var Message: TWMChar);
-begin
- TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
- 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
- TntCombo_DefaultDrawItem(Canvas, Index, Rect, State, Items);
-end;
-
-function TTntCustomComboBox.GetItems: TTntStrings;
-begin
- Result := FItems;
-end;
-
-procedure TTntCustomComboBox.SetItems(const Value: TTntStrings);
-begin
- FItems.Assign(Value);
-end;
-
-function TTntCustomComboBox.GetSelStart: Integer;
-begin
- Result := TntCombo_GetSelStart(Self);
-end;
-
-procedure TTntCustomComboBox.SetSelStart(const Value: Integer);
-begin
- TntCombo_SetSelStart(Self, Value);
-end;
-
-function TTntCustomComboBox.GetSelLength: Integer;
-begin
- Result := TntCombo_GetSelLength(Self);
-end;
-
-procedure TTntCustomComboBox.SetSelLength(const Value: Integer);
-begin
- TntCombo_SetSelLength(Self, Value);
-end;
-
-function TTntCustomComboBox.GetSelText: WideString;
-begin
- Result := TntCombo_GetSelText(Self);
-end;
-
-procedure TTntCustomComboBox.SetSelText(const Value: WideString);
-begin
- TntCombo_SetSelText(Self, Value);
-end;
-
-function TTntCustomComboBox.GetText: WideString;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntCustomComboBox.SetText(const Value: WideString);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntCustomComboBox.CNCommand(var Message: TWMCommand);
-begin
- if not TntCombo_CNCommand(Self, Items, Message) then
- inherited;
-end;
-
-function TTntCustomComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
-begin
- Result := True;
-end;
-
-function TTntCustomComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
-begin
- Result := False;
-end;
-
-function TTntCustomComboBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCustomComboBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomComboBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomComboBox.AddItem(const Item: WideString; AObject: TObject);
-begin
- TntComboBox_AddItem(Items, Item, AObject);
-end;
-
-procedure TTntCustomComboBox.CopySelection(Destination: TCustomListControl);
-begin
- TntComboBox_CopySelection(Items, ItemIndex, Destination);
-end;
-
-procedure TTntCustomComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomComboBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{$IFDEF DELPHI_7} // fix for Delphi 7 only
-function TTntCustomComboBox.GetItemsClass: TCustomComboBoxStringsClass;
-begin
- Result := TD7PatchedComboBoxStrings;
-end;
-{$ENDIF}
-
-{ TTntListBoxStrings }
-
-function TTntListBoxStrings.GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
-begin
- Result := TCustomListBox{TNT-ALLOW TCustomListBox}(FListBox);
-end;
-
-procedure TTntListBoxStrings.SetListBox(const Value: TCustomListBox{TNT-ALLOW TCustomListBox});
-begin
- FListBox := TAccessCustomListBox(Value);
-end;
-
-function TTntListBoxStrings.GetCount: Integer;
-begin
- Result := ListBox.Items.Count;
-end;
-
-function TTntListBoxStrings.Get(Index: Integer): WideString;
-var
- Len: Integer;
-begin
- if (not IsWindowUnicode(ListBox.Handle)) then
- Result := ListBox.Items[Index]
- else begin
- Len := SendMessageW(ListBox.Handle, LB_GETTEXTLEN, Index, 0);
- if Len = LB_ERR then
- Error(SListIndexError, Index)
- else begin
- SetLength(Result, Len + 1);
- Len := SendMessageW(ListBox.Handle, LB_GETTEXT, Index, Longint(PWideChar(Result)));
- if Len = LB_ERR then
- Result := ''
- else
- Result := PWideChar(Result);
- end;
- end;
-end;
-
-function TTntListBoxStrings.GetObject(Index: Integer): TObject;
-begin
- Result := ListBox.Items.Objects[Index];
-end;
-
-procedure TTntListBoxStrings.Put(Index: Integer; const S: WideString);
-var
- I: Integer;
- TempData: Longint;
-begin
- I := ListBox.ItemIndex;
- TempData := FListBox.InternalGetItemData(Index);
- // Set the Item to 0 in case it is an object that gets freed during Delete
- FListBox.InternalSetItemData(Index, 0);
- Delete(Index);
- InsertObject(Index, S, nil);
- FListBox.InternalSetItemData(Index, TempData);
- ListBox.ItemIndex := I;
-end;
-
-procedure TTntListBoxStrings.PutObject(Index: Integer; AObject: TObject);
-begin
- ListBox.Items.Objects[Index] := AObject;
-end;
-
-function TTntListBoxStrings.Add(const S: WideString): Integer;
-begin
- if (not IsWindowUnicode(ListBox.Handle)) then
- Result := ListBox.Items.Add(S)
- else begin
- Result := SendMessageW(ListBox.Handle, LB_ADDSTRING, 0, Longint(PWideChar(S)));
- if Result < 0 then
- raise EOutOfResources.Create(SInsertLineError);
- end;
-end;
-
-procedure TTntListBoxStrings.Insert(Index: Integer; const S: WideString);
-begin
- if (not IsWindowUnicode(ListBox.Handle)) then
- ListBox.Items.Insert(Index, S)
- else begin
- if SendMessageW(ListBox.Handle, LB_INSERTSTRING, Index, Longint(PWideChar(S))) < 0 then
- raise EOutOfResources.Create(SInsertLineError);
- end;
-end;
-
-procedure TTntListBoxStrings.Delete(Index: Integer);
-begin
- FListBox.DeleteString(Index);
-end;
-
-procedure TTntListBoxStrings.Exchange(Index1, Index2: Integer);
-var
- TempData: Longint;
- TempString: WideString;
-begin
- BeginUpdate;
- try
- TempString := Strings[Index1];
- TempData := FListBox.InternalGetItemData(Index1);
- Strings[Index1] := Strings[Index2];
- FListBox.InternalSetItemData(Index1, FListBox.InternalGetItemData(Index2));
- Strings[Index2] := TempString;
- FListBox.InternalSetItemData(Index2, TempData);
- if ListBox.ItemIndex = Index1 then
- ListBox.ItemIndex := Index2
- else if ListBox.ItemIndex = Index2 then
- ListBox.ItemIndex := Index1;
- finally
- EndUpdate;
- end;
-end;
-
-procedure TTntListBoxStrings.Clear;
-begin
- FListBox.ResetContent;
-end;
-
-procedure TTntListBoxStrings.SetUpdateState(Updating: Boolean);
-begin
- TAccessStrings(ListBox.Items).SetUpdateState(Updating);
-end;
-
-function TTntListBoxStrings.IndexOf(const S: WideString): Integer;
-begin
- if (not IsWindowUnicode(ListBox.Handle)) then
- Result := ListBox.Items.IndexOf(S)
- else
- Result := SendMessageW(ListBox.Handle, LB_FINDSTRINGEXACT, -1, LongInt(PWideChar(S)));
-end;
-
-procedure TTntListBoxStrings.Move(CurIndex, NewIndex: Integer);
-var
- TempData: Longint;
- TempString: WideString;
-begin
- BeginUpdate;
- FListBox.FMoving := True;
- try
- if CurIndex <> NewIndex then
- begin
- TempString := Get(CurIndex);
- TempData := FListBox.InternalGetItemData(CurIndex);
- FListBox.InternalSetItemData(CurIndex, 0);
- Delete(CurIndex);
- Insert(NewIndex, TempString);
- FListBox.InternalSetItemData(NewIndex, TempData);
- end;
- finally
- FListBox.FMoving := False;
- EndUpdate;
- end;
-end;
-
-//-- list box helper procs
-
-procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
-begin
- if FSaveItems <> nil then
- begin
- FItems.Assign(FSaveItems);
- FreeAndNil(FSaveItems);
- ListBox.TopIndex := FSaveTopIndex;
- ListBox.ItemIndex := FSaveItemIndex;
- end;
-end;
-
-procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
- var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
-begin
- if (FItems.Count > 0)
- and (not (TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw]))
- then begin
- 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: TTntStrings; Index: Integer; Rect: TRect);
-var
- Flags: Integer;
- Canvas: TCanvas;
-begin
- Canvas := TAccessCustomListBox(ListBox).Canvas;
- Canvas.FillRect(Rect);
- if Index < Items.Count then
- begin
- Flags := ListBox.DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
- if not ListBox.UseRightToLeftAlignment then
- Inc(Rect.Left, 2)
- else
- Dec(Rect.Right, 2);
- Tnt_DrawTextW(Canvas.Handle, PWideChar(Items[Index]), Length(Items[Index]), Rect, Flags);
- end;
-end;
-
-procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
-begin
- Items.AddObject(PWideChar(Item), AObject);
-end;
-
-procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
- Items: TTntStrings; Destination: TCustomListControl);
-var
- I: Integer;
-begin
- if ListBox.MultiSelect then
- begin
- for I := 0 to Items.Count - 1 do
- if ListBox.Selected[I] then
- WideListControl_AddItem(Destination, PWideChar(Items[I]), Items.Objects[I]);
- end
- else
- 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
- WStrCopy(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;
-
-{ TTntCustomListBox }
-
-constructor TTntCustomListBox.Create(AOwner: TComponent);
-begin
- inherited;
- FItems := TTntListBoxStrings.Create;
- TTntListBoxStrings(FItems).ListBox := Self;
-end;
-
-destructor TTntCustomListBox.Destroy;
-begin
- FreeAndNil(FItems);
- FreeAndNil(FSaveItems);
- inherited;
-end;
-
-procedure TTntCustomListBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'LISTBOX');
-end;
-
-procedure TTntCustomListBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntCustomListBox.CreateWnd;
-begin
- inherited;
- TntListBox_AfterInherited_CreateWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
-end;
-
-procedure TTntCustomListBox.DestroyWnd;
-begin
- TntListBox_BeforeInherited_DestroyWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
- inherited;
-end;
-
-procedure TTntCustomListBox.SetItems(const Value: TTntStrings);
-begin
- FItems.Assign(Value);
-end;
-
-procedure TTntCustomListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
-begin
- if Assigned(OnDrawItem) then
- OnDrawItem(Self, Index, Rect, State)
- else
- TntListBox_DrawItem_Text(Self, Items, Index, Rect);
-end;
-
-function TTntCustomListBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCustomListBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomListBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomListBox.AddItem(const Item: WideString; AObject: TObject);
-begin
- TntListBox_AddItem(Items, Item, AObject);
-end;
-
-procedure TTntCustomListBox.CopySelection(Destination: TCustomListControl);
-begin
- TntListBox_CopySelection(Self, Items, Destination);
-end;
-
-procedure TTntCustomListBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomListBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-procedure TTntCustomListBox.LBGetText(var Message: TMessage);
-begin
- if not TntCustomListBox_LBGetText(Self, OnData, Message) then
- inherited;
-end;
-
-procedure TTntCustomListBox.LBGetTextLen(var Message: TMessage);
-begin
- if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
- inherited;
-end;
-
-// --- 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;
-{$IFDEF COMPILER_9_UP}
-const
- EllipsisStr = '...';
- Ellipsis: array[TEllipsisPosition] of Longint = (0, DT_PATH_ELLIPSIS,
- DT_END_ELLIPSIS, DT_WORD_ELLIPSIS);
-{$ENDIF}
-var
- Text: WideString;
- ShowAccelChar: Boolean;
- Canvas: TCanvas;
- {$IFDEF COMPILER_9_UP}
- DText: WideString;
- NewRect: TRect;
- Height: Integer;
- Delim: Integer;
- {$ENDIF}
-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;
- {$IFDEF COMPILER_9_UP}
- if (TAccessCustomLabel(Control).EllipsisPosition <> epNone)
- and (not TAccessCustomLabel(Control).AutoSize) then
- begin
- DText := Text;
- Flags := Flags and not (DT_EXPANDTABS or DT_CALCRECT);
- Flags := Flags or Ellipsis[TAccessCustomLabel(Control).EllipsisPosition];
- if TAccessCustomLabel(Control).WordWrap
- and (TAccessCustomLabel(Control).EllipsisPosition in [epEndEllipsis, epWordEllipsis]) then
- begin
- repeat
- NewRect := Rect;
- Dec(NewRect.Right, WideCanvasTextWidth(Canvas, EllipsisStr));
- Tnt_DrawTextW(Canvas.Handle, PWideChar(DText), Length(DText), NewRect, Flags or DT_CALCRECT);
- Height := NewRect.Bottom - NewRect.Top;
- if (Height > TAccessCustomLabel(Control).ClientHeight)
- and (Height > Canvas.Font.Height) then
- begin
- Delim := WideLastDelimiter(' '#9, Text);
- if Delim = 0 then
- Delim := Length(Text);
- Dec(Delim);
- Text := Copy(Text, 1, Delim);
- DText := Text + EllipsisStr;
- if Text = '' then
- Break;
- end else
- Break;
- until False;
- end;
- if Text <> '' then
- Text := DText;
- end;
- {$ENDIF}
- 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
- begin
- SetFocus;
- Message.Result := 1;
- 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)
-end;
-
-function TTntCustomLabel.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self);
-end;
-
-procedure TTntCustomLabel.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntCustomLabel.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntCustomLabel.GetLabelText: WideString;
-begin
- Result := Caption;
-end;
-
-procedure TTntCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
-begin
- if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
- inherited;
-end;
-
-function TTntCustomLabel.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCustomLabel.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomLabel.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomLabel.CMHintShow(var Message: TMessage);
-begin
- ProcessCMHintShowMsg(Message);
- inherited;
-end;
-
-procedure TTntCustomLabel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomLabel.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntButton }
-
-procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
-begin
- with Message do
- if IsWideCharAccel(Message.CharCode, TntControl_GetText(Button))
- and Button.CanFocus then
- begin
- Button.Click;
- Result := 1;
- end else
- Button.Broadcast(Message);
-end;
-
-procedure TTntButton.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'BUTTON');
-end;
-
-procedure TTntButton.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntButton.CMDialogChar(var Message: TCMDialogChar);
-begin
- TntButton_CMDialogChar(Self, Message);
-end;
-
-function TTntButton.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self)
-end;
-
-function TTntButton.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntButton.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntButton.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntButton.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntButton.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntButton.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntCustomCheckBox }
-
-procedure TTntCustomCheckBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'BUTTON');
-end;
-
-procedure TTntCustomCheckBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
-begin
- with Message do
- if IsWideCharAccel(Message.CharCode, Caption)
- and CanFocus then
- begin
- SetFocus;
- if Focused then Toggle;
- Result := 1;
- end else
- Broadcast(Message);
-end;
-
-function TTntCustomCheckBox.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self)
-end;
-
-function TTntCustomCheckBox.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntCustomCheckBox.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntCustomCheckBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCustomCheckBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomCheckBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomCheckBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntRadioButton }
-
-procedure TTntRadioButton.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'BUTTON');
-end;
-
-procedure TTntRadioButton.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntRadioButton.CMDialogChar(var Message: TCMDialogChar);
-begin
- with Message do
- if IsWideCharAccel(Message.CharCode, Caption)
- and CanFocus then
- begin
- SetFocus;
- Result := 1;
- end else
- Broadcast(Message);
-end;
-
-function TTntRadioButton.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self);
-end;
-
-function TTntRadioButton.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntRadioButton.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntRadioButton.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntRadioButton.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntRadioButton.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntRadioButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntRadioButton.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntScrollBar }
-
-procedure TTntScrollBar.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'SCROLLBAR');
-end;
-
-procedure TTntScrollBar.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-function TTntScrollBar.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntScrollBar.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntScrollBar.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntScrollBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntScrollBar.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntCustomGroupBox }
-
-procedure TTntCustomGroupBox.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, '');
-end;
-
-procedure TTntCustomGroupBox.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
-begin
- with Message do
- if IsWideCharAccel(Message.CharCode, Caption)
- and CanFocus then
- begin
- SelectFirst;
- Result := 1;
- end else
- Broadcast(Message);
-end;
-
-function TTntCustomGroupBox.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self);
-end;
-
-function TTntCustomGroupBox.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntCustomGroupBox.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-procedure TTntCustomGroupBox.Paint;
-
- {$IFDEF THEME_7_UP}
- procedure PaintThemedGroupBox;
- var
- CaptionRect: TRect;
- OuterRect: TRect;
- Size: TSize;
- Box: TThemedButton;
- Details: TThemedElementDetails;
- begin
- with Canvas do begin
- if Caption <> '' then
- begin
- GetTextExtentPoint32W(Handle, PWideChar(Caption), Length(Caption), Size);
- CaptionRect := Rect(0, 0, Size.cx, Size.cy);
- if not UseRightToLeftAlignment then
- OffsetRect(CaptionRect, 8, 0)
- else
- OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
- end
- else
- CaptionRect := Rect(0, 0, 0, 0);
-
- OuterRect := ClientRect;
- OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
- with CaptionRect do
- ExcludeClipRect(Handle, Left, Top, Right, Bottom);
- if Enabled then
- Box := tbGroupBoxNormal
- else
- Box := tbGroupBoxDisabled;
- Details := ThemeServices.GetElementDetails(Box);
- ThemeServices.DrawElement(Handle, Details, OuterRect);
-
- SelectClipRgn(Handle, 0);
- if Text <> '' then
- ThemeServices.DrawText{TNT-ALLOW DrawText}(Handle, Details, Caption, CaptionRect, DT_LEFT, 0);
- end;
- end;
- {$ENDIF}
-
- procedure PaintGroupBox;
- var
- H: Integer;
- R: TRect;
- Flags: Longint;
- begin
- with Canvas do begin
- H := WideCanvasTextHeight(Canvas, '0');
- R := Rect(0, H div 2 - 1, Width, Height);
- if Ctl3D then
- begin
- Inc(R.Left);
- Inc(R.Top);
- Brush.Color := clBtnHighlight;
- FrameRect(R);
- OffsetRect(R, -1, -1);
- Brush.Color := clBtnShadow;
- end else
- Brush.Color := clWindowFrame;
- FrameRect(R);
- if Caption <> '' then
- begin
- if not UseRightToLeftAlignment then
- R := Rect(8, 0, 0, H)
- else
- R := Rect(R.Right - WideCanvasTextWidth(Canvas, Caption) - 8, 0, 0, H);
- Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
- Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags or DT_CALCRECT);
- Brush.Color := Color;
- Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags);
- end;
- end;
- end;
-
-begin
- if (not Win32PlatformIsUnicode) then
- inherited
- else
- begin
- Canvas.Font := Self.Font;
- {$IFDEF THEME_7_UP}
- if ThemeServices.ThemesEnabled then
- PaintThemedGroupBox
- else
- PaintGroupBox;
- {$ELSE}
- PaintGroupBox;
- {$ENDIF}
- end;
-end;
-
-function TTntCustomGroupBox.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCustomGroupBox.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self);
-end;
-
-procedure TTntCustomGroupBox.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomGroupBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomGroupBox.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-{ TTntCustomStaticText }
-
-constructor TTntCustomStaticText.Create(AOwner: TComponent);
-begin
- inherited;
- AdjustBounds;
-end;
-
-procedure TTntCustomStaticText.CMFontChanged(var Message: TMessage);
-begin
- inherited;
- AdjustBounds;
-end;
-
-procedure TTntCustomStaticText.CMTextChanged(var Message: TMessage);
-begin
- inherited;
- AdjustBounds;
-end;
-
-procedure TTntCustomStaticText.Loaded;
-begin
- inherited;
- AdjustBounds;
-end;
-
-procedure TTntCustomStaticText.SetAutoSize(AValue: boolean);
-begin
- inherited;
- if AValue then
- AdjustBounds;
-end;
-
-procedure TTntCustomStaticText.CreateWindowHandle(const Params: TCreateParams);
-begin
- CreateUnicodeHandle(Self, Params, 'STATIC');
-end;
-
-procedure TTntCustomStaticText.DefineProperties(Filer: TFiler);
-begin
- inherited;
- TntPersistent_AfterInherited_DefineProperties(Filer, Self);
-end;
-
-procedure TTntCustomStaticText.CMDialogChar(var Message: TCMDialogChar);
-begin
- if (FocusControl <> nil) and Enabled and ShowAccelChar and
- IsWideCharAccel(Message.CharCode, Caption) then
- with FocusControl do
- if CanFocus then
- begin
- SetFocus;
- Message.Result := 1;
- end;
-end;
-
-function TTntCustomStaticText.IsCaptionStored: Boolean;
-begin
- Result := TntControl_IsCaptionStored(Self)
-end;
-
-procedure TTntCustomStaticText.AdjustBounds;
-var
- DC: HDC;
- SaveFont: HFont;
- TextSize: TSize;
-begin
- if not (csReading in ComponentState) and AutoSize then
- begin
- DC := GetDC(0);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextExtentPoint32W(DC, PWideChar(Caption), Length(Caption), TextSize);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
- SetBounds(Left, Top,
- TextSize.cx + (GetSystemMetrics(SM_CXBORDER) * 4),
- TextSize.cy + (GetSystemMetrics(SM_CYBORDER) * 4));
- end;
-end;
-
-function TTntCustomStaticText.GetCaption: TWideCaption;
-begin
- Result := TntControl_GetText(Self)
-end;
-
-procedure TTntCustomStaticText.SetCaption(const Value: TWideCaption);
-begin
- TntControl_SetText(Self, Value);
-end;
-
-function TTntCustomStaticText.IsHintStored: Boolean;
-begin
- Result := TntControl_IsHintStored(Self)
-end;
-
-function TTntCustomStaticText.GetHint: WideString;
-begin
- Result := TntControl_GetHint(Self)
-end;
-
-procedure TTntCustomStaticText.SetHint(const Value: WideString);
-begin
- TntControl_SetHint(Self, Value);
-end;
-
-procedure TTntCustomStaticText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
- inherited;
-end;
-
-function TTntCustomStaticText.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
-end;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntSysUtils.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntSysUtils.pas deleted file mode 100644 index f6cd3e2ebb..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntSysUtils.pas +++ /dev/null @@ -1,1699 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntSysUtils;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: Consider: more filename functions from SysUtils }
-{ TODO: Consider: string functions from StrUtils. }
-
-uses
- Types, SysUtils, Windows;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Types
-//---------------------------------------------------------------------------------------------
-
-// ......... introduced .........
-type
- // The user of the application did something plainly wrong.
- ETntUserError = class(Exception);
- // A general error occured. (ie. file didn't exist, server didn't return data, etc.)
- ETntGeneralError = class(Exception);
- // Like Assert(). An error occured that should never have happened, send me a bug report now!
- ETntInternalError = class(Exception);
-
-//---------------------------------------------------------------------------------------------
-// Tnt - SysUtils
-//---------------------------------------------------------------------------------------------
-
-// ......... SBCS and MBCS functions with WideString replacements in SysUtils.pas .........
-
-{TNT-WARN CompareStr} {TNT-WARN AnsiCompareStr}
-{TNT-WARN SameStr} {TNT-WARN AnsiSameStr}
-{TNT-WARN SameText} {TNT-WARN AnsiSameText}
-{TNT-WARN CompareText} {TNT-WARN AnsiCompareText}
-{TNT-WARN UpperCase} {TNT-WARN AnsiUpperCase}
-{TNT-WARN LowerCase} {TNT-WARN AnsiLowerCase}
-
-{TNT-WARN AnsiPos} { --> Pos() supports WideString. }
-{TNT-WARN FmtStr}
-{TNT-WARN Format}
-{TNT-WARN FormatBuf}
-
-// ......... MBCS Byte Type Procs .........
-
-{TNT-WARN ByteType}
-{TNT-WARN StrByteType}
-{TNT-WARN ByteToCharIndex}
-{TNT-WARN ByteToCharLen}
-{TNT-WARN CharToByteIndex}
-{TNT-WARN CharToByteLen}
-
-// ........ null-terminated string functions .........
-
-{TNT-WARN StrEnd}
-{TNT-WARN StrLen}
-{TNT-WARN StrLCopy}
-{TNT-WARN StrCopy}
-{TNT-WARN StrECopy}
-{TNT-WARN StrPLCopy}
-{TNT-WARN StrPCopy}
-{TNT-WARN StrLComp}
-{TNT-WARN AnsiStrLComp}
-{TNT-WARN StrComp}
-{TNT-WARN AnsiStrComp}
-{TNT-WARN StrLIComp}
-{TNT-WARN AnsiStrLIComp}
-{TNT-WARN StrIComp}
-{TNT-WARN AnsiStrIComp}
-{TNT-WARN StrLower}
-{TNT-WARN AnsiStrLower}
-{TNT-WARN StrUpper}
-{TNT-WARN AnsiStrUpper}
-{TNT-WARN StrPos}
-{TNT-WARN AnsiStrPos}
-{TNT-WARN StrScan}
-{TNT-WARN AnsiStrScan}
-{TNT-WARN StrRScan}
-{TNT-WARN AnsiStrRScan}
-{TNT-WARN StrLCat}
-{TNT-WARN StrCat}
-{TNT-WARN StrMove}
-{TNT-WARN StrPas}
-{TNT-WARN StrAlloc}
-{TNT-WARN StrBufSize}
-{TNT-WARN StrNew}
-{TNT-WARN StrDispose}
-
-{TNT-WARN AnsiExtractQuotedStr}
-{TNT-WARN AnsiLastChar}
-{TNT-WARN AnsiStrLastChar}
-{TNT-WARN QuotedStr}
-{TNT-WARN AnsiQuotedStr}
-{TNT-WARN AnsiDequotedStr}
-
-// ........ string functions .........
-
-{$IFNDEF COMPILER_9_UP}
- //
- // pre-Delphi 9 issues w/ WideFormatBuf, WideFmtStr and WideFormat
- //
-
- {$IFDEF COMPILER_7_UP}
- type
- PFormatSettings = ^TFormatSettings;
- {$ENDIF}
-
- // SysUtils.WideFormatBuf doesn't correctly handle numeric specifiers.
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const): Cardinal; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const;
- const FormatSettings: TFormatSettings): Cardinal; overload;
- {$ENDIF}
-
- // SysUtils.WideFmtStr doesn't handle string lengths > 4096.
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const); {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
-
- {$IFDEF COMPILER_7_UP}
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const; const FormatSettings: TFormatSettings); overload;
- {$ENDIF}
-
- {----------------------------------------------------------------------------------------
- Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
- TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
- will fix WideFormat as well as WideFmtStr.
- ----------------------------------------------------------------------------------------}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
- const FormatSettings: TFormatSettings): WideString; overload;
- {$ENDIF}
-
-{$ENDIF}
-
-{TNT-WARN WideUpperCase} // SysUtils.WideUpperCase is broken on Win9x for D6, D7, D9.
-function Tnt_WideUpperCase(const S: WideString): WideString;
-{TNT-WARN WideLowerCase} // SysUtils.WideLowerCase is broken on Win9x for D6, D7, D9.
-function Tnt_WideLowerCase(const S: WideString): WideString;
-
-function TntWideLastChar(const S: WideString): WideChar;
-
-{TNT-WARN StringReplace}
-{TNT-WARN WideStringReplace} // <-- WideStrUtils.WideStringReplace uses SysUtils.WideUpperCase which is broken on Win9x.
-function Tnt_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;
-
-// ........ filename manipulation .........
-
-{TNT-WARN SameFileName} // doesn't apply to Unicode filenames, use WideSameText
-{TNT-WARN AnsiCompareFileName} // doesn't apply to Unicode filenames, use WideCompareText
-{TNT-WARN AnsiLowerCaseFileName} // doesn't apply to Unicode filenames, use WideLowerCase
-{TNT-WARN AnsiUpperCaseFileName} // doesn't apply to Unicode filenames, use WideUpperCase
-
-{TNT-WARN IncludeTrailingBackslash}
-function WideIncludeTrailingBackslash(const S: WideString): WideString;
-{TNT-WARN IncludeTrailingPathDelimiter}
-function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
-{TNT-WARN ExcludeTrailingBackslash}
-function WideExcludeTrailingBackslash(const S: WideString): WideString;
-{TNT-WARN ExcludeTrailingPathDelimiter}
-function WideExcludeTrailingPathDelimiter(const S: WideString): WideString;
-{TNT-WARN IsDelimiter}
-function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
-{TNT-WARN IsPathDelimiter}
-function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
-{TNT-WARN LastDelimiter}
-function WideLastDelimiter(const Delimiters, S: WideString): Integer;
-{TNT-WARN ChangeFileExt}
-function WideChangeFileExt(const FileName, Extension: WideString): WideString;
-{TNT-WARN ExtractFilePath}
-function WideExtractFilePath(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileDir}
-function WideExtractFileDir(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileDrive}
-function WideExtractFileDrive(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileName}
-function WideExtractFileName(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileExt}
-function WideExtractFileExt(const FileName: WideString): WideString;
-{TNT-WARN ExtractRelativePath}
-function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
-
-// ........ file management routines .........
-
-{TNT-WARN ExpandFileName}
-function WideExpandFileName(const FileName: WideString): WideString;
-{TNT-WARN ExtractShortPathName}
-function WideExtractShortPathName(const FileName: WideString): WideString;
-{TNT-WARN FileCreate}
-function WideFileCreate(const FileName: WideString): Integer;
-{TNT-WARN FileOpen}
-function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
-{TNT-WARN FileAge}
-function WideFileAge(const FileName: WideString): Integer; overload;
-function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean; overload;
-{TNT-WARN DirectoryExists}
-function WideDirectoryExists(const Name: WideString): Boolean;
-{TNT-WARN FileExists}
-function WideFileExists(const Name: WideString): Boolean;
-{TNT-WARN FileGetAttr}
-function WideFileGetAttr(const FileName: WideString): Cardinal;
-{TNT-WARN FileSetAttr}
-function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
-{TNT-WARN FileIsReadOnly}
-function WideFileIsReadOnly(const FileName: WideString): Boolean;
-{TNT-WARN FileSetReadOnly}
-function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
-{TNT-WARN ForceDirectories}
-function WideForceDirectories(Dir: WideString): Boolean;
-{TNT-WARN FileSearch}
-function WideFileSearch(const Name, DirList: WideString): WideString;
-{TNT-WARN RenameFile}
-function WideRenameFile(const OldName, NewName: WideString): Boolean;
-{TNT-WARN DeleteFile}
-function WideDeleteFile(const FileName: WideString): Boolean;
-{TNT-WARN CopyFile}
-function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
-
-
-{TNT-WARN TFileName}
-type
- TWideFileName = type WideString;
-
-{TNT-WARN TSearchRec} // <-- FindFile - warning on TSearchRec is all that is necessary
-type
- TSearchRecW = record
- Time: Integer;
- Size: Int64;
- Attr: Integer;
- Name: TWideFileName;
- ExcludeAttr: Integer;
- FindHandle: THandle;
- FindData: TWin32FindDataW;
- end;
-function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
-function WideFindNext(var F: TSearchRecW): Integer;
-procedure WideFindClose(var F: TSearchRecW);
-
-{TNT-WARN CreateDir}
-function WideCreateDir(const Dir: WideString): Boolean;
-{TNT-WARN RemoveDir}
-function WideRemoveDir(const Dir: WideString): Boolean;
-{TNT-WARN GetCurrentDir}
-function WideGetCurrentDir: WideString;
-{TNT-WARN SetCurrentDir}
-function WideSetCurrentDir(const Dir: WideString): Boolean;
-
-
-// ........ date/time functions .........
-
-{TNT-WARN TryStrToDateTime}
-function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
-{TNT-WARN TryStrToDate}
-function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
-{TNT-WARN TryStrToTime}
-function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;
-
-{ introduced }
-function ValidDateTimeStr(Str: WideString): Boolean;
-function ValidDateStr(Str: WideString): Boolean;
-function ValidTimeStr(Str: WideString): Boolean;
-
-{TNT-WARN StrToDateTime}
-function TntStrToDateTime(Str: WideString): TDateTime;
-{TNT-WARN StrToDate}
-function TntStrToDate(Str: WideString): TDateTime;
-{TNT-WARN StrToTime}
-function TntStrToTime(Str: WideString): TDateTime;
-{TNT-WARN StrToDateTimeDef}
-function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-{TNT-WARN StrToDateDef}
-function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
-{TNT-WARN StrToTimeDef}
-function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-
-{TNT-WARN CurrToStr}
-{TNT-WARN CurrToStrF}
-function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
-{TNT-WARN StrToCurr}
-function TntStrToCurr(const S: WideString): Currency;
-{TNT-WARN StrToCurrDef}
-function ValidCurrencyStr(const S: WideString): Boolean;
-function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
-function GetDefaultCurrencyFmt: TCurrencyFmtW;
-
-// ........ misc functions .........
-
-{TNT-WARN GetLocaleStr}
-function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
-{TNT-WARN SysErrorMessage}
-function WideSysErrorMessage(ErrorCode: Integer): WideString;
-
-// ......... introduced .........
-
-function WideLibraryErrorMessage(const LibName: WideString; Dll: THandle; ErrorCode: Integer): WideString;
-
-const
- CR = WideChar(#13);
- LF = WideChar(#10);
- CRLF = WideString(#13#10);
- WideLineSeparator = WideChar($2028);
-
-var
- Win32PlatformIsUnicode: Boolean;
- Win32PlatformIsXP: Boolean;
- Win32PlatformIs2003: Boolean;
- Win32PlatformIsVista: Boolean;
-
-{$IFNDEF COMPILER_7_UP}
-function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
-{$ENDIF}
-function WinCheckH(RetVal: Cardinal): Cardinal;
-function WinCheckFileH(RetVal: Cardinal): Cardinal;
-function WinCheckP(RetVal: Pointer): Pointer;
-
-function WideGetModuleFileName(Instance: HModule): WideString;
-function WideSafeLoadLibrary(const Filename: Widestring;
- ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE;
-function WideLoadPackage(const Name: Widestring): HMODULE;
-
-function IsWideCharUpper(WC: WideChar): Boolean;
-function IsWideCharLower(WC: WideChar): Boolean;
-function IsWideCharDigit(WC: WideChar): Boolean;
-function IsWideCharSpace(WC: WideChar): Boolean;
-function IsWideCharPunct(WC: WideChar): Boolean;
-function IsWideCharCntrl(WC: WideChar): Boolean;
-function IsWideCharBlank(WC: WideChar): Boolean;
-function IsWideCharXDigit(WC: WideChar): Boolean;
-function IsWideCharAlpha(WC: WideChar): Boolean;
-function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
-
-function WideTextPos(const SubStr, S: WideString): Integer;
-
-function ExtractStringArrayStr(P: PWideChar): WideString;
-function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
-function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;
-
-function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
-function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
-function IsRTF(const Value: WideString): Boolean;
-
-function ENG_US_FloatToStr(Value: Extended): WideString;
-function ENG_US_StrToFloat(const S: WideString): Extended;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Variants
-//---------------------------------------------------------------------------------------------
-
-// ........ Variants.pas has WideString versions of these functions .........
-{TNT-WARN VarToStr}
-{TNT-WARN VarToStrDef}
-
-var
- _SettingChangeTime: Cardinal;
-
-implementation
-
-uses
- ActiveX, ComObj, SysConst,
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils,
- TntSystem, TntWindows, TntFormatStrUtils;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - SysUtils
-//---------------------------------------------------------------------------------------------
-
-{$IFNDEF COMPILER_9_UP}
-
- function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const
- {$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings {$ENDIF}): Cardinal;
- var
- OldFormat: WideString;
- NewFormat: WideString;
- begin
- SetString(OldFormat, PWideChar(@FormatStr), FmtLen);
- { The reason for this is that WideFormat doesn't correctly format floating point specifiers.
- See QC#4254. }
- NewFormat := ReplaceFloatingArgumentsInFormatString(OldFormat, Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
- {$IFDEF COMPILER_7_UP}
- if FormatSettings <> nil then
- Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
- Length(NewFormat), Args, FormatSettings^)
- else
- {$ENDIF}
- Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
- Length(NewFormat), Args);
- end;
-
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const): Cardinal;
- begin
- Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
- end;
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
- begin
- Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args, @FormatSettings);
- end;
- {$ENDIF}
-
- procedure _Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const{$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings{$ENDIF});
- var
- Len, BufLen: Integer;
- Buffer: array[0..4095] of WideChar;
- begin
- BufLen := Length(Buffer); // Fixes buffer overwrite issue. (See QC #4703, #4744)
- if Length(FormatStr) < (Length(Buffer) - (Length(Buffer) div 4)) then
- Len := _Tnt_WideFormatBuf(Buffer, Length(Buffer) - 1, Pointer(FormatStr)^,
- Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF})
- else
- begin
- BufLen := Length(FormatStr);
- Len := BufLen;
- end;
- if Len >= BufLen - 1 then
- begin
- while Len >= BufLen - 1 do
- begin
- Inc(BufLen, BufLen);
- Result := ''; // prevent copying of existing data, for speed
- SetLength(Result, BufLen);
- Len := _Tnt_WideFormatBuf(Pointer(Result)^, BufLen - 1, Pointer(FormatStr)^,
- Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
- end;
- SetLength(Result, Len);
- end
- else
- SetString(Result, Buffer, Len);
- end;
-
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const);
- begin
- _Tnt_WideFmtStr(Result, FormatStr, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
- end;
-
- {$IFDEF COMPILER_7_UP}
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const; const FormatSettings: TFormatSettings);
- begin
- _Tnt_WideFmtStr(Result, FormatStr, Args, @FormatSettings);
- end;
- {$ENDIF}
-
- {----------------------------------------------------------------------------------------
- Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
- TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
- will fix WideFormat as well as WideFmtStr.
- ----------------------------------------------------------------------------------------}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
- begin
- Tnt_WideFmtStr(Result, FormatStr, Args);
- end;
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
- const FormatSettings: TFormatSettings): WideString;
- begin
- Tnt_WideFmtStr(Result, FormatStr, Args, FormatSettings);
- end;
- {$ENDIF}
-
-{$ENDIF}
-
-function Tnt_WideUpperCase(const S: WideString): WideString;
-begin
- {$IFNDEF COMPILER_10_UP}
- { SysUtils.WideUpperCase is broken for Win9x. }
- Result := S;
- if Length(Result) > 0 then
- Tnt_CharUpperBuffW(PWideChar(Result), Length(Result));
- {$ELSE}
- Result := SysUtils.WideUpperCase{TNT-ALLOW WideUpperCase}(S);
- {$ENDIF}
-end;
-
-function Tnt_WideLowerCase(const S: WideString): WideString;
-begin
- {$IFNDEF COMPILER_10_UP}
- { SysUtils.WideLowerCase is broken for Win9x. }
- Result := S;
- if Length(Result) > 0 then
- Tnt_CharLowerBuffW(PWideChar(Result), Length(Result));
- {$ELSE}
- Result := SysUtils.WideLowerCase{TNT-ALLOW WideLowerCase}(S);
- {$ENDIF}
-end;
-
-function TntWideLastChar(const S: WideString): WideChar;
-var
- P: PWideChar;
-begin
- P := WideLastChar(S);
- if P = nil then
- Result := #0
- else
- Result := P^;
-end;
-
-function Tnt_WideStringReplace(const S, OldPattern, NewPattern: WideString;
- Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;
-
- function IsWordSeparator(WC: WideChar): Boolean;
- begin
- Result := (WC = WideChar(#0))
- or IsWideCharSpace(WC)
- or IsWideCharPunct(WC);
- end;
-
-var
- SearchStr, Patt, NewStr: WideString;
- Offset: Integer;
- PrevChar, NextChar: WideChar;
-begin
- if rfIgnoreCase in Flags then
- begin
- SearchStr := Tnt_WideUpperCase(S);
- Patt := Tnt_WideUpperCase(OldPattern);
- end else
- begin
- SearchStr := S;
- Patt := OldPattern;
- end;
- NewStr := S;
- Result := '';
- while SearchStr <> '' do
- begin
- Offset := Pos(Patt, SearchStr);
- if Offset = 0 then
- begin
- Result := Result + NewStr;
- Break;
- end; // done
-
- if (WholeWord) then
- begin
- if (Offset = 1) then
- PrevChar := TntWideLastChar(Result)
- else
- PrevChar := NewStr[Offset - 1];
-
- if Offset + Length(OldPattern) <= Length(NewStr) then
- NextChar := NewStr[Offset + Length(OldPattern)]
- else
- NextChar := WideChar(#0);
-
- if (not IsWordSeparator(PrevChar))
- or (not IsWordSeparator(NextChar)) then
- begin
- Result := Result + Copy(NewStr, 1, Offset + Length(OldPattern) - 1);
- NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
- SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
- continue;
- end;
- end;
-
- Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
- NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
- if not (rfReplaceAll in Flags) then
- begin
- Result := Result + NewStr;
- Break;
- end;
- SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
- end;
-end;
-
-function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
-var
- Source, SourceEnd: PWideChar;
-begin
- Source := Pointer(S);
- SourceEnd := Source + Length(S);
- Result := Length(S);
- while Source < SourceEnd do
- begin
- case Source^ of
- #10, WideLineSeparator:
- if Style = tlbsCRLF then
- Inc(Result);
- #13:
- if Style = tlbsCRLF then
- if Source[1] = #10 then
- Inc(Source)
- else
- Inc(Result)
- else
- if Source[1] = #10 then
- Dec(Result);
- end;
- Inc(Source);
- end;
-end;
-
-function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
-var
- Source, SourceEnd, Dest: PWideChar;
- DestLen: Integer;
-begin
- Source := Pointer(S);
- SourceEnd := Source + Length(S);
- DestLen := TntAdjustLineBreaksLength(S, Style);
- SetString(Result, nil, DestLen);
- Dest := Pointer(Result);
- while Source < SourceEnd do begin
- case Source^ of
- #10, WideLineSeparator:
- begin
- if Style in [tlbsCRLF, tlbsCR] then
- begin
- Dest^ := #13;
- Inc(Dest);
- end;
- if Style in [tlbsCRLF, tlbsLF] then
- begin
- Dest^ := #10;
- Inc(Dest);
- end;
- Inc(Source);
- end;
- #13:
- begin
- if Style in [tlbsCRLF, tlbsCR] then
- begin
- Dest^ := #13;
- Inc(Dest);
- end;
- if Style in [tlbsCRLF, tlbsLF] then
- begin
- Dest^ := #10;
- Inc(Dest);
- end;
- Inc(Source);
- if Source^ = #10 then Inc(Source);
- end;
- else
- Dest^ := Source^;
- Inc(Dest);
- Inc(Source);
- end;
- end;
-end;
-
-function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
- MaxCol: Integer): WideString;
-
- function WideCharIn(C: WideChar; SysCharSet: TSysCharSet): Boolean;
- begin
- Result := (C <= High(AnsiChar)) and (AnsiChar(C) in SysCharSet);
- end;
-
-const
- QuoteChars = ['''', '"'];
-var
- Col, Pos: Integer;
- LinePos, LineLen: Integer;
- BreakLen, BreakPos: Integer;
- QuoteChar, CurChar: WideChar;
- ExistingBreak: Boolean;
-begin
- Col := 1;
- Pos := 1;
- LinePos := 1;
- BreakPos := 0;
- QuoteChar := ' ';
- ExistingBreak := False;
- LineLen := Length(Line);
- BreakLen := Length(BreakStr);
- Result := '';
- while Pos <= LineLen do
- begin
- CurChar := Line[Pos];
- if CurChar = BreakStr[1] then
- begin
- if QuoteChar = ' ' then
- begin
- ExistingBreak := WideSameText(BreakStr, Copy(Line, Pos, BreakLen));
- if ExistingBreak then
- begin
- Inc(Pos, BreakLen-1);
- BreakPos := Pos;
- end;
- end
- end
- else if WideCharIn(CurChar, BreakChars) then
- begin
- if QuoteChar = ' ' then BreakPos := Pos
- end
- else if WideCharIn(CurChar, QuoteChars) then
- begin
- if CurChar = QuoteChar then
- QuoteChar := ' '
- else if QuoteChar = ' ' then
- QuoteChar := CurChar;
- end;
- Inc(Pos);
- Inc(Col);
- if not (WideCharIn(QuoteChar, QuoteChars)) and (ExistingBreak or
- ((Col > MaxCol) and (BreakPos > LinePos))) then
- begin
- Col := Pos - BreakPos;
- Result := Result + Copy(Line, LinePos, BreakPos - LinePos + 1);
- if not (WideCharIn(CurChar, QuoteChars)) then
- while Pos <= LineLen do
- begin
- if WideCharIn(Line[Pos], BreakChars) then
- Inc(Pos)
- else if Copy(Line, Pos, Length(sLineBreak)) = sLineBreak then
- Inc(Pos, Length(sLineBreak))
- else
- break;
- end;
- if not ExistingBreak and (Pos < LineLen) then
- Result := Result + BreakStr;
- Inc(BreakPos);
- LinePos := BreakPos;
- ExistingBreak := False;
- end;
- end;
- Result := Result + Copy(Line, LinePos, MaxInt);
-end;
-
-function WideWrapText(const Line: WideString; MaxCol: Integer): WideString;
-begin
- Result := WideWrapText(Line, sLineBreak, [' ', '-', #9], MaxCol); { do not localize }
-end;
-
-function WideIncludeTrailingBackslash(const S: WideString): WideString;
-begin
- Result := WideIncludeTrailingPathDelimiter(S);
-end;
-
-function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
-begin
- Result := S;
- if not WideIsPathDelimiter(Result, Length(Result)) then Result := Result + PathDelim;
-end;
-
-function WideExcludeTrailingBackslash(const S: WideString): WideString;
-begin
- Result := WideExcludeTrailingPathDelimiter(S);
-end;
-
-function WideExcludeTrailingPathDelimiter(const S: WideString): WideString;
-begin
- Result := S;
- if WideIsPathDelimiter(Result, Length(Result)) then
- SetLength(Result, Length(Result)-1);
-end;
-
-function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
-begin
- Result := False;
- if (Index <= 0) or (Index > Length(S)) then exit;
- Result := WStrScan(PWideChar(Delimiters), S[Index]) <> nil;
-end;
-
-function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
-begin
- Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = PathDelim);
-end;
-
-function WideLastDelimiter(const Delimiters, S: WideString): Integer;
-var
- P: PWideChar;
-begin
- Result := Length(S);
- P := PWideChar(Delimiters);
- while Result > 0 do
- begin
- if (S[Result] <> #0) and (WStrScan(P, S[Result]) <> nil) then
- Exit;
- Dec(Result);
- end;
-end;
-
-function WideChangeFileExt(const FileName, Extension: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('.\:',Filename);
- if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
- Result := Copy(FileName, 1, I - 1) + Extension;
-end;
-
-function WideExtractFilePath(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('\:', FileName);
- Result := Copy(FileName, 1, I);
-end;
-
-function WideExtractFileDir(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter(DriveDelim + PathDelim,Filename);
- if (I > 1) and (FileName[I] = PathDelim) and
- (not (FileName[I - 1] in [WideChar(PathDelim), WideChar(DriveDelim)])) then Dec(I);
- Result := Copy(FileName, 1, I);
-end;
-
-function WideExtractFileDrive(const FileName: WideString): WideString;
-var
- I, J: Integer;
-begin
- if (Length(FileName) >= 2) and (FileName[2] = DriveDelim) then
- Result := Copy(FileName, 1, 2)
- else if (Length(FileName) >= 2) and (FileName[1] = PathDelim) and
- (FileName[2] = PathDelim) then
- begin
- J := 0;
- I := 3;
- While (I < Length(FileName)) and (J < 2) do
- begin
- if FileName[I] = PathDelim then Inc(J);
- if J < 2 then Inc(I);
- end;
- if FileName[I] = PathDelim then Dec(I);
- Result := Copy(FileName, 1, I);
- end else Result := '';
-end;
-
-function WideExtractFileName(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('\:', FileName);
- Result := Copy(FileName, I + 1, MaxInt);
-end;
-
-function WideExtractFileExt(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('.\:', FileName);
- if (I > 0) and (FileName[I] = '.') then
- Result := Copy(FileName, I, MaxInt) else
- Result := '';
-end;
-
-function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
-var
- BasePath, DestPath: WideString;
- BaseLead, DestLead: PWideChar;
- BasePtr, DestPtr: PWideChar;
-
- function WideExtractFilePathNoDrive(const FileName: WideString): WideString;
- begin
- Result := WideExtractFilePath(FileName);
- Delete(Result, 1, Length(WideExtractFileDrive(FileName)));
- end;
-
- function Next(var Lead: PWideChar): PWideChar;
- begin
- Result := Lead;
- if Result = nil then Exit;
- Lead := WStrScan(Lead, PathDelim);
- if Lead <> nil then
- begin
- Lead^ := #0;
- Inc(Lead);
- end;
- end;
-
-begin
- if WideSameText(WideExtractFileDrive(BaseName), WideExtractFileDrive(DestName)) then
- begin
- BasePath := WideExtractFilePathNoDrive(BaseName);
- DestPath := WideExtractFilePathNoDrive(DestName);
- BaseLead := Pointer(BasePath);
- BasePtr := Next(BaseLead);
- DestLead := Pointer(DestPath);
- DestPtr := Next(DestLead);
- while (BasePtr <> nil) and (DestPtr <> nil) and WideSameText(BasePtr, DestPtr) do
- begin
- BasePtr := Next(BaseLead);
- DestPtr := Next(DestLead);
- end;
- Result := '';
- while BaseLead <> nil do
- begin
- Result := Result + '..' + PathDelim; { Do not localize }
- Next(BaseLead);
- end;
- if (DestPtr <> nil) and (DestPtr^ <> #0) then
- Result := Result + DestPtr + PathDelim;
- if DestLead <> nil then
- Result := Result + DestLead; // destlead already has a trailing backslash
- Result := Result + WideExtractFileName(DestName);
- end
- else
- Result := DestName;
-end;
-
-function WideExpandFileName(const FileName: WideString): WideString;
-var
- FName: PWideChar;
- Buffer: array[0..MAX_PATH - 1] of WideChar;
-begin
- SetString(Result, Buffer, Tnt_GetFullPathNameW(PWideChar(FileName), MAX_PATH, Buffer, FName));
-end;
-
-function WideExtractShortPathName(const FileName: WideString): WideString;
-var
- Buffer: array[0..MAX_PATH - 1] of WideChar;
-begin
- SetString(Result, Buffer, Tnt_GetShortPathNameW(PWideChar(FileName), Buffer, MAX_PATH));
-end;
-
-function WideFileCreate(const FileName: WideString): Integer;
-begin
- Result := Integer(Tnt_CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
- 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0))
-end;
-
-function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
-const
- AccessMode: array[0..2] of LongWord = (
- GENERIC_READ,
- GENERIC_WRITE,
- GENERIC_READ or GENERIC_WRITE);
- ShareMode: array[0..4] of LongWord = (
- 0,
- 0,
- FILE_SHARE_READ,
- FILE_SHARE_WRITE,
- FILE_SHARE_READ or FILE_SHARE_WRITE);
-begin
- Result := Integer(Tnt_CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
- ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL, 0));
-end;
-
-function WideFileAge(const FileName: WideString): Integer;
-var
- Handle: THandle;
- FindData: TWin32FindDataW;
- LocalFileTime: TFileTime;
-begin
- Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
- if Handle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(Handle);
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
- begin
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo) then
- Exit
- end;
- end;
- Result := -1;
-end;
-
-function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean;
-var
- Handle: THandle;
- FindData: TWin32FindDataW;
- LSystemTime: TSystemTime;
- LocalFileTime: TFileTime;
-begin
- Result := False;
- Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
- if Handle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(Handle);
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
- begin
- Result := True;
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- FileTimeToSystemTime(LocalFileTime, LSystemTime);
- with LSystemTime do
- FileDateTime := EncodeDate(wYear, wMonth, wDay) +
- EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
- end;
- end;
-end;
-
-function WideDirectoryExists(const Name: WideString): Boolean;
-var
- Code: Cardinal;
-begin
- Code := WideFileGetAttr(Name);
- Result := (Code <> INVALID_FILE_ATTRIBUTES) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
-end;
-
-function WideFileExists(const Name: WideString): Boolean;
-var
- Handle: THandle;
- FindData: TWin32FindDataW;
-begin
- Result := False;
- Handle := Tnt_FindFirstFileW(PWideChar(Name), FindData);
- if Handle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(Handle);
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
- Result := True;
- end;
-end;
-
-function WideFileGetAttr(const FileName: WideString): Cardinal;
-begin
- Result := Tnt_GetFileAttributesW(PWideChar(FileName));
-end;
-
-function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
-begin
- Result := Tnt_SetFileAttributesW(PWideChar(FileName), Attr)
-end;
-
-function WideFileIsReadOnly(const FileName: WideString): Boolean;
-begin
- Result := (Tnt_GetFileAttributesW(PWideChar(FileName)) and faReadOnly) <> 0;
-end;
-
-function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
-var
- Flags: Integer;
-begin
- Result := False;
- Flags := Tnt_GetFileAttributesW(PWideChar(FileName));
- if Flags = -1 then Exit;
- if ReadOnly then
- Flags := Flags or faReadOnly
- else
- Flags := Flags and not faReadOnly;
- Result := Tnt_SetFileAttributesW(PWideChar(FileName), Flags);
-end;
-
-function WideForceDirectories(Dir: WideString): Boolean;
-begin
- Result := True;
- if Length(Dir) = 0 then
- raise ETntGeneralError.Create(SCannotCreateDir);
- Dir := WideExcludeTrailingBackslash(Dir);
- if (Length(Dir) < 3) or WideDirectoryExists(Dir)
- or (WideExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
- Result := WideForceDirectories(WideExtractFilePath(Dir));
- if Result then
- Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil)
-end;
-
-function WideFileSearch(const Name, DirList: WideString): WideString;
-var
- I, P, L: Integer;
- C: WideChar;
-begin
- Result := Name;
- P := 1;
- L := Length(DirList);
- while True do
- begin
- if WideFileExists(Result) then Exit;
- while (P <= L) and (DirList[P] = PathSep) do Inc(P);
- if P > L then Break;
- I := P;
- while (P <= L) and (DirList[P] <> PathSep) do
- Inc(P);
- Result := Copy(DirList, I, P - I);
- C := TntWideLastChar(Result);
- if (C <> DriveDelim) and (C <> PathDelim) then
- Result := Result + PathDelim;
- Result := Result + Name;
- end;
- Result := '';
-end;
-
-function WideRenameFile(const OldName, NewName: WideString): Boolean;
-begin
- Result := Tnt_MoveFileW(PWideChar(OldName), PWideChar(NewName))
-end;
-
-function WideDeleteFile(const FileName: WideString): Boolean;
-begin
- Result := Tnt_DeleteFileW(PWideChar(FileName))
-end;
-
-function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
-begin
- Result := Tnt_CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists)
-end;
-
-function _WideFindMatchingFile(var F: TSearchRecW): Integer;
-var
- LocalFileTime: TFileTime;
-begin
- with F do
- begin
- while FindData.dwFileAttributes and ExcludeAttr <> 0 do
- if not Tnt_FindNextFileW(FindHandle, FindData) then
- begin
- Result := GetLastError;
- Exit;
- end;
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
- Size := (Int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
- Attr := FindData.dwFileAttributes;
- Name := FindData.cFileName;
- end;
- Result := 0;
-end;
-
-function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
-const
- faSpecial = faHidden or faSysFile {$IFNDEF COMPILER_9_UP} or faVolumeID {$ENDIF} or faDirectory;
-begin
- F.ExcludeAttr := not Attr and faSpecial;
- F.FindHandle := Tnt_FindFirstFileW(PWideChar(Path), F.FindData);
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Result := _WideFindMatchingFile(F);
- if Result <> 0 then WideFindClose(F);
- end else
- Result := GetLastError;
-end;
-
-function WideFindNext(var F: TSearchRecW): Integer;
-begin
- if Tnt_FindNextFileW(F.FindHandle, F.FindData) then
- Result := _WideFindMatchingFile(F) else
- Result := GetLastError;
-end;
-
-procedure WideFindClose(var F: TSearchRecW);
-begin
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(F.FindHandle);
- F.FindHandle := INVALID_HANDLE_VALUE;
- end;
-end;
-
-function WideCreateDir(const Dir: WideString): Boolean;
-begin
- Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil);
-end;
-
-function WideRemoveDir(const Dir: WideString): Boolean;
-begin
- Result := Tnt_RemoveDirectoryW(PWideChar(Dir));
-end;
-
-function WideGetCurrentDir: WideString;
-begin
- SetLength(Result, MAX_PATH);
- Tnt_GetCurrentDirectoryW(MAX_PATH, PWideChar(Result));
- Result := PWideChar(Result);
-end;
-
-function WideSetCurrentDir(const Dir: WideString): Boolean;
-begin
- Result := Tnt_SetCurrentDirectoryW(PWideChar(Dir));
-end;
-
-//=============================================================================================
-//== DATE/TIME STRING PARSING ================================================================
-//=============================================================================================
-
-function _IntTryStrToDateTime(Str: WideString; Flags: Integer; out DateTime: TDateTime): HResult;
-begin
- Result := VarDateFromStr(Str, GetThreadLocale, Flags, Double(DateTime));
- if (not Succeeded(Result)) then begin
- if (Flags = VAR_TIMEVALUEONLY)
- and SysUtils.TryStrToTime{TNT-ALLOW TryStrToTime}(Str, DateTime) then
- Result := S_OK // SysUtils seems confident (works for date = "dd.MM.yy" and time = "H.mm.ss")
- else if (Flags = VAR_DATEVALUEONLY)
- and SysUtils.TryStrToDate{TNT-ALLOW TryStrToDate}(Str, DateTime) then
- Result := S_OK // SysUtils seems confident
- else if (Flags = 0)
- and SysUtils.TryStrToDateTime{TNT-ALLOW TryStrToDateTime}(Str, DateTime) then
- Result := S_OK // SysUtils seems confident
- end;
-end;
-
-function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, 0, DateTime));
-end;
-
-function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, DateTime));
-end;
-
-function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, DateTime));
-end;
-
-function ValidDateTimeStr(Str: WideString): Boolean;
-var
- Temp: TDateTime;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, 0, Temp));
-end;
-
-function ValidDateStr(Str: WideString): Boolean;
-var
- Temp: TDateTime;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, Temp));
-end;
-
-function ValidTimeStr(Str: WideString): Boolean;
-var
- Temp: TDateTime;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, Temp));
-end;
-
-function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-begin
- if not TntTryStrToDateTime(Str, Result) then
- Result := Default;
-end;
-
-function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
-begin
- if not TntTryStrToDate(Str, Result) then
- Result := Default;
-end;
-
-function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-begin
- if not TntTryStrToTime(Str, Result) then
- Result := Default;
-end;
-
-function _IntStrToDateTime(Str: WideString; Flags: Integer; ErrorFormatStr: WideString): TDateTime;
-begin
- try
- OleCheck(_IntTryStrToDateTime(Str, Flags, Result));
- except
- on E: Exception do begin
- E.Message := E.Message + CRLF + WideFormat(ErrorFormatStr, [Str]);
- raise EConvertError.Create(E.Message);
- end;
- end;
-end;
-
-function TntStrToDateTime(Str: WideString): TDateTime;
-begin
- Result := _IntStrToDateTime(Str, 0, SInvalidDateTime);
-end;
-
-function TntStrToDate(Str: WideString): TDateTime;
-begin
- Result := _IntStrToDateTime(Str, VAR_DATEVALUEONLY, SInvalidDate);
-end;
-
-function TntStrToTime(Str: WideString): TDateTime;
-begin
- Result := _IntStrToDateTime(Str, VAR_TIMEVALUEONLY, SInvalidTime);
-end;
-
-//=============================================================================================
-//== CURRENCY STRING PARSING =================================================================
-//=============================================================================================
-
-function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
-const
- MAX_BUFF_SIZE = 64; // can a currency string actually be larger?
-var
- ValueStr: WideString;
-begin
- // format lpValue using ENG-US settings
- ValueStr := ENG_US_FloatToStr(Value);
- // get currency format
- SetLength(Result, MAX_BUFF_SIZE);
- if 0 = Tnt_GetCurrencyFormatW(GetThreadLocale, 0, PWideChar(ValueStr),
- lpFormat, PWideChar(Result), Length(Result))
- then begin
- RaiseLastOSError;
- end;
- Result := PWideChar(Result);
-end;
-
-function TntStrToCurr(const S: WideString): Currency;
-begin
- try
- OleCheck(VarCyFromStr(S, GetThreadLocale, 0, Result));
- except
- on E: Exception do begin
- E.Message := E.Message + CRLF + WideFormat(SInvalidCurrency, [S]);
- raise EConvertError.Create(E.Message);
- end;
- end;
-end;
-
-function ValidCurrencyStr(const S: WideString): Boolean;
-var
- Dummy: Currency;
-begin
- Result := Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Dummy));
-end;
-
-function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
-begin
- if not Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Result)) then
- Result := Default;
-end;
-
-threadvar
- Currency_DecimalSep: WideString;
- Currency_ThousandSep: WideString;
- Currency_CurrencySymbol: WideString;
-
-function GetDefaultCurrencyFmt: TCurrencyFmtW;
-begin
- ZeroMemory(@Result, SizeOf(Result));
- Result.NumDigits := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRDIGITS, '2'), 2);
- Result.LeadingZero := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ILZERO, '1'), 1);
- Result.Grouping := StrToIntDef(Copy(WideGetLocaleStr(GetThreadLocale, LOCALE_SMONGROUPING, '3;0'), 1, 1), 3);
- Currency_DecimalSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONDECIMALSEP, '.');
- Result.lpDecimalSep := PWideChar(Currency_DecimalSep);
- Currency_ThousandSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONTHOUSANDSEP, ',');
- Result.lpThousandSep := PWideChar(Currency_ThousandSep);
- Result.NegativeOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_INEGCURR, '0'), 0);
- Result.PositiveOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRENCY, '0'), 0);
- Currency_CurrencySymbol := WideGetLocaleStr(GetThreadLocale, LOCALE_SCURRENCY, '');
- Result.lpCurrencySymbol := PWideChar(Currency_CurrencySymbol);
-end;
-
-//=============================================================================================
-
-function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
-var
- L: Integer;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := GetLocaleStr{TNT-ALLOW GetLocaleStr}(LocaleID, LocaleType, Default)
- else begin
- SetLength(Result, 255);
- L := GetLocaleInfoW(LocaleID, LocaleType, PWideChar(Result), Length(Result));
- if L > 0 then
- SetLength(Result, L - 1)
- else
- Result := Default;
- end;
-end;
-
-function WideSysErrorMessage(ErrorCode: Integer): WideString;
-begin
- Result := WideLibraryErrorMessage('system', 0, ErrorCode);
-end;
-
-function WideLibraryErrorMessage(const LibName: WideString; Dll: THandle; ErrorCode: Integer): WideString;
-var
- Len: Integer;
- AnsiResult: AnsiString;
- Flags: Cardinal;
-begin
- Flags := FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or FORMAT_MESSAGE_ARGUMENT_ARRAY;
- if Dll <> 0 then
- Flags := Flags or FORMAT_MESSAGE_FROM_HMODULE;
- if Win32PlatformIsUnicode then begin
- SetLength(Result, 256);
- Len := FormatMessageW(Flags, Pointer(Dll), ErrorCode, 0, PWideChar(Result), Length(Result), nil);
- SetLength(Result, Len);
- end else begin
- SetLength(AnsiResult, 256);
- Len := FormatMessageA(Flags, Pointer(Dll), ErrorCode, 0, PAnsiChar(AnsiResult), Length(AnsiResult), nil);
- SetLength(AnsiResult, Len);
- Result := AnsiResult;
- end;
- if Trim(Result) = '' then
- Result := WideFormat('Unspecified error (%d) from %s.', [ErrorCode, LibName]);
-end;
-
-{$IFNDEF COMPILER_7_UP}
-function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
-begin
- Result := (Win32MajorVersion > AMajor) or
- ((Win32MajorVersion = AMajor) and
- (Win32MinorVersion >= AMinor));
-end;
-{$ENDIF}
-
-function WinCheckH(RetVal: Cardinal): Cardinal;
-begin
- if RetVal = 0 then RaiseLastOSError;
- Result := RetVal;
-end;
-
-function WinCheckFileH(RetVal: Cardinal): Cardinal;
-begin
- if RetVal = INVALID_HANDLE_VALUE then RaiseLastOSError;
- Result := RetVal;
-end;
-
-function WinCheckP(RetVal: Pointer): Pointer;
-begin
- if RetVal = nil then RaiseLastOSError;
- Result := RetVal;
-end;
-
-function WideGetModuleFileName(Instance: HModule): WideString;
-begin
- SetLength(Result, MAX_PATH);
- WinCheckH(Tnt_GetModuleFileNameW(Instance, PWideChar(Result), Length(Result)));
- Result := PWideChar(Result)
-end;
-
-function WideSafeLoadLibrary(const Filename: Widestring; ErrorMode: UINT): HMODULE;
-var
- OldMode: UINT;
- FPUControlWord: Word;
-begin
- OldMode := SetErrorMode(ErrorMode);
- try
- asm
- FNSTCW FPUControlWord
- end;
- try
- Result := Tnt_LoadLibraryW(PWideChar(Filename));
- finally
- asm
- FNCLEX
- FLDCW FPUControlWord
- end;
- end;
- finally
- SetErrorMode(OldMode);
- end;
-end;
-
-function WideLoadPackage(const Name: Widestring): HMODULE;
-begin
- Result := WideSafeLoadLibrary(Name);
- if Result = 0 then
- begin
- raise EPackageError.CreateFmt(sErrorLoadingPackage, [Name, WideSysErrorMessage(GetLastError)]);
- end;
- try
- InitializePackage(Result);
- except
- FreeLibrary(Result);
- raise;
- end;
-end;
-
-function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
-begin
- Win32Check(Tnt_GetStringTypeExW(GetThreadLocale, dwInfoType, PWideChar(@WC), 1, Result))
-end;
-
-function IsWideCharUpper(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_UPPER) <> 0;
-end;
-
-function IsWideCharLower(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_LOWER) <> 0;
-end;
-
-function IsWideCharDigit(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_DIGIT) <> 0;
-end;
-
-function IsWideCharSpace(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_SPACE) <> 0;
-end;
-
-function IsWideCharPunct(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_PUNCT) <> 0;
-end;
-
-function IsWideCharCntrl(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_CNTRL) <> 0;
-end;
-
-function IsWideCharBlank(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_BLANK) <> 0;
-end;
-
-function IsWideCharXDigit(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_XDIGIT) <> 0;
-end;
-
-function IsWideCharAlpha(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_ALPHA) <> 0;
-end;
-
-function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and (C1_ALPHA + C1_DIGIT)) <> 0;
-end;
-
-function WideTextPos(const SubStr, S: WideString): Integer;
-begin
- Result := Pos(Tnt_WideUpperCase(SubStr), Tnt_WideUpperCase(S));
-end;
-
-function FindDoubleTerminator(P: PWideChar): PWideChar;
-begin
- Result := P;
- while True do begin
- Result := WStrScan(Result, #0);
- Inc(Result);
- if Result^ = #0 then begin
- Dec(Result);
- break;
- end;
- end;
-end;
-
-function ExtractStringArrayStr(P: PWideChar): WideString;
-var
- PEnd: PWideChar;
-begin
- PEnd := FindDoubleTerminator(P);
- Inc(PEnd, 2); // move past #0#0
- SetString(Result, P, PEnd - P);
-end;
-
-function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
-var
- Start: PWideChar;
-begin
- Start := P;
- P := WStrScan(Start, Separator);
- if P = nil then begin
- Result := Start;
- P := WStrEnd(Start);
- end else begin
- SetString(Result, Start, P - Start);
- Inc(P);
- end;
-end;
-
-function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;
-const
- GROW_COUNT = 256;
-var
- Count: Integer;
- Item: WideString;
-begin
- Count := 0;
- SetLength(Result, GROW_COUNT);
- Item := ExtractStringFromStringArray(P, Separator);
- While Item <> '' do begin
- if Count > High(Result) then
- SetLength(Result, Length(Result) + GROW_COUNT);
- Result[Count] := Item;
- Inc(Count);
- Item := ExtractStringFromStringArray(P, Separator);
- end;
- SetLength(Result, Count);
-end;
-
-function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
-var
- UsedDefaultChar: BOOL;
-begin
- WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(@WC), 1, nil, 0, nil, @UsedDefaultChar);
- Result := not UsedDefaultChar;
-end;
-
-function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
-var
- UsedDefaultChar: BOOL;
-begin
- WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(WS), Length(WS), nil, 0, nil, @UsedDefaultChar);
- Result := not UsedDefaultChar;
-end;
-
-function IsRTF(const Value: WideString): Boolean;
-const
- RTF_BEGIN_1 = WideString('{\RTF');
- RTF_BEGIN_2 = WideString('{URTF');
-begin
- Result := (WideTextPos(RTF_BEGIN_1, Value) = 1)
- or (WideTextPos(RTF_BEGIN_2, Value) = 1);
-end;
-
-{$IFDEF COMPILER_7_UP}
-var
- Cached_ENG_US_FormatSettings: TFormatSettings;
- Cached_ENG_US_FormatSettings_Time: Cardinal;
-
-function ENG_US_FormatSettings: TFormatSettings;
-begin
- if Cached_ENG_US_FormatSettings_Time = _SettingChangeTime then
- Result := Cached_ENG_US_FormatSettings
- else begin
- GetLocaleFormatSettings(MAKELCID(MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US)), Result);
- Result.DecimalSeparator := '.'; // ignore overrides
- Cached_ENG_US_FormatSettings := Result;
- Cached_ENG_US_FormatSettings_Time := _SettingChangeTime;
- end;
- end;
-
-function ENG_US_FloatToStr(Value: Extended): WideString;
-begin
- Result := FloatToStr(Value, ENG_US_FormatSettings);
-end;
-
-function ENG_US_StrToFloat(const S: WideString): Extended;
-begin
- if not TextToFloat(PAnsiChar(AnsiString(S)), Result, fvExtended, ENG_US_FormatSettings) then
- Result := StrToFloat(S); // try using native format
-end;
-
-{$ELSE}
-
-function ENG_US_FloatToStr(Value: Extended): WideString;
-var
- SaveDecimalSep: AnsiChar;
-begin
- SaveDecimalSep := SysUtils.DecimalSeparator;
- try
- SysUtils.DecimalSeparator := '.';
- Result := FloatToStr(Value);
- finally
- SysUtils.DecimalSeparator := SaveDecimalSep;
- end;
-end;
-
-function ENG_US_StrToFloat(const S: WideString): Extended;
-var
- SaveDecimalSep: AnsiChar;
-begin
- try
- SaveDecimalSep := SysUtils.DecimalSeparator;
- try
- SysUtils.DecimalSeparator := '.';
- Result := StrToFloat(S);
- finally
- SysUtils.DecimalSeparator := SaveDecimalSep;
- end;
- except
- if SysUtils.DecimalSeparator <> '.' then
- Result := StrToFloat(S) // try using native format
- else
- raise;
- end;
-end;
-{$ENDIF}
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Variants
-//---------------------------------------------------------------------------------------------
-
-initialization
- Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
- Win32PlatformIsXP := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1))
- or (Win32MajorVersion > 5);
- Win32PlatformIs2003 := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 2))
- or (Win32MajorVersion > 5);
- Win32PlatformIsVista := (Win32MajorVersion >= 6);
-
-finalization
- Currency_DecimalSep := ''; {make memory sleuth happy}
- Currency_ThousandSep := ''; {make memory sleuth happy}
- Currency_CurrencySymbol := ''; {make memory sleuth happy}
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntSystem.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntSystem.pas deleted file mode 100644 index cc99aa48f7..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntSystem.pas +++ /dev/null @@ -1,1384 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntSystem;
-
-{$INCLUDE TntCompilers.inc}
-
-{*****************************************************************************}
-{ Special thanks go to Francisco Leong for originating the design for }
-{ WideString-enabled resourcestrings. }
-{*****************************************************************************}
-
-interface
-
-uses
- Windows;
-
-// These functions should not be used by Delphi code since conversions are implicit.
-{TNT-WARN WideCharToString}
-{TNT-WARN WideCharLenToString}
-{TNT-WARN WideCharToStrVar}
-{TNT-WARN WideCharLenToStrVar}
-{TNT-WARN StringToWideChar}
-
-// ................ ANSI TYPES ................
-{TNT-WARN Char}
-{TNT-WARN PChar}
-{TNT-WARN String}
-
-{TNT-WARN CP_ACP} // <-- use DefaultSystemCodePage
-function DefaultSystemCodePage: Cardinal; // implicitly used when converting AnsiString <--> WideString.
-
-var
- WideCustomLoadResString: function(ResStringRec: PResStringRec; var Value: WideString): Boolean;
-
-{TNT-WARN LoadResString}
-function WideLoadResString(ResStringRec: PResStringRec): WideString;
-{TNT-WARN ParamCount}
-function WideParamCount: Integer;
-{TNT-WARN ParamStr}
-function WideParamStr(Index: Integer): WideString;
-
-// ......... introduced .........
-
-const
- { Each Unicode stream should begin with the code U+FEFF, }
- { which the standard defines as the *byte order mark*. }
- UNICODE_BOM = WideChar($FEFF);
- UNICODE_BOM_SWAPPED = WideChar($FFFE);
- UTF8_BOM = AnsiString(#$EF#$BB#$BF);
-
-function WideStringToUTF8(const S: WideString): AnsiString;
-function UTF8ToWideString(const S: AnsiString): WideString;
-
-function WideStringToUTF7(const W: WideString): AnsiString;
-function UTF7ToWideString(const S: AnsiString): WideString;
-
-function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
-function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
-
-function UCS2ToWideString(const Value: AnsiString): WideString;
-function WideStringToUCS2(const Value: WideString): AnsiString;
-
-function CharSetToCodePage(ciCharset: UINT): Cardinal;
-function LCIDToCodePage(ALcid: LCID): Cardinal;
-function KeyboardCodePage: Cardinal;
-function KeyUnicode(CharCode: Word): WideChar;
-
-procedure StrSwapByteOrder(Str: PWideChar);
-
-type
- TTntSystemUpdate =
- (tsWideResourceStrings
- {$IFNDEF COMPILER_9_UP}, tsFixImplicitCodePage, tsFixWideStrConcat, tsFixWideFormat {$ENDIF}
- );
- TTntSystemUpdateSet = set of TTntSystemUpdate;
-
-const
- AllTntSystemUpdates = [Low(TTntSystemUpdate)..High(TTntSystemUpdate)];
-
-procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
-
-implementation
-
-uses
- SysUtils, Variants, TntWindows, TntSysUtils;
-
-var
- GDefaultSystemCodePage: Cardinal;
-
-function DefaultSystemCodePage: Cardinal;
-begin
- Result := GDefaultSystemCodePage;
-end;
-
-var
- IsDebugging: Boolean;
-
-function WideLoadResString(ResStringRec: PResStringRec): WideString;
-const
- MAX_RES_STRING_SIZE = 4097; { MSDN documents this as the maximum size of a string in table. }
-var
- Buffer: array [0..MAX_RES_STRING_SIZE] of WideChar; { Buffer leaves room for null terminator. }
- PCustom: PAnsiChar;
-begin
- if Assigned(WideCustomLoadResString) and WideCustomLoadResString(ResStringRec, Result) then
- exit; { a custom resourcestring has been loaded. }
-
- if ResStringRec = nil then
- Result := ''
- else if ResStringRec.Identifier < 64*1024 then
- SetString(Result, Buffer,
- Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^),
- ResStringRec.Identifier, Buffer, MAX_RES_STRING_SIZE))
- else begin
- // custom string pointer
- PCustom := PAnsiChar(ResStringRec.Identifier); { I would like to use PWideChar, but this would break legacy code. }
- if (StrLen{TNT-ALLOW StrLen}(PCustom) > Cardinal(Length(UTF8_BOM)))
- and CompareMem(PCustom, PAnsiChar(UTF8_BOM), Length(UTF8_BOM)) then
- // detected UTF8
- Result := UTF8ToWideString(PAnsiChar(PCustom + Length(UTF8_BOM)))
- else
- // normal
- Result := PCustom;
- end;
-end;
-
-function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar;
-var
- i, Len: Integer;
- Start, S, Q: PWideChar;
-begin
- while True do
- begin
- while (P[0] <> #0) and (P[0] <= ' ') do
- Inc(P);
- if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
- end;
- Len := 0;
- Start := P;
- while P[0] > ' ' do
- begin
- if P[0] = '"' then
- begin
- Inc(P);
- while (P[0] <> #0) and (P[0] <> '"') do
- begin
- Q := P + 1;
- Inc(Len, Q - P);
- P := Q;
- end;
- if P[0] <> #0 then
- Inc(P);
- end
- else
- begin
- Q := P + 1;
- Inc(Len, Q - P);
- P := Q;
- end;
- end;
-
- SetLength(Param, Len);
-
- P := Start;
- S := PWideChar(Param);
- i := 0;
- while P[0] > ' ' do
- begin
- if P[0] = '"' then
- begin
- Inc(P);
- while (P[0] <> #0) and (P[0] <> '"') do
- begin
- Q := P + 1;
- while P < Q do
- begin
- S[i] := P^;
- Inc(P);
- Inc(i);
- end;
- end;
- if P[0] <> #0 then Inc(P);
- end
- else
- begin
- Q := P + 1;
- while P < Q do
- begin
- S[i] := P^;
- Inc(P);
- Inc(i);
- end;
- end;
- end;
-
- Result := P;
-end;
-
-function WideParamCount: Integer;
-var
- P: PWideChar;
- S: WideString;
-begin
- P := WideGetParamStr(GetCommandLineW, S);
- Result := 0;
- while True do
- begin
- P := WideGetParamStr(P, S);
- if S = '' then Break;
- Inc(Result);
- end;
-end;
-
-function WideParamStr(Index: Integer): WideString;
-var
- P: PWideChar;
-begin
- if Index = 0 then
- Result := WideGetModuleFileName(0)
- else
- begin
- P := GetCommandLineW;
- while True do
- begin
- P := WideGetParamStr(P, Result);
- if (Index = 0) or (Result = '') then Break;
- Dec(Index);
- end;
- end;
-end;
-
-function WideStringToUTF8(const S: WideString): AnsiString;
-begin
- Result := UTF8Encode(S);
-end;
-
-function UTF8ToWideString(const S: AnsiString): WideString;
-begin
- Result := UTF8Decode(S);
-end;
-
- { ======================================================================= }
- { Original File: ConvertUTF7.c }
- { Author: David B. Goldsmith }
- { Copyright (C) 1994, 1996 Taligent, Inc. All rights reserved. }
- { }
- { This code is copyrighted. Under the copyright laws, this code may not }
- { be copied, in whole or part, without prior written consent of Taligent. }
- { }
- { Taligent grants the right to use this code as long as this ENTIRE }
- { copyright notice is reproduced in the code. The code is provided }
- { AS-IS, AND TALIGENT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR }
- { IMPLIED, INCLUDING, BUT NOT LIMITED TO IMPLIED WARRANTIES OF }
- { MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT }
- { WILL TALIGENT BE LIABLE FOR ANY DAMAGES WHATSOEVER (INCLUDING, }
- { WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS }
- { INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR OTHER PECUNIARY }
- { LOSS) ARISING OUT OF THE USE OR INABILITY TO USE THIS CODE, EVEN }
- { IF TALIGENT HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. }
- { BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF }
- { LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE ABOVE }
- { LIMITATION MAY NOT APPLY TO YOU. }
- { }
- { RESTRICTED RIGHTS LEGEND: Use, duplication, or disclosure by the }
- { government is subject to restrictions as set forth in subparagraph }
- { (c)(l)(ii) of the Rights in Technical Data and Computer Software }
- { clause at DFARS 252.227-7013 and FAR 52.227-19. }
- { }
- { This code may be protected by one or more U.S. and International }
- { Patents. }
- { }
- { TRADEMARKS: Taligent and the Taligent Design Mark are registered }
- { trademarks of Taligent, Inc. }
- { ======================================================================= }
-
-type UCS2 = Word;
-
-const
- _base64: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
- _direct: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789''(),-./:?';
- _optional: AnsiString = '!"#$%&*;<=>@[]^_`{|}';
- _spaces: AnsiString = #9#13#10#32;
-
-var
- base64: PAnsiChar;
- invbase64: array[0..127] of SmallInt;
- direct: PAnsiChar;
- optional: PAnsiChar;
- spaces: PAnsiChar;
- mustshiftsafe: array[0..127] of AnsiChar;
- mustshiftopt: array[0..127] of AnsiChar;
-
-var
- needtables: Boolean = True;
-
-procedure Initialize_UTF7_Data;
-begin
- base64 := PAnsiChar(_base64);
- direct := PAnsiChar(_direct);
- optional := PAnsiChar(_optional);
- spaces := PAnsiChar(_spaces);
-end;
-
-procedure tabinit;
-var
- i: Integer;
- limit: Integer;
-begin
- i := 0;
- while (i < 128) do
- begin
- mustshiftopt[i] := #1;
- mustshiftsafe[i] := #1;
- invbase64[i] := -1;
- Inc(i);
- end { For };
- limit := Length(_Direct);
- i := 0;
- while (i < limit) do
- begin
- mustshiftopt[Integer(direct[i])] := #0;
- mustshiftsafe[Integer(direct[i])] := #0;
- Inc(i);
- end { For };
- limit := Length(_Spaces);
- i := 0;
- while (i < limit) do
- begin
- mustshiftopt[Integer(spaces[i])] := #0;
- mustshiftsafe[Integer(spaces[i])] := #0;
- Inc(i);
- end { For };
- limit := Length(_Optional);
- i := 0;
- while (i < limit) do
- begin
- mustshiftopt[Integer(optional[i])] := #0;
- Inc(i);
- end { For };
- limit := Length(_Base64);
- i := 0;
- while (i < limit) do
- begin
- invbase64[Integer(base64[i])] := i;
- Inc(i);
- end { For };
- needtables := False;
-end; { tabinit }
-
-function WRITE_N_BITS(x: UCS2; n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): Integer;
-begin
- BITbuffer := BITbuffer or (x and (not (-1 shl n))) shl (32 - n - bufferbits);
- bufferbits := bufferbits + n;
- Result := bufferbits;
-end; { WRITE_N_BITS }
-
-function READ_N_BITS(n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): UCS2;
-var
- buffertemp: Cardinal;
-begin
- buffertemp := BITbuffer shr (32 - n);
- BITbuffer := BITbuffer shl n;
- bufferbits := bufferbits - n;
- Result := UCS2(buffertemp);
-end; { READ_N_BITS }
-
-function ConvertUCS2toUTF7(var sourceStart: PWideChar; sourceEnd: PWideChar;
- var targetStart: PAnsiChar; targetEnd: PAnsiChar; optional: Boolean;
- verbose: Boolean): Integer;
-var
- r: UCS2;
- target: PAnsiChar;
- source: PWideChar;
- BITbuffer: Cardinal;
- bufferbits: Integer;
- shifted: Boolean;
- needshift: Boolean;
- done: Boolean;
- mustshift: PAnsiChar;
-begin
- Initialize_UTF7_Data;
- Result := 0;
- BITbuffer := 0;
- bufferbits := 0;
- shifted := False;
- source := sourceStart;
- target := targetStart;
- r := 0;
- if needtables then
- tabinit;
- if optional then
- mustshift := @mustshiftopt[0]
- else
- mustshift := @mustshiftsafe[0];
- repeat
- done := source >= sourceEnd;
- if not Done then
- begin
- r := Word(source^);
- Inc(Source);
- end { If };
- needshift := (not done) and ((r > $7F) or (mustshift[r] <> #0));
- if needshift and (not shifted) then
- begin
- if (Target >= TargetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- target^ := '+';
- Inc(target);
- { Special case handling of the SHIFT_IN character }
- if (r = UCS2('+')) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end;
- target^ := '-';
- Inc(target);
- end
- else
- shifted := True;
- end { If };
- if shifted then
- begin
- { Either write the character to the bit buffer, or pad }
- { the bit buffer out to a full base64 character. }
- { }
- if needshift then
- WRITE_N_BITS(r, 16, BITbuffer, bufferbits)
- else
- WRITE_N_BITS(0, (6 - (bufferbits mod 6)) mod 6, BITbuffer,
- bufferbits);
- { Flush out as many full base64 characters as possible }
- { from the bit buffer. }
- { }
- while (target < targetEnd) and (bufferbits >= 6) do
- begin
- Target^ := base64[READ_N_BITS(6, BITbuffer, bufferbits)];
- Inc(Target);
- end { While };
- if (bufferbits >= 6) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- end { If };
- if (not needshift) then
- begin
- { Write the explicit shift out character if }
- { 1) The caller has requested we always do it, or }
- { 2) The directly encoded character is in the }
- { base64 set, or }
- { 3) The directly encoded character is SHIFT_OUT. }
- { }
- if verbose or ((not done) and ((invbase64[r] >= 0) or (r =
- Integer('-')))) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- Break;
- end { If };
- Target^ := '-';
- Inc(Target);
- end { If };
- shifted := False;
- end { If };
- { The character can be directly encoded as ASCII. }
- end { If };
- if (not needshift) and (not done) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- Target^ := AnsiChar(r);
- Inc(Target);
- end { If };
- until (done);
- sourceStart := source;
- targetStart := target;
-end; { ConvertUCS2toUTF7 }
-
-function ConvertUTF7toUCS2(var sourceStart: PAnsiChar; sourceEnd: PAnsiChar;
- var targetStart: PWideChar; targetEnd: PWideChar): Integer;
-var
- target: PWideChar { Register };
- source: PAnsiChar { Register };
- BITbuffer: Cardinal { & "Address Of" Used };
- bufferbits: Integer { & "Address Of" Used };
- shifted: Boolean { Used In Boolean Context };
- first: Boolean { Used In Boolean Context };
- wroteone: Boolean;
- base64EOF: Boolean;
- base64value: Integer;
- done: Boolean;
- c: UCS2;
- prevc: UCS2;
- junk: UCS2 { Used In Boolean Context };
-begin
- Initialize_UTF7_Data;
- Result := 0;
- BITbuffer := 0;
- bufferbits := 0;
- shifted := False;
- first := False;
- wroteone := False;
- source := sourceStart;
- target := targetStart;
- c := 0;
- if needtables then
- tabinit;
- repeat
- { read an ASCII character c }
- done := Source >= SourceEnd;
- if (not done) then
- begin
- c := Word(Source^);
- Inc(Source);
- end { If };
- if shifted then
- begin
- { We're done with a base64 string if we hit EOF, it's not a valid }
- { ASCII character, or it's not in the base64 set. }
- { }
- base64value := invbase64[c];
- base64EOF := (done or (c > $7F)) or (base64value < 0);
- if base64EOF then
- begin
- shifted := False;
- { If the character causing us to drop out was SHIFT_IN or }
- { SHIFT_OUT, it may be a special escape for SHIFT_IN. The }
- { test for SHIFT_IN is not necessary, but allows an alternate }
- { form of UTF-7 where SHIFT_IN is escaped by SHIFT_IN. This }
- { only works for some values of SHIFT_IN. }
- { }
- if ((not done) and ((c = Integer('+')) or (c = Integer('-')))) then
- begin
- { get another character c }
- prevc := c;
- Done := Source >= SourceEnd;
- if (not Done) then
- begin
- c := Word(Source^);
- Inc(Source);
- { If no base64 characters were encountered, and the }
- { character terminating the shift sequence was }
- { SHIFT_OUT, then it's a special escape for SHIFT_IN. }
- { }
- end;
- if first and (prevc = Integer('-')) then
- begin
- { write SHIFT_IN unicode }
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- Target^ := WideChar('+');
- Inc(Target);
- end
- else
- begin
- if (not wroteone) then
- begin
- Result := 1;
- end { If };
- end { Else };
- ;
- end { If }
- else
- begin
- if (not wroteone) then
- begin
- Result := 1;
- end { If };
- end { Else };
- end { If }
- else
- begin
- { Add another 6 bits of base64 to the bit buffer. }
- WRITE_N_BITS(base64value, 6, BITbuffer,
- bufferbits);
- first := False;
- end { Else };
- { Extract as many full 16 bit characters as possible from the }
- { bit buffer. }
- { }
- while (bufferbits >= 16) and (target < targetEnd) do
- begin
- { write a unicode }
- Target^ := WideChar(READ_N_BITS(16, BITbuffer, bufferbits));
- Inc(Target);
- wroteone := True;
- end { While };
- if (bufferbits >= 16) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- Break;
- end;
- end { If };
- if (base64EOF) then
- begin
- junk := READ_N_BITS(bufferbits, BITbuffer, bufferbits);
- if (junk <> 0) then
- begin
- Result := 1;
- end { If };
- end { If };
- end { If };
- if (not shifted) and (not done) then
- begin
- if (c = Integer('+')) then
- begin
- shifted := True;
- first := True;
- wroteone := False;
- end { If }
- else
- begin
- { It must be a directly encoded character. }
- if (c > $7F) then
- begin
- Result := 1;
- end { If };
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- Target^ := WideChar(c);
- Inc(Target);
- end { Else };
- end { If };
- until (done);
- sourceStart := source;
- targetStart := target;
-end; { ConvertUTF7toUCS2 }
-
- {*****************************************************************************}
- { Thanks to Francisco Leong for providing the Pascal conversion of }
- { ConvertUTF7.c (by David B. Goldsmith) }
- {*****************************************************************************}
-
-resourcestring
- SBufferOverflow = 'Buffer overflow';
- SInvalidUTF7 = 'Invalid UTF7';
-
-function WideStringToUTF7(const W: WideString): AnsiString;
-var
- SourceStart, SourceEnd: PWideChar;
- TargetStart, TargetEnd: PAnsiChar;
-begin
- if W = '' then
- Result := ''
- else
- begin
- SetLength(Result, Length(W) * 7); // Assume worst case
- SourceStart := PWideChar(@W[1]);
- SourceEnd := PWideChar(@W[Length(W)]) + 1;
- TargetStart := PAnsiChar(@Result[1]);
- TargetEnd := PAnsiChar(@Result[Length(Result)]) + 1;
- if ConvertUCS2toUTF7(SourceStart, SourceEnd, TargetStart,
- TargetEnd, True, False) <> 0
- then
- raise ETntInternalError.Create(SBufferOverflow);
- SetLength(Result, TargetStart - PAnsiChar(@Result[1]));
- end;
-end;
-
-function UTF7ToWideString(const S: AnsiString): WideString;
-var
- SourceStart, SourceEnd: PAnsiChar;
- TargetStart, TargetEnd: PWideChar;
-begin
- if (S = '') then
- Result := ''
- else
- begin
- SetLength(Result, Length(S)); // Assume Worst case
- SourceStart := PAnsiChar(@S[1]);
- SourceEnd := PAnsiChar(@S[Length(S)]) + 1;
- TargetStart := PWideChar(@Result[1]);
- TargetEnd := PWideChar(@Result[Length(Result)]) + 1;
- case ConvertUTF7toUCS2(SourceStart, SourceEnd, TargetStart,
- TargetEnd) of
- 1: raise ETntGeneralError.Create(SInvalidUTF7);
- 2: raise ETntInternalError.Create(SBufferOverflow);
- end;
- SetLength(Result, TargetStart - PWideChar(@Result[1]));
- end;
-end;
-
-function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
-var
- InputLength,
- OutputLength: Integer;
-begin
- if CodePage = CP_UTF7 then
- Result := UTF7ToWideString(S) // CP_UTF7 not supported on Windows 95
- else if CodePage = CP_UTF8 then
- Result := UTF8ToWideString(S) // CP_UTF8 not supported on Windows 95
- else begin
- InputLength := Length(S);
- OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0);
- SetLength(Result, OutputLength);
- MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength);
- end;
-end;
-
-function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
-var
- InputLength,
- OutputLength: Integer;
-begin
- if CodePage = CP_UTF7 then
- Result := WideStringToUTF7(WS) // CP_UTF7 not supported on Windows 95
- else if CodePage = CP_UTF8 then
- Result := WideStringToUTF8(WS) // CP_UTF8 not supported on Windows 95
- else begin
- InputLength := Length(WS);
- OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil);
- SetLength(Result, OutputLength);
- WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil);
- end;
-end;
-
-function UCS2ToWideString(const Value: AnsiString): WideString;
-begin
- if Length(Value) = 0 then
- Result := ''
- else
- SetString(Result, PWideChar(@Value[1]), Length(Value) div SizeOf(WideChar))
-end;
-
-function WideStringToUCS2(const Value: WideString): AnsiString;
-begin
- if Length(Value) = 0 then
- Result := ''
- else
- SetString(Result, PAnsiChar(@Value[1]), Length(Value) * SizeOf(WideChar))
-end;
-
-{ Windows.pas doesn't declare TranslateCharsetInfo() correctly. }
-function TranslateCharsetInfo(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo';
-
-function CharSetToCodePage(ciCharset: UINT): Cardinal;
-var
- C: TCharsetInfo;
-begin
- Win32Check(TranslateCharsetInfo(PDWORD(ciCharset), C, TCI_SRCCHARSET));
- Result := C.ciACP
-end;
-
-function LCIDToCodePage(ALcid: LCID): Cardinal;
-var
- Buf: array[0..6] of AnsiChar;
-begin
- GetLocaleInfo(ALcid, LOCALE_IDefaultAnsiCodePage, Buf, 6);
- Result := StrToIntDef(Buf, GetACP);
-end;
-
-function KeyboardCodePage: Cardinal;
-begin
- Result := LCIDToCodePage(GetKeyboardLayout(0) and $FFFF);
-end;
-
-function KeyUnicode(CharCode: Word): WideChar;
-var
- AChar: AnsiChar;
-begin
- // converts the given character (as it comes with a WM_CHAR message) into its
- // corresponding Unicode character depending on the active keyboard layout
- if CharCode <= Word(High(AnsiChar)) then begin
- AChar := AnsiChar(CharCode);
- MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @AChar, 1, @Result, 1);
- end else
- Result := WideChar(CharCode);
-end;
-
-procedure StrSwapByteOrder(Str: PWideChar);
-var
- P: PWord;
-begin
- P := PWord(Str);
- While (P^ <> 0) do begin
- P^ := MakeWord(HiByte(P^), LoByte(P^));
- Inc(P);
- end;
-end;
-
-//--------------------------------------------------------------------
-// LoadResString()
-//
-// This system function is used to retrieve a resourcestring and
-// return the result as an AnsiString. If we believe that the result
-// is only a temporary value, and that it will be immediately
-// assigned to a WideString or a Variant, then we will save the
-// Unicode result as well as a reference to the original Ansi string.
-// WStrFromPCharLen() or VarFromLStr() will return this saved
-// Unicode string if it appears to receive the most recent result
-// of LoadResString.
-//--------------------------------------------------------------------
-
-
- //===========================================================================================
- //
- // function CodeMatchesPatternForUnicode(...);
- //
- // GIVEN: SomeWideString := SSomeResString; { WideString := resourcestring }
- //
- // Delphi will compile this statement into the following:
- // -------------------------------------------------
- // TempAnsiString := LoadResString(@SSomeResString);
- // LINE 1: lea edx,[SomeTempAnsiString]
- // LINE 2: mov eax,[@SomeResString]
- // LINE 3: call LoadResString
- //
- // WStrFromLStr(SomeWideString, TempAnsiString); { SomeWideString := TempAnsiString }
- // LINE 4: mov edx,[SomeTempAnsiString]
- // LINE 5: mov/lea eax [@SomeWideString]
- // LINE 6: call @WStrFromLStr
- // -------------------------------------------------
- //
- // The order in which the parameters are prepared for WStrFromLStr (ie LINE 4 & 5) is
- // reversed when assigning a non-temporary AnsiString to a WideString.
- //
- // This code, for example, results in LINE 4 and LINE 5 being swapped.
- //
- // SomeAnsiString := SSomeResString;
- // SomeWideString := SomeAnsiString;
- //
- // Since we know the "signature" used by the compiler, we can detect this pattern.
- // If we believe it is only temporary, we can save the Unicode results for later
- // retrieval from WStrFromLStr.
- //
- // One final note: When assigning a resourcestring to a Variant, the same patterns exist.
- //===========================================================================================
-
-function CodeMatchesPatternForUnicode(PLine4: PAnsiChar): Boolean;
-const
- SIZEOF_OPCODE = 1 {byte};
- MOV_16_OPCODE = AnsiChar($8B); { we'll assume operand size is 16 bits }
- MOV_32_OPCODE = AnsiChar($B8); { we'll assume operand size is 32 bits }
- LEA_OPCODE = AnsiChar($8D); { operand size can be 16 or 40 bits }
- CALL_OPCODE = AnsiChar($E8); { assumed operand size is 32 bits }
- BREAK_OPCODE = AnsiChar($CC); {in a breakpoint}
-var
- PLine1: PAnsiChar;
- PLine2: PAnsiChar;
- PLine3: PAnsiChar;
- DataSize: Integer; // bytes in first LEA operand
-begin
- Result := False;
-
- PLine3 := PLine4 - SizeOf(CALL_OPCODE) - 4;
- PLine2 := PLine3 - SizeOf(MOV_32_OPCODE) - 4;
-
- // figure PLine1 and operand size
- DataSize := 2; { try 16 bit operand for line 1 }
- PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
- if (PLine1^ <> LEA_OPCODE) and (not (IsDebugging and (PLine1^ = BREAK_OPCODE))) then
- begin
- DataSize := 5; { try 40 bit operand for line 1 }
- PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
- end;
- if (PLine1^ = LEA_OPCODE) or (IsDebugging and (PLine1^ = BREAK_OPCODE)) then
- begin
- if CompareMem(PLine1 + SIZEOF_OPCODE, PLine4 + SIZEOF_OPCODE, DataSize) then
- begin
- // After this check, it seems to match the WideString <- (temp) AnsiString pattern
- Result := True; // It is probably OK. (The side effects of being wrong aren't very bad.)
- end;
- end;
-end;
-
-threadvar
- PLastResString: PAnsiChar;
- LastResStringValue: AnsiString;
- LastWideResString: WideString;
-
-procedure FreeTntSystemThreadVars;
-begin
- LastResStringValue := '';
- LastWideResString := '';
-end;
-
-procedure Custom_System_EndThread(ExitCode: Integer);
-begin
- FreeTntSystemThreadVars;
- {$IFDEF COMPILER_10_UP}
- if Assigned(SystemThreadEndProc) then
- SystemThreadEndProc(ExitCode);
- {$ENDIF}
- ExitThread(ExitCode);
-end;
-
-function Custom_System_LoadResString(ResStringRec: PResStringRec): AnsiString;
-var
- ReturnAddr: Pointer;
-begin
- // get return address
- asm
- PUSH ECX
- MOV ECX, [EBP + 4]
- MOV ReturnAddr, ECX
- POP ECX
- end;
- // check calling code pattern
- if CodeMatchesPatternForUnicode(ReturnAddr) then begin
- // result will probably be assigned to an intermediate AnsiString
- // on its way to either a WideString or Variant.
- LastWideResString := WideLoadResString(ResStringRec);
- Result := LastWideResString;
- LastResStringValue := Result;
- if Result = '' then
- PLastResString := nil
- else
- PLastResString := PAnsiChar(Result);
- end else begin
- // result will probably be assigned to an actual AnsiString variable.
- PLastResString := nil;
- Result := WideLoadResString(ResStringRec);
- end;
-end;
-
-//--------------------------------------------------------------------
-// WStrFromPCharLen()
-//
-// This system function is used to assign an AnsiString to a WideString.
-// It has been modified to assign Unicode results from LoadResString.
-// Another purpose of this function is to specify the code page.
-//--------------------------------------------------------------------
-
-procedure Custom_System_WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
-var
- DestLen: Integer;
- Buffer: array[0..2047] of WideChar;
- Local_PLastResString: Pointer;
-begin
- Local_PLastResString := PLastResString;
- if (Local_PLastResString <> nil)
- and (Local_PLastResString = Source)
- and (System.Length(LastResStringValue) = Length)
- and (LastResStringValue = Source) then begin
- // use last unicode resource string
- PLastResString := nil; { clear for further use }
- Dest := LastWideResString;
- end else begin
- if Local_PLastResString <> nil then
- PLastResString := nil; { clear for further use }
- if Length <= 0 then
- begin
- Dest := '';
- Exit;
- end;
- if Length + 1 < High(Buffer) then
- begin
- DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Buffer,
- High(Buffer));
- if DestLen > 0 then
- begin
- SetLength(Dest, DestLen);
- Move(Pointer(@Buffer[0])^, Pointer(Dest)^, DestLen * SizeOf(WideChar));
- Exit;
- end;
- end;
- DestLen := (Length + 1);
- SetLength(Dest, DestLen); // overallocate, trim later
- DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest),
- DestLen);
- if DestLen < 0 then
- DestLen := 0;
- SetLength(Dest, DestLen);
- end;
-end;
-
-{$IFNDEF COMPILER_9_UP}
-
-//--------------------------------------------------------------------
-// LStrFromPWCharLen()
-//
-// This system function is used to assign an WideString to an AnsiString.
-// It has not been modified from its original purpose other than to specify the code page.
-//--------------------------------------------------------------------
-
-procedure Custom_System_LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
-var
- DestLen: Integer;
- Buffer: array[0..4095] of AnsiChar;
-begin
- if Length <= 0 then
- begin
- Dest := '';
- Exit;
- end;
- if Length + 1 < (High(Buffer) div sizeof(WideChar)) then
- begin
- DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source,
- Length, Buffer, High(Buffer),
- nil, nil);
- if DestLen >= 0 then
- begin
- SetLength(Dest, DestLen);
- Move(Pointer(@Buffer[0])^, PAnsiChar(Dest)^, DestLen);
- Exit;
- end;
- end;
-
- DestLen := (Length + 1) * sizeof(WideChar);
- SetLength(Dest, DestLen); // overallocate, trim later
- DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest), DestLen,
- nil, nil);
- if DestLen < 0 then
- DestLen := 0;
- SetLength(Dest, DestLen);
-end;
-
-//--------------------------------------------------------------------
-// WStrToString()
-//
-// This system function is used to assign an WideString to an short string.
-// It has not been modified from its original purpose other than to specify the code page.
-//--------------------------------------------------------------------
-
-procedure Custom_System_WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
-var
- SourceLen, DestLen: Integer;
- Buffer: array[0..511] of AnsiChar;
-begin
- if MaxLen > 255 then MaxLen := 255;
- SourceLen := Length(Source);
- if SourceLen >= MaxLen then SourceLen := MaxLen;
- if SourceLen = 0 then
- DestLen := 0
- else begin
- DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Pointer(Source), SourceLen,
- Buffer, SizeOf(Buffer), nil, nil);
- if DestLen > MaxLen then DestLen := MaxLen;
- end;
- Dest^[0] := Chr(DestLen);
- if DestLen > 0 then Move(Buffer, Dest^[1], DestLen);
-end;
-
-{$ENDIF}
-
-//--------------------------------------------------------------------
-// VarFromLStr()
-//
-// This system function is used to assign an AnsiString to a Variant.
-// It has been modified to assign Unicode results from LoadResString.
-//--------------------------------------------------------------------
-
-procedure Custom_System_VarFromLStr(var V: TVarData; const Value: AnsiString);
-const
- varDeepData = $BFE8;
-var
- Local_PLastResString: Pointer;
-begin
- if (V.VType and varDeepData) <> 0 then
- VarClear(PVariant(@V)^);
-
- Local_PLastResString := PLastResString;
- if (Local_PLastResString <> nil)
- and (Local_PLastResString = PAnsiChar(Value))
- and (LastResStringValue = Value) then begin
- // use last unicode resource string
- PLastResString := nil; { clear for further use }
- V.VOleStr := nil;
- V.VType := varOleStr;
- WideString(Pointer(V.VOleStr)) := Copy(LastWideResString, 1, MaxInt);
- end else begin
- if Local_PLastResString <> nil then
- PLastResString := nil; { clear for further use }
- V.VString := nil;
- V.VType := varString;
- AnsiString(V.VString) := Value;
- end;
-end;
-
-{$IFNDEF COMPILER_9_UP}
-
-//--------------------------------------------------------------------
-// WStrCat3() A := B + C;
-//
-// This system function is used to concatenate two strings into one result.
-// This function is added because A := '' + '' doesn't necessarily result in A = '';
-//--------------------------------------------------------------------
-
-procedure Custom_System_WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
-
- function NewWideString(CharLength: Longint): Pointer;
- var
- _NewWideString: function(CharLength: Longint): Pointer;
- begin
- asm
- PUSH ECX
- MOV ECX, offset System.@NewWideString;
- MOV _NewWideString, ECX
- POP ECX
- end;
- Result := _NewWideString(CharLength);
- end;
-
- procedure WStrSet(var S: WideString; P: PWideChar);
- var
- Temp: Pointer;
- begin
- Temp := Pointer(InterlockedExchange(Integer(S), Integer(P)));
- if Temp <> nil then
- WideString(Temp) := '';
- end;
-
-var
- Source1Len, Source2Len: Integer;
- NewStr: PWideChar;
-begin
- Source1Len := Length(Source1);
- Source2Len := Length(Source2);
- if (Source1Len <> 0) or (Source2Len <> 0) then
- begin
- NewStr := NewWideString(Source1Len + Source2Len);
- Move(Pointer(Source1)^, Pointer(NewStr)^, Source1Len * sizeof(WideChar));
- Move(Pointer(Source2)^, NewStr[Source1Len], Source2Len * sizeof(WideChar));
- WStrSet(Dest, NewStr);
- end else
- Dest := '';
-end;
-
-{$ENDIF}
-
-//--------------------------------------------------------------------
-// System proc replacements
-//--------------------------------------------------------------------
-
-type
- POverwrittenData = ^TOverwrittenData;
- TOverwrittenData = record
- Location: Pointer;
- OldCode: array[0..6] of Byte;
- end;
-
-procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer; Data: POverwrittenData = nil);
-{ OverwriteProcedure originally from Igor Siticov }
-{ Modified by Jacques Garcia Vazquez }
-var
- x: PAnsiChar;
- y: integer;
- ov2, ov: cardinal;
- p: pointer;
-begin
- if Assigned(Data) and (Data.Location <> nil) then
- exit; { procedure already overwritten }
-
- // need six bytes in place of 5
- x := PAnsiChar(OldProcedure);
- if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
- RaiseLastOSError;
-
- // if a jump is present then a redirect is found
- // $FF25 = jmp dword ptr [xxx]
- // This redirect is normally present in bpl files, but not in exe files
- p := OldProcedure;
-
- if Word(p^) = $25FF then
- begin
- Inc(Integer(p), 2); // skip the jump
- // get the jump address p^ and dereference it p^^
- p := Pointer(Pointer(p^)^);
-
- // release the memory
- if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
- RaiseLastOSError;
-
- // re protect the correct one
- x := PAnsiChar(p);
- if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
- RaiseLastOSError;
- end;
-
- if Assigned(Data) then
- begin
- Move(x^, Data.OldCode, 6);
- { Assign Location last so that Location <> nil only if OldCode is properly initialized. }
- Data.Location := x;
- end;
-
- x[0] := AnsiChar($E9);
- y := integer(NewProcedure) - integer(p) - 5;
- x[1] := AnsiChar(y and 255);
- x[2] := AnsiChar((y shr 8) and 255);
- x[3] := AnsiChar((y shr 16) and 255);
- x[4] := AnsiChar((y shr 24) and 255);
-
- if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
- RaiseLastOSError;
-end;
-
-procedure RestoreProcedure(OriginalProc: Pointer; Data: TOverwrittenData);
-var
- ov, ov2: Cardinal;
-begin
- if Data.Location <> nil then begin
- if not VirtualProtect(Data.Location, 6, PAGE_EXECUTE_READWRITE, @ov) then
- RaiseLastOSError;
- Move(Data.OldCode, Data.Location^, 6);
- if not VirtualProtect(Data.Location, 6, ov, @ov2) then
- RaiseLastOSError;
- end;
-end;
-
-function Addr_System_EndThread: Pointer;
-begin
- Result := @System.EndThread;
-end;
-
-function Addr_System_LoadResString: Pointer;
-begin
- Result := @System.LoadResString{TNT-ALLOW LoadResString};
-end;
-
-function Addr_System_WStrFromPCharLen: Pointer;
-asm
- mov eax, offset System.@WStrFromPCharLen;
-end;
-
-{$IFNDEF COMPILER_9_UP}
-function Addr_System_LStrFromPWCharLen: Pointer;
-asm
- mov eax, offset System.@LStrFromPWCharLen;
-end;
-
-function Addr_System_WStrToString: Pointer;
-asm
- mov eax, offset System.@WStrToString;
-end;
-{$ENDIF}
-
-function Addr_System_VarFromLStr: Pointer;
-asm
- mov eax, offset System.@VarFromLStr;
-end;
-
-function Addr_System_WStrCat3: Pointer;
-asm
- mov eax, offset System.@WStrCat3;
-end;
-
-var
- System_EndThread_Code,
- System_LoadResString_Code,
- System_WStrFromPCharLen_Code,
- {$IFNDEF COMPILER_9_UP}
- System_LStrFromPWCharLen_Code,
- System_WStrToString_Code,
- {$ENDIF}
- System_VarFromLStr_Code
- {$IFNDEF COMPILER_9_UP}
- ,
- System_WStrCat3_Code,
- SysUtils_WideFmtStr_Code
- {$ENDIF}
- : TOverwrittenData;
-
-procedure InstallEndThreadOverride;
-begin
- OverwriteProcedure(Addr_System_EndThread, @Custom_System_EndThread, @System_EndThread_Code);
-end;
-
-procedure InstallStringConversionOverrides;
-begin
- OverwriteProcedure(Addr_System_WStrFromPCharLen, @Custom_System_WStrFromPCharLen, @System_WStrFromPCharLen_Code);
- {$IFNDEF COMPILER_9_UP}
- OverwriteProcedure(Addr_System_LStrFromPWCharLen, @Custom_System_LStrFromPWCharLen, @System_LStrFromPWCharLen_Code);
- OverwriteProcedure(Addr_System_WStrToString, @Custom_System_WStrToString, @System_WStrToString_Code);
- {$ENDIF}
-end;
-
-procedure InstallWideResourceStrings;
-begin
- OverwriteProcedure(Addr_System_LoadResString, @Custom_System_LoadResString, @System_LoadResString_Code);
- OverwriteProcedure(Addr_System_VarFromLStr, @Custom_System_VarFromLStr, @System_VarFromLStr_Code);
-end;
-
-{$IFNDEF COMPILER_9_UP}
-procedure InstallWideStringConcatenationFix;
-begin
- OverwriteProcedure(Addr_System_WStrCat3, @Custom_System_WStrCat3, @System_WStrCat3_Code);
-end;
-
-procedure InstallWideFormatFixes;
-begin
- OverwriteProcedure(@SysUtils.WideFmtStr, @TntSysUtils.Tnt_WideFmtStr, @SysUtils_WideFmtStr_Code);
-end;
-{$ENDIF}
-
-procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
-begin
- InstallEndThreadOverride;
- if tsWideResourceStrings in Updates then begin
- InstallStringConversionOverrides;
- InstallWideResourceStrings;
- end;
- {$IFNDEF COMPILER_9_UP}
- if tsFixImplicitCodePage in Updates then begin
- InstallStringConversionOverrides;
- { CP_ACP is the code page used by the non-Unicode Windows API. }
- GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
- end;
- if tsFixWideStrConcat in Updates then begin
- InstallWideStringConcatenationFix;
- end;
- if tsFixWideFormat in Updates then begin
- InstallWideFormatFixes;
- end;
- {$ENDIF}
-end;
-
-{$IFNDEF COMPILER_9_UP}
-var
- StartupDefaultUserCodePage: Cardinal;
-{$ENDIF}
-
-procedure UninstallSystemOverrides;
-begin
- RestoreProcedure(Addr_System_EndThread, System_EndThread_Code);
- // String Conversion
- RestoreProcedure(Addr_System_WStrFromPCharLen, System_WStrFromPCharLen_Code);
- {$IFNDEF COMPILER_9_UP}
- RestoreProcedure(Addr_System_LStrFromPWCharLen, System_LStrFromPWCharLen_Code);
- RestoreProcedure(Addr_System_WStrToString, System_WStrToString_Code);
- GDefaultSystemCodePage := StartupDefaultUserCodePage;
- {$ENDIF}
- // Wide resourcestring
- RestoreProcedure(Addr_System_LoadResString, System_LoadResString_Code);
- RestoreProcedure(Addr_System_VarFromLStr, System_VarFromLStr_Code);
- {$IFNDEF COMPILER_9_UP}
- // WideString concat fix
- RestoreProcedure(Addr_System_WStrCat3, System_WStrCat3_Code);
- // WideFormat fixes
- RestoreProcedure(@SysUtils.WideFmtStr, SysUtils_WideFmtStr_Code);
- {$ENDIF}
-end;
-
-initialization
- {$IFDEF COMPILER_9_UP}
- GDefaultSystemCodePage := GetACP;
- {$ELSE}
- {$IFDEF COMPILER_7_UP}
- if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
- GDefaultSystemCodePage := CP_THREAD_ACP // Win 2K/XP/...
- else
- GDefaultSystemCodePage := LCIDToCodePage(GetThreadLocale); // Win NT4/95/98/ME
- {$ELSE}
- GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF COMPILER_9_UP}
- StartupDefaultUserCodePage := DefaultSystemCodePage;
- {$ENDIF}
- IsDebugging := DebugHook > 0;
-
-finalization
- UninstallSystemOverrides;
- FreeTntSystemThreadVars; { Make MemorySleuth happy. }
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWideStrUtils.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWideStrUtils.pas deleted file mode 100644 index 02a64bbc3e..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWideStrUtils.pas +++ /dev/null @@ -1,451 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntWideStrUtils;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ Wide string manipulation functions }
-
-{$IFNDEF COMPILER_9_UP}
-function WStrAlloc(Size: Cardinal): PWideChar;
-function WStrBufSize(const Str: PWideChar): Cardinal;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_9_UP}
-function WStrNew(const Str: PWideChar): PWideChar;
-procedure WStrDispose(Str: PWideChar);
-{$ENDIF}
-//---------------------------------------------------------------------------------------------
-{$IFNDEF COMPILER_9_UP}
-function WStrLen(Str: PWideChar): Cardinal;
-function WStrEnd(Str: PWideChar): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_9_UP}
-function WStrCopy(Dest, Source: PWideChar): PWideChar;
-function WStrLCopy(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
-function WStrPCopy(Dest: PWideChar; const Source: WideString): PWideChar;
-function WStrPLCopy(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WStrScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-// WStrComp and WStrPos were introduced as broken in Delphi 2006, but fixed in Delphi 2006 Update 2
-function WStrComp(Str1, Str2: PWideChar): Integer;
-function WStrPos(Str, SubStr: PWideChar): PWideChar;
-{$ENDIF}
-function Tnt_WStrComp(Str1, Str2: PWideChar): Integer; deprecated;
-function Tnt_WStrPos(Str, SubStr: PWideChar): PWideChar; deprecated;
-
-{ ------------ introduced --------------- }
-function WStrECopy(Dest, Source: PWideChar): PWideChar;
-function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-function WStrLIComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-function WStrIComp(Str1, Str2: PWideChar): Integer;
-function WStrLower(Str: PWideChar): PWideChar;
-function WStrUpper(Str: PWideChar): PWideChar;
-function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-function WStrLCat(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
-function WStrPas(const Str: PWideChar): WideString;
-
-{ SysUtils.pas } //-------------------------------------------------------------------------
-
-{$IFNDEF COMPILER_10_UP}
-function WideLastChar(const S: WideString): PWideChar;
-function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
-{$ENDIF}
-{$IFNDEF COMPILER_9_UP}
-function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): Widestring;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
-{$ENDIF}
-
-implementation
-
-uses
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} Math, Windows, TntWindows;
-
-{$IFNDEF COMPILER_9_UP}
-function WStrAlloc(Size: Cardinal): PWideChar;
-begin
- Size := SizeOf(Cardinal) + (Size * SizeOf(WideChar));
- GetMem(Result, Size);
- PCardinal(Result)^ := Size;
- Inc(PAnsiChar(Result), SizeOf(Cardinal));
-end;
-
-function WStrBufSize(const Str: PWideChar): Cardinal;
-var
- P: PWideChar;
-begin
- P := Str;
- Dec(PAnsiChar(P), SizeOf(Cardinal));
- Result := PCardinal(P)^ - SizeOf(Cardinal);
- Result := Result div SizeOf(WideChar);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
-var
- Length: Integer;
-begin
- Result := Dest;
- Length := Count * SizeOf(WideChar);
- Move(Source^, Dest^, Length);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_9_UP}
-function WStrNew(const Str: PWideChar): PWideChar;
-var
- Size: Cardinal;
-begin
- if Str = nil then Result := nil else
- begin
- Size := WStrLen(Str) + 1;
- Result := WStrMove(WStrAlloc(Size), Str, Size);
- end;
-end;
-
-procedure WStrDispose(Str: PWideChar);
-begin
- if Str <> nil then
- begin
- Dec(PAnsiChar(Str), SizeOf(Cardinal));
- FreeMem(Str, Cardinal(Pointer(Str)^));
- end;
-end;
-{$ENDIF}
-
-//---------------------------------------------------------------------------------------------
-
-{$IFNDEF COMPILER_9_UP}
-function WStrLen(Str: PWideChar): Cardinal;
-begin
- Result := WStrEnd(Str) - Str;
-end;
-
-function WStrEnd(Str: PWideChar): PWideChar;
-begin
- // returns a pointer to the end of a null terminated string
- Result := Str;
- While Result^ <> #0 do
- Inc(Result);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
-begin
- Result := Dest;
- WStrCopy(WStrEnd(Dest), Source);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_9_UP}
-function WStrCopy(Dest, Source: PWideChar): PWideChar;
-begin
- Result := WStrLCopy(Dest, Source, MaxInt);
-end;
-
-function WStrLCopy(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
-var
- Count: Cardinal;
-begin
- // copies a specified maximum number of characters from Source to Dest
- Result := Dest;
- Count := 0;
- While (Count < MaxLen) and (Source^ <> #0) do begin
- Dest^ := Source^;
- Inc(Source);
- Inc(Dest);
- Inc(Count);
- end;
- Dest^ := #0;
-end;
-
-function WStrPCopy(Dest: PWideChar; const Source: WideString): PWideChar;
-begin
- Result := WStrLCopy(Dest, PWideChar(Source), Length(Source));
-end;
-
-function WStrPLCopy(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar;
-begin
- Result := WStrLCopy(Dest, PWideChar(Source), MaxLen);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WStrScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-begin
- Result := Str;
- while Result^ <> Chr do
- begin
- if Result^ = #0 then
- begin
- Result := nil;
- Exit;
- end;
- Inc(Result);
- end;
-end;
-
-function WStrComp(Str1, Str2: PWideChar): Integer;
-begin
- Result := WStrLComp(Str1, Str2, MaxInt);
-end;
-
-function WStrPos(Str, SubStr: PWideChar): PWideChar;
-var
- PSave: PWideChar;
- P: PWideChar;
- PSub: PWideChar;
-begin
- // returns a pointer to the first occurance of SubStr in Str
- Result := nil;
- if (Str <> nil) and (Str^ <> #0) and (SubStr <> nil) and (SubStr^ <> #0) then begin
- P := Str;
- While P^ <> #0 do begin
- if P^ = SubStr^ then begin
- // investigate possibility here
- PSave := P;
- PSub := SubStr;
- While (P^ = PSub^) do begin
- Inc(P);
- Inc(PSub);
- if (PSub^ = #0) then begin
- Result := PSave;
- exit; // found a match
- end;
- if (P^ = #0) then
- exit; // no match, hit end of string
- end;
- P := PSave;
- end;
- Inc(P);
- end;
- end;
-end;
-{$ENDIF}
-
-function Tnt_WStrComp(Str1, Str2: PWideChar): Integer; deprecated;
-begin
- Result := WStrComp(Str1, Str2);
-end;
-
-function Tnt_WStrPos(Str, SubStr: PWideChar): PWideChar; deprecated;
-begin
- Result := WStrPos(Str, SubStr);
-end;
-
-//------------------------------------------------------------------------------
-
-function WStrECopy(Dest, Source: PWideChar): PWideChar;
-begin
- Result := WStrEnd(WStrCopy(Dest, Source));
-end;
-
-function WStrComp_EX(Str1, Str2: PWideChar; MaxLen: Cardinal; dwCmpFlags: Cardinal): Integer;
-var
- Len1, Len2: Integer;
-begin
- if MaxLen = Cardinal(MaxInt) then begin
- Len1 := -1;
- Len2 := -1;
- end else begin
- Len1 := Min(WStrLen(Str1), MaxLen);
- Len2 := Min(WStrLen(Str2), MaxLen);
- end;
- Result := Tnt_CompareStringW(GetThreadLocale, dwCmpFlags, Str1, Len1, Str2, Len2) - 2;
-end;
-
-function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-begin
- Result := WStrComp_EX(Str1, Str2, MaxLen, 0);
-end;
-
-function WStrLIComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-begin
- Result := WStrComp_EX(Str1, Str2, MaxLen, NORM_IGNORECASE);
-end;
-
-function WStrIComp(Str1, Str2: PWideChar): Integer;
-begin
- Result := WStrLIComp(Str1, Str2, MaxInt);
-end;
-
-function WStrLower(Str: PWideChar): PWideChar;
-begin
- Result := Str;
- Tnt_CharLowerBuffW(Str, WStrLen(Str))
-end;
-
-function WStrUpper(Str: PWideChar): PWideChar;
-begin
- Result := Str;
- Tnt_CharUpperBuffW(Str, WStrLen(Str))
-end;
-
-function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-var
- MostRecentFound: PWideChar;
-begin
- if Chr = #0 then
- Result := WStrEnd(Str)
- else
- begin
- Result := nil;
- MostRecentFound := Str;
- while True do
- begin
- while MostRecentFound^ <> Chr do
- begin
- if MostRecentFound^ = #0 then
- Exit;
- Inc(MostRecentFound);
- end;
- Result := MostRecentFound;
- Inc(MostRecentFound);
- end;
- end;
-end;
-
-function WStrLCat(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
-begin
- Result := Dest;
- WStrLCopy(WStrEnd(Dest), Source, MaxLen - WStrLen(Dest));
-end;
-
-function WStrPas(const Str: PWideChar): WideString;
-begin
- Result := Str;
-end;
-
-//---------------------------------------------------------------------------------------------
-
-{$IFNDEF COMPILER_10_UP}
-function WideLastChar(const S: WideString): PWideChar;
-begin
- if S = '' then
- Result := nil
- else
- Result := @S[Length(S)];
-end;
-
-function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
-var
- P, Src,
- Dest: PWideChar;
- AddCount: Integer;
-begin
- AddCount := 0;
- P := WStrScan(PWideChar(S), Quote);
- while (P <> nil) do
- begin
- Inc(P);
- Inc(AddCount);
- P := WStrScan(P, Quote);
- end;
-
- if AddCount = 0 then
- Result := Quote + S + Quote
- else
- begin
- SetLength(Result, Length(S) + AddCount + 2);
- Dest := PWideChar(Result);
- Dest^ := Quote;
- Inc(Dest);
- Src := PWideChar(S);
- P := WStrScan(Src, Quote);
- repeat
- Inc(P);
- Move(Src^, Dest^, 2 * (P - Src));
- Inc(Dest, P - Src);
- Dest^ := Quote;
- Inc(Dest);
- Src := P;
- P := WStrScan(Src, Quote);
- until P = nil;
- P := WStrEnd(Src);
- Move(Src^, Dest^, 2 * (P - Src));
- Inc(Dest, P - Src);
- Dest^ := Quote;
- end;
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_9_UP}
-function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): Widestring;
-var
- P, Dest: PWideChar;
- DropCount: Integer;
-begin
- Result := '';
- if (Src = nil) or (Src^ <> Quote) then Exit;
- Inc(Src);
- DropCount := 1;
- P := Src;
- Src := WStrScan(Src, Quote);
- while Src <> nil do // count adjacent pairs of quote chars
- begin
- Inc(Src);
- if Src^ <> Quote then Break;
- Inc(Src);
- Inc(DropCount);
- Src := WStrScan(Src, Quote);
- end;
- if Src = nil then Src := WStrEnd(P);
- if ((Src - P) <= 1) then Exit;
- if DropCount = 1 then
- SetString(Result, P, Src - P - 1)
- else
- begin
- SetLength(Result, Src - P - DropCount);
- Dest := PWideChar(Result);
- Src := WStrScan(P, Quote);
- while Src <> nil do
- begin
- Inc(Src);
- if Src^ <> Quote then Break;
- Move(P^, Dest^, (Src - P) * SizeOf(WideChar));
- Inc(Dest, Src - P);
- Inc(Src);
- P := Src;
- Src := WStrScan(Src, Quote);
- end;
- if Src = nil then Src := WStrEnd(P);
- Move(P^, Dest^, (Src - P - 1) * SizeOf(WideChar));
- end;
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
-var
- LText : PWideChar;
-begin
- LText := PWideChar(S);
- Result := WideExtractQuotedStr(LText, AQuote);
- if Result = '' then
- Result := S;
-end;
-{$ENDIF}
-
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWideStrings.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWideStrings.pas deleted file mode 100644 index dfe3755403..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWideStrings.pas +++ /dev/null @@ -1,831 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntWideStrings;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{$IFDEF COMPILER_10_UP}
- {$MESSAGE FATAL 'Do not refer to TntWideStrings.pas. It works correctly in Delphi 2006.'}
-{$ENDIF}
-
-uses
- Classes;
-
-{******************************************************************************}
-{ }
-{ Delphi 2005 introduced TWideStrings in WideStrings.pas. }
-{ Unfortunately, it was not ready for prime time. }
-{ Setting CommaText is not consistent, and it relies on CharNextW }
-{ Which is only available on Windows NT+. }
-{ }
-{******************************************************************************}
-
-type
- TWideStrings = class;
-
-{ IWideStringsAdapter interface }
-{ Maintains link between TWideStrings and IWideStrings implementations }
-
- IWideStringsAdapter = interface
- ['{25FE0E3B-66CB-48AA-B23B-BCFA67E8F5DA}']
- procedure ReferenceStrings(S: TWideStrings);
- procedure ReleaseStrings;
- end;
-
- TWideStringsEnumerator = class
- private
- FIndex: Integer;
- FStrings: TWideStrings;
- public
- constructor Create(AStrings: TWideStrings);
- function GetCurrent: WideString;
- function MoveNext: Boolean;
- property Current: WideString read GetCurrent;
- end;
-
-{ TWideStrings class }
-
- TWideStrings = class(TPersistent)
- private
- FDefined: TStringsDefined;
- FDelimiter: WideChar;
- FQuoteChar: WideChar;
- {$IFDEF COMPILER_7_UP}
- FNameValueSeparator: WideChar;
- {$ENDIF}
- 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 SetCommaText(const Value: WideString);
- procedure SetDelimitedText(const Value: WideString);
- procedure SetStringsAdapter(const Value: IWideStringsAdapter);
- procedure SetValue(const Name, Value: WideString);
- procedure WriteData(Writer: TWriter);
- function GetDelimiter: WideChar;
- procedure SetDelimiter(const Value: WideChar);
- function GetQuoteChar: WideChar;
- procedure SetQuoteChar(const Value: WideChar);
- function GetNameValueSeparator: WideChar;
- {$IFDEF COMPILER_7_UP}
- procedure SetNameValueSeparator(const Value: WideChar);
- {$ENDIF}
- function GetValueFromIndex(Index: Integer): WideString;
- procedure SetValueFromIndex(Index: Integer; const Value: WideString);
- protected
- procedure AssignTo(Dest: TPersistent); override;
- procedure DefineProperties(Filer: TFiler); override;
- 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 SetUpdateState(Updating: Boolean); virtual;
- property UpdateCount: Integer read FUpdateCount;
- function CompareStrings(const S1, S2: WideString): Integer; virtual;
- public
- destructor Destroy; override;
- function Add(const S: WideString): Integer; virtual;
- function AddObject(const S: WideString; AObject: TObject): Integer; virtual;
- procedure Append(const S: WideString);
- procedure AddStrings(Strings: TStrings{TNT-ALLOW TStrings}); overload; virtual;
- procedure AddStrings(Strings: TWideStrings); overload; virtual;
- procedure Assign(Source: TPersistent); override;
- procedure BeginUpdate;
- procedure Clear; virtual; abstract;
- procedure Delete(Index: Integer); virtual; abstract;
- procedure EndUpdate;
- function Equals(Strings: TWideStrings): Boolean;
- procedure Exchange(Index1, Index2: Integer); virtual;
- function GetEnumerator: TWideStringsEnumerator;
- 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); virtual;
- procedure Move(CurIndex, NewIndex: Integer); virtual;
- procedure SaveToFile(const FileName: WideString); virtual;
- procedure SaveToStream(Stream: TStream); 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 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 {$IFDEF COMPILER_7_UP} write SetNameValueSeparator {$ENDIF};
- property Strings[Index: Integer]: WideString read Get write Put; default;
- property Text: WideString read GetTextStr write SetTextStr;
- property StringsAdapter: IWideStringsAdapter read FAdapter write SetStringsAdapter;
- end;
-
- PWideStringItem = ^TWideStringItem;
- TWideStringItem = record
- FString: WideString;
- FObject: TObject;
- end;
-
- PWideStringItemList = ^TWideStringItemList;
- TWideStringItemList = array[0..MaxListSize] of TWideStringItem;
-
-implementation
-
-uses
- Windows, SysUtils, TntSystem, {$IFDEF COMPILER_9_UP} WideStrUtils, {$ELSE} TntWideStrUtils, {$ENDIF}
- TntSysUtils, TntClasses;
-
-{ TWideStringsEnumerator }
-
-constructor TWideStringsEnumerator.Create(AStrings: TWideStrings);
-begin
- inherited Create;
- FIndex := -1;
- FStrings := AStrings;
-end;
-
-function TWideStringsEnumerator.GetCurrent: WideString;
-begin
- Result := FStrings[FIndex];
-end;
-
-function TWideStringsEnumerator.MoveNext: Boolean;
-begin
- Result := FIndex < FStrings.Count - 1;
- if Result then
- Inc(FIndex);
-end;
-
-{ TWideStrings }
-
-destructor TWideStrings.Destroy;
-begin
- StringsAdapter := nil;
- inherited;
-end;
-
-function TWideStrings.Add(const S: WideString): Integer;
-begin
- Result := GetCount;
- Insert(Result, S);
-end;
-
-function TWideStrings.AddObject(const S: WideString; AObject: TObject): Integer;
-begin
- Result := Add(S);
- PutObject(Result, AObject);
-end;
-
-procedure TWideStrings.Append(const S: WideString);
-begin
- Add(S);
-end;
-
-procedure TWideStrings.AddStrings(Strings: TStrings{TNT-ALLOW TStrings});
-var
- I: Integer;
-begin
- BeginUpdate;
- try
- for I := 0 to Strings.Count - 1 do
- AddObject(Strings[I], Strings.Objects[I]);
- finally
- EndUpdate;
- end;
-end;
-
-procedure TWideStrings.AddStrings(Strings: TWideStrings);
-var
- I: Integer;
-begin
- BeginUpdate;
- try
- for I := 0 to Strings.Count - 1 do
- AddObject(Strings[I], Strings.Objects[I]);
- finally
- EndUpdate;
- end;
-end;
-
-procedure TWideStrings.Assign(Source: TPersistent);
-begin
- if Source is TWideStrings then
- begin
- BeginUpdate;
- try
- Clear;
- FDefined := TWideStrings(Source).FDefined;
- {$IFDEF COMPILER_7_UP}
- FNameValueSeparator := TWideStrings(Source).FNameValueSeparator;
- {$ENDIF}
- FQuoteChar := TWideStrings(Source).FQuoteChar;
- FDelimiter := TWideStrings(Source).FDelimiter;
- AddStrings(TWideStrings(Source));
- finally
- EndUpdate;
- end;
- end
- else if Source is TStrings{TNT-ALLOW TStrings} then
- begin
- BeginUpdate;
- try
- Clear;
- {$IFDEF COMPILER_7_UP}
- FNameValueSeparator := WideChar(TStrings{TNT-ALLOW TStrings}(Source).NameValueSeparator);
- {$ENDIF}
- FQuoteChar := WideChar(TStrings{TNT-ALLOW TStrings}(Source).QuoteChar);
- FDelimiter := WideChar(TStrings{TNT-ALLOW TStrings}(Source).Delimiter);
- AddStrings(TStrings{TNT-ALLOW TStrings}(Source));
- finally
- EndUpdate;
- end;
- end
- else
- inherited Assign(Source);
-end;
-
-procedure TWideStrings.AssignTo(Dest: TPersistent);
-var
- I: Integer;
-begin
- if Dest is TWideStrings then Dest.Assign(Self)
- else if Dest is TStrings{TNT-ALLOW TStrings} then
- begin
- TStrings{TNT-ALLOW TStrings}(Dest).BeginUpdate;
- try
- TStrings{TNT-ALLOW TStrings}(Dest).Clear;
- {$IFDEF COMPILER_7_UP}
- TStrings{TNT-ALLOW TStrings}(Dest).NameValueSeparator := AnsiChar(NameValueSeparator);
- {$ENDIF}
- TStrings{TNT-ALLOW TStrings}(Dest).QuoteChar := AnsiChar(QuoteChar);
- TStrings{TNT-ALLOW TStrings}(Dest).Delimiter := AnsiChar(Delimiter);
- for I := 0 to Count - 1 do
- TStrings{TNT-ALLOW TStrings}(Dest).AddObject(Strings[I], Objects[I]);
- finally
- TStrings{TNT-ALLOW TStrings}(Dest).EndUpdate;
- end;
- end
- else
- inherited AssignTo(Dest);
-end;
-
-procedure TWideStrings.BeginUpdate;
-begin
- if FUpdateCount = 0 then SetUpdateState(True);
- Inc(FUpdateCount);
-end;
-
-procedure TWideStrings.DefineProperties(Filer: TFiler);
-
- function DoWrite: Boolean;
- begin
- if Filer.Ancestor <> nil then
- begin
- Result := True;
- if Filer.Ancestor is TWideStrings then
- Result := not Equals(TWideStrings(Filer.Ancestor))
- end
- else Result := Count > 0;
- end;
-
-begin
- Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
-end;
-
-procedure TWideStrings.EndUpdate;
-begin
- Dec(FUpdateCount);
- if FUpdateCount = 0 then SetUpdateState(False);
-end;
-
-function TWideStrings.Equals(Strings: TWideStrings): Boolean;
-var
- I, Count: Integer;
-begin
- 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;
-
-procedure TWideStrings.Error(const Msg: WideString; Data: Integer);
-
- function ReturnAddr: Pointer;
- asm
- MOV EAX,[EBP+4]
- end;
-
-begin
- raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
-end;
-
-procedure TWideStrings.Error(Msg: PResStringRec; Data: Integer);
-begin
- Error(WideLoadResString(Msg), Data);
-end;
-
-procedure TWideStrings.Exchange(Index1, Index2: Integer);
-var
- TempObject: TObject;
- TempString: WideString;
-begin
- 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 TWideStrings.ExtractName(const S: WideString): WideString;
-var
- P: Integer;
-begin
- Result := S;
- P := Pos(NameValueSeparator, Result);
- if P <> 0 then
- SetLength(Result, P-1) else
- SetLength(Result, 0);
-end;
-
-function TWideStrings.GetCapacity: Integer;
-begin // descendents may optionally override/replace this default implementation
- Result := Count;
-end;
-
-function TWideStrings.GetCommaText: WideString;
-var
- LOldDefined: TStringsDefined;
- LOldDelimiter: WideChar;
- LOldQuoteChar: WideChar;
-begin
- LOldDefined := FDefined;
- LOldDelimiter := FDelimiter;
- LOldQuoteChar := FQuoteChar;
- Delimiter := ',';
- QuoteChar := '"';
- try
- Result := GetDelimitedText;
- finally
- FDelimiter := LOldDelimiter;
- FQuoteChar := LOldQuoteChar;
- FDefined := LOldDefined;
- end;
-end;
-
-function TWideStrings.GetDelimitedText: WideString;
-var
- S: WideString;
- P: PWideChar;
- I, Count: Integer;
-begin
- Count := GetCount;
- if (Count = 1) and (Get(0) = '') then
- Result := WideString(QuoteChar) + QuoteChar
- else
- begin
- 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 TWideStrings.GetName(Index: Integer): WideString;
-begin
- Result := ExtractName(Get(Index));
-end;
-
-function TWideStrings.GetObject(Index: Integer): TObject;
-begin
- Result := nil;
-end;
-
-function TWideStrings.GetEnumerator: TWideStringsEnumerator;
-begin
- Result := TWideStringsEnumerator.Create(Self);
-end;
-
-function TWideStrings.GetTextW: PWideChar;
-begin
- Result := WStrNew(PWideChar(GetTextStr));
-end;
-
-function TWideStrings.GetTextStr: WideString;
-var
- I, L, Size, Count: Integer;
- P: PWideChar;
- S, LB: WideString;
-begin
- 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
- S := Get(I);
- L := Length(S);
- if L <> 0 then
- begin
- System.Move(Pointer(S)^, P^, L * SizeOf(WideChar));
- Inc(P, L);
- end;
- L := Length(LB);
- if L <> 0 then
- begin
- System.Move(Pointer(LB)^, P^, L * SizeOf(WideChar));
- Inc(P, L);
- end;
- end;
-end;
-
-function TWideStrings.GetValue(const Name: WideString): WideString;
-var
- I: Integer;
-begin
- I := IndexOfName(Name);
- if I >= 0 then
- Result := Copy(Get(I), Length(Name) + 2, MaxInt) else
- Result := '';
-end;
-
-function TWideStrings.IndexOf(const S: WideString): Integer;
-begin
- for Result := 0 to GetCount - 1 do
- if CompareStrings(Get(Result), S) = 0 then Exit;
- Result := -1;
-end;
-
-function TWideStrings.IndexOfName(const Name: WideString): Integer;
-var
- P: Integer;
- S: WideString;
-begin
- for Result := 0 to GetCount - 1 do
- begin
- S := Get(Result);
- P := Pos(NameValueSeparator, S);
- if (P <> 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then Exit;
- end;
- Result := -1;
-end;
-
-function TWideStrings.IndexOfObject(AObject: TObject): Integer;
-begin
- for Result := 0 to GetCount - 1 do
- if GetObject(Result) = AObject then Exit;
- Result := -1;
-end;
-
-procedure TWideStrings.InsertObject(Index: Integer; const S: WideString;
- AObject: TObject);
-begin
- Insert(Index, S);
- PutObject(Index, AObject);
-end;
-
-procedure TWideStrings.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TWideStrings.LoadFromStream(Stream: TStream);
-var
- Size: Integer;
- S: WideString;
-begin
- BeginUpdate;
- try
- Size := Stream.Size - Stream.Position;
- SetString(S, nil, Size div SizeOf(WideChar));
- Stream.Read(Pointer(S)^, Length(S) * SizeOf(WideChar));
- SetTextStr(S);
- finally
- EndUpdate;
- end;
-end;
-
-procedure TWideStrings.Move(CurIndex, NewIndex: Integer);
-var
- TempObject: TObject;
- TempString: WideString;
-begin
- if CurIndex <> NewIndex then
- begin
- BeginUpdate;
- try
- TempString := Get(CurIndex);
- TempObject := GetObject(CurIndex);
- Delete(CurIndex);
- InsertObject(NewIndex, TempString, TempObject);
- finally
- EndUpdate;
- end;
- end;
-end;
-
-procedure TWideStrings.Put(Index: Integer; const S: WideString);
-var
- TempObject: TObject;
-begin
- TempObject := GetObject(Index);
- Delete(Index);
- InsertObject(Index, S, TempObject);
-end;
-
-procedure TWideStrings.PutObject(Index: Integer; AObject: TObject);
-begin
-end;
-
-procedure TWideStrings.ReadData(Reader: TReader);
-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;
- end;
-end;
-
-procedure TWideStrings.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TWideStrings.SaveToStream(Stream: TStream);
-var
- SW: WideString;
-begin
- SW := GetTextStr;
- Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
-end;
-
-procedure TWideStrings.SetCapacity(NewCapacity: Integer);
-begin
- // do nothing - descendents may optionally implement this method
-end;
-
-procedure TWideStrings.SetCommaText(const Value: WideString);
-begin
- Delimiter := ',';
- QuoteChar := '"';
- SetDelimitedText(Value);
-end;
-
-procedure TWideStrings.SetStringsAdapter(const Value: IWideStringsAdapter);
-begin
- if FAdapter <> nil then FAdapter.ReleaseStrings;
- FAdapter := Value;
- if FAdapter <> nil then FAdapter.ReferenceStrings(Self);
-end;
-
-procedure TWideStrings.SetTextW(const Text: PWideChar);
-begin
- SetTextStr(Text);
-end;
-
-procedure TWideStrings.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 TWideStrings.SetUpdateState(Updating: Boolean);
-begin
-end;
-
-procedure TWideStrings.SetValue(const Name, Value: WideString);
-var
- I: Integer;
-begin
- 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;
-
-procedure TWideStrings.WriteData(Writer: TWriter);
-var
- I: Integer;
-begin
- Writer.WriteListBegin;
- for I := 0 to Count-1 do begin
- Writer.WriteWideString(Get(I));
- end;
- Writer.WriteListEnd;
-end;
-
-procedure TWideStrings.SetDelimitedText(const Value: WideString);
-var
- P, P1: PWideChar;
- S: WideString;
-begin
- 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;
-
-function TWideStrings.GetDelimiter: WideChar;
-begin
- if not (sdDelimiter in FDefined) then
- Delimiter := ',';
- Result := FDelimiter;
-end;
-
-function TWideStrings.GetQuoteChar: WideChar;
-begin
- if not (sdQuoteChar in FDefined) then
- QuoteChar := '"';
- Result := FQuoteChar;
-end;
-
-procedure TWideStrings.SetDelimiter(const Value: WideChar);
-begin
- if (FDelimiter <> Value) or not (sdDelimiter in FDefined) then
- begin
- Include(FDefined, sdDelimiter);
- FDelimiter := Value;
- end
-end;
-
-procedure TWideStrings.SetQuoteChar(const Value: WideChar);
-begin
- if (FQuoteChar <> Value) or not (sdQuoteChar in FDefined) then
- begin
- Include(FDefined, sdQuoteChar);
- FQuoteChar := Value;
- end
-end;
-
-function TWideStrings.CompareStrings(const S1, S2: WideString): Integer;
-begin
- Result := WideCompareText(S1, S2);
-end;
-
-function TWideStrings.GetNameValueSeparator: WideChar;
-begin
- {$IFDEF COMPILER_7_UP}
- if not (sdNameValueSeparator in FDefined) then
- NameValueSeparator := '=';
- Result := FNameValueSeparator;
- {$ELSE}
- Result := '=';
- {$ENDIF}
-end;
-
-{$IFDEF COMPILER_7_UP}
-procedure TWideStrings.SetNameValueSeparator(const Value: WideChar);
-begin
- if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then
- begin
- Include(FDefined, sdNameValueSeparator);
- FNameValueSeparator := Value;
- end
-end;
-{$ENDIF}
-
-function TWideStrings.GetValueFromIndex(Index: Integer): WideString;
-begin
- if Index >= 0 then
- Result := Copy(Get(Index), Length(Names[Index]) + 2, MaxInt) else
- Result := '';
-end;
-
-procedure TWideStrings.SetValueFromIndex(Index: Integer; const Value: WideString);
-begin
- 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;
-
-end.
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWindows.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWindows.pas deleted file mode 100644 index 12d74d8344..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntWindows.pas +++ /dev/null @@ -1,1452 +0,0 @@ -
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntWindows;
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Windows, ShellApi, ShlObj;
-
-// ......... compatibility
-
-const
- DT_NOFULLWIDTHCHARBREAK = $00080000;
-
-const
- INVALID_FILE_ATTRIBUTES = DWORD(-1);
-
-// ................ ANSI TYPES ................
-{TNT-WARN LPSTR}
-{TNT-WARN PLPSTR}
-{TNT-WARN LPCSTR}
-{TNT-WARN LPCTSTR}
-{TNT-WARN LPTSTR}
-
-// ........ EnumResourceTypesW, EnumResourceNamesW and EnumResourceLanguagesW are supposed ....
-// ........ to work on Win95/98/ME but have caused access violations in testing on Win95 ......
-// .. TNT--WARN EnumResourceTypes ..
-// .. TNT--WARN EnumResourceTypesA ..
-// .. TNT--WARN EnumResourceNames ..
-// .. TNT--WARN EnumResourceNamesA ..
-// .. TNT--WARN EnumResourceLanguages ..
-// .. TNT--WARN EnumResourceLanguagesA ..
-
-//------------------------------------------------------------------------------------------
-
-// ......... The Unicode form of these functions are supported on Windows 95/98/ME .........
-{TNT-WARN ExtTextOut}
-{TNT-WARN ExtTextOutA}
-{TNT-WARN Tnt_ExtTextOutW}
-
-{TNT-WARN FindResource}
-{TNT-WARN FindResourceA}
-{TNT-WARN Tnt_FindResourceW}
-
-{TNT-WARN FindResourceEx}
-{TNT-WARN FindResourceExA}
-{TNT-WARN Tnt_FindResourceExW}
-
-{TNT-WARN GetCharWidth}
-{TNT-WARN GetCharWidthA}
-{TNT-WARN Tnt_GetCharWidthW}
-
-{TNT-WARN GetCommandLine}
-{TNT-WARN GetCommandLineA}
-{TNT-WARN Tnt_GetCommandLineW}
-
-{TNT-WARN GetTextExtentPoint}
-{TNT-WARN GetTextExtentPointA}
-{TNT-WARN Tnt_GetTextExtentPointW}
-
-{TNT-WARN GetTextExtentPoint32}
-{TNT-WARN GetTextExtentPoint32A}
-{TNT-WARN Tnt_GetTextExtentPoint32W}
-
-{TNT-WARN lstrcat}
-{TNT-WARN lstrcatA}
-{TNT-WARN Tnt_lstrcatW}
-
-{TNT-WARN lstrcpy}
-{TNT-WARN lstrcpyA}
-{TNT-WARN Tnt_lstrcpyW}
-
-{TNT-WARN lstrlen}
-{TNT-WARN lstrlenA}
-{TNT-WARN Tnt_lstrlenW}
-
-{TNT-WARN MessageBox}
-{TNT-WARN MessageBoxA}
-{TNT-WARN Tnt_MessageBoxW}
-
-{TNT-WARN MessageBoxEx}
-{TNT-WARN MessageBoxExA}
-{TNT-WARN Tnt_MessageBoxExA}
-
-{TNT-WARN TextOut}
-{TNT-WARN TextOutA}
-{TNT-WARN Tnt_TextOutW}
-
-//------------------------------------------------------------------------------------------
-
-{TNT-WARN LOCALE_USER_DEFAULT} // <-- use GetThreadLocale
-{TNT-WARN LOCALE_SYSTEM_DEFAULT} // <-- use GetThreadLocale
-
-//------------------------------------------------------------------------------------------
-// compatiblity
-//------------------------------------------------------------------------------------------
-{$IFNDEF COMPILER_9_UP}
-type
- TStartupInfoA = _STARTUPINFOA;
- TStartupInfoW = record
- cb: DWORD;
- lpReserved: PWideChar;
- lpDesktop: PWideChar;
- lpTitle: PWideChar;
- dwX: DWORD;
- dwY: DWORD;
- dwXSize: DWORD;
- dwYSize: DWORD;
- dwXCountChars: DWORD;
- dwYCountChars: DWORD;
- dwFillAttribute: DWORD;
- dwFlags: DWORD;
- wShowWindow: Word;
- cbReserved2: Word;
- lpReserved2: PByte;
- hStdInput: THandle;
- hStdOutput: THandle;
- hStdError: THandle;
- end;
-
-function CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
- var lpProcessInformation: TProcessInformation): BOOL; stdcall; external kernel32 name 'CreateProcessW';
-
-{$ENDIF}
-//------------------------------------------------------------------------------------------
-
-{TNT-WARN SetWindowText}
-{TNT-WARN SetWindowTextA}
-{TNT-WARN SetWindowTextW}
-function Tnt_SetWindowTextW(hWnd: HWND; lpString: PWideChar): BOOL;
-
-{TNT-WARN RemoveDirectory}
-{TNT-WARN RemoveDirectoryA}
-{TNT-WARN RemoveDirectoryW}
-function Tnt_RemoveDirectoryW(lpPathName: PWideChar): BOOL;
-
-{TNT-WARN GetShortPathName}
-{TNT-WARN GetShortPathNameA}
-{TNT-WARN GetShortPathNameW}
-function Tnt_GetShortPathNameW(lpszLongPath: PWideChar; lpszShortPath: PWideChar;
- cchBuffer: DWORD): DWORD;
-
-{TNT-WARN GetFullPathName}
-{TNT-WARN GetFullPathNameA}
-{TNT-WARN GetFullPathNameW}
-function Tnt_GetFullPathNameW(lpFileName: PWideChar; nBufferLength: DWORD;
- lpBuffer: PWideChar; var lpFilePart: PWideChar): DWORD;
-
-{TNT-WARN CreateFile}
-{TNT-WARN CreateFileA}
-{TNT-WARN CreateFileW}
-function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
- lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
- hTemplateFile: THandle): THandle;
-
-{TNT-WARN FindFirstFile}
-{TNT-WARN FindFirstFileA}
-{TNT-WARN FindFirstFileW}
-function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
-
-{TNT-WARN FindNextFile}
-{TNT-WARN FindNextFileA}
-{TNT-WARN FindNextFileW}
-function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
-
-{TNT-WARN GetFileAttributes}
-{TNT-WARN GetFileAttributesA}
-{TNT-WARN GetFileAttributesW}
-function Tnt_GetFileAttributesW(lpFileName: PWideChar): DWORD;
-
-{TNT-WARN SetFileAttributes}
-{TNT-WARN SetFileAttributesA}
-{TNT-WARN SetFileAttributesW}
-function Tnt_SetFileAttributesW(lpFileName: PWideChar; dwFileAttributes: DWORD): BOOL;
-
-{TNT-WARN CreateDirectory}
-{TNT-WARN CreateDirectoryA}
-{TNT-WARN CreateDirectoryW}
-function Tnt_CreateDirectoryW(lpPathName: PWideChar;
- lpSecurityAttributes: PSecurityAttributes): BOOL;
-
-{TNT-WARN MoveFile}
-{TNT-WARN MoveFileA}
-{TNT-WARN MoveFileW}
-function Tnt_MoveFileW(lpExistingFileName, lpNewFileName: PWideChar): BOOL;
-
-{TNT-WARN CopyFile}
-{TNT-WARN CopyFileA}
-{TNT-WARN CopyFileW}
-function Tnt_CopyFileW(lpExistingFileName, lpNewFileName: PWideChar; bFailIfExists: BOOL): BOOL;
-
-{TNT-WARN DeleteFile}
-{TNT-WARN DeleteFileA}
-{TNT-WARN DeleteFileW}
-function Tnt_DeleteFileW(lpFileName: PWideChar): BOOL;
-
-{TNT-WARN DrawText}
-{TNT-WARN DrawTextA}
-{TNT-WARN DrawTextW}
-function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
- var lpRect: TRect; uFormat: UINT): Integer;
-
-{TNT-WARN GetDiskFreeSpace}
-{TNT-WARN GetDiskFreeSpaceA}
-{TNT-WARN GetDiskFreeSpaceW}
-function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
- lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
-
-{TNT-WARN GetVolumeInformation}
-{TNT-WARN GetVolumeInformationA}
-{TNT-WARN GetVolumeInformationW}
-function Tnt_GetVolumeInformationW(lpRootPathName: PWideChar; lpVolumeNameBuffer: PWideChar;
- nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
- var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: PWideChar;
- nFileSystemNameSize: DWORD): BOOL;
-
-{TNT-WARN GetModuleFileName}
-{TNT-WARN GetModuleFileNameA}
-{TNT-WARN GetModuleFileNameW}
-function Tnt_GetModuleFileNameW(hModule: HINST; lpFilename: PWideChar; nSize: DWORD): DWORD;
-
-{TNT-WARN GetTempPath}
-{TNT-WARN GetTempPathA}
-{TNT-WARN GetTempPathW}
-function Tnt_GetTempPathW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-
-{TNT-WARN GetTempFileName}
-{TNT-WARN GetTempFileNameA}
-{TNT-WARN GetTempFileNameW}
-function Tnt_GetTempFileNameW(lpPathName, lpPrefixString: PWideChar; uUnique: UINT;
- lpTempFileName: PWideChar): UINT;
-
-{TNT-WARN GetWindowsDirectory}
-{TNT-WARN GetWindowsDirectoryA}
-{TNT-WARN GetWindowsDirectoryW}
-function Tnt_GetWindowsDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-
-{TNT-WARN GetSystemDirectory}
-{TNT-WARN GetSystemDirectoryA}
-{TNT-WARN GetSystemDirectoryW}
-function Tnt_GetSystemDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-
-{TNT-WARN GetCurrentDirectory}
-{TNT-WARN GetCurrentDirectoryA}
-{TNT-WARN GetCurrentDirectoryW}
-function Tnt_GetCurrentDirectoryW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-
-{TNT-WARN SetCurrentDirectory}
-{TNT-WARN SetCurrentDirectoryA}
-{TNT-WARN SetCurrentDirectoryW}
-function Tnt_SetCurrentDirectoryW(lpPathName: PWideChar): BOOL;
-
-{TNT-WARN GetComputerName}
-{TNT-WARN GetComputerNameA}
-{TNT-WARN GetComputerNameW}
-function Tnt_GetComputerNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-
-{TNT-WARN GetUserName}
-{TNT-WARN GetUserNameA}
-{TNT-WARN GetUserNameW}
-function Tnt_GetUserNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-
-{TNT-WARN ShellExecute}
-{TNT-WARN ShellExecuteA}
-{TNT-WARN ShellExecuteW}
-function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
- Directory: PWideChar; ShowCmd: Integer): HINST;
-
-{TNT-WARN LoadLibrary}
-{TNT-WARN LoadLibraryA}
-{TNT-WARN LoadLibraryW}
-function Tnt_LoadLibraryW(lpLibFileName: PWideChar): HMODULE;
-
-{TNT-WARN LoadLibraryEx}
-{TNT-WARN LoadLibraryExA}
-{TNT-WARN LoadLibraryExW}
-function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
-
-{TNT-WARN CreateProcess}
-{TNT-WARN CreateProcessA}
-{TNT-WARN CreateProcessW}
-function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
- var lpProcessInformation: TProcessInformation): BOOL;
-
-{TNT-WARN GetCurrencyFormat}
-{TNT-WARN GetCurrencyFormatA}
-{TNT-WARN GetCurrencyFormatW}
-function Tnt_GetCurrencyFormatW(Locale: LCID; dwFlags: DWORD; lpValue: PWideChar;
- lpFormat: PCurrencyFmtW; lpCurrencyStr: PWideChar; cchCurrency: Integer): Integer;
-
-{TNT-WARN CompareString}
-{TNT-WARN CompareStringA}
-{TNT-WARN CompareStringW}
-function Tnt_CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
- cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer;
-
-{TNT-WARN CharUpper}
-{TNT-WARN CharUpperA}
-{TNT-WARN CharUpperW}
-function Tnt_CharUpperW(lpsz: PWideChar): PWideChar;
-
-{TNT-WARN CharUpperBuff}
-{TNT-WARN CharUpperBuffA}
-{TNT-WARN CharUpperBuffW}
-function Tnt_CharUpperBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-
-{TNT-WARN CharLower}
-{TNT-WARN CharLowerA}
-{TNT-WARN CharLowerW}
-function Tnt_CharLowerW(lpsz: PWideChar): PWideChar;
-
-{TNT-WARN CharLowerBuff}
-{TNT-WARN CharLowerBuffA}
-{TNT-WARN CharLowerBuffW}
-function Tnt_CharLowerBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-
-{TNT-WARN GetStringTypeEx}
-{TNT-WARN GetStringTypeExA}
-{TNT-WARN GetStringTypeExW}
-function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
- lpSrcStr: PWideChar; cchSrc: Integer; var lpCharType): BOOL;
-
-{TNT-WARN LoadString}
-{TNT-WARN LoadStringA}
-{TNT-WARN LoadStringW}
-function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
-
-{TNT-WARN InsertMenuItem}
-{TNT-WARN InsertMenuItemA}
-{TNT-WARN InsertMenuItemW}
-function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: tagMenuItemINFOW): BOOL;
-
-{TNT-WARN ExtractIconEx}
-{TNT-WARN ExtractIconExA}
-{TNT-WARN ExtractIconExW}
-function Tnt_ExtractIconExW(lpszFile: PWideChar; nIconIndex: Integer;
- var phiconLarge, phiconSmall: HICON; nIcons: UINT): UINT;
-
-{TNT-WARN ExtractAssociatedIcon}
-{TNT-WARN ExtractAssociatedIconA}
-{TNT-WARN ExtractAssociatedIconW}
-function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
- var lpiIcon: Word): HICON;
-
-{TNT-WARN GetFileVersionInfoSize}
-{TNT-WARN GetFileVersionInfoSizeA}
-{TNT-WARN GetFileVersionInfoSizeW}
-function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
-
-{TNT-WARN GetFileVersionInfo}
-{TNT-WARN GetFileVersionInfoA}
-{TNT-WARN GetFileVersionInfoW}
-function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
- lpData: Pointer): BOOL;
-
-const
- VQV_FIXEDFILEINFO = '\';
- VQV_VARFILEINFO_TRANSLATION = '\VarFileInfo\Translation';
- VQV_STRINGFILEINFO = '\StringFileInfo';
-
- VER_COMMENTS = 'Comments';
- VER_INTERNALNAME = 'InternalName';
- VER_PRODUCTNAME = 'ProductName';
- VER_COMPANYNAME = 'CompanyName';
- VER_LEGALCOPYRIGHT = 'LegalCopyright';
- VER_PRODUCTVERSION = 'ProductVersion';
- VER_FILEDESCRIPTION = 'FileDescription';
- VER_LEGALTRADEMARKS = 'LegalTrademarks';
- VER_PRIVATEBUILD = 'PrivateBuild';
- VER_FILEVERSION = 'FileVersion';
- VER_ORIGINALFILENAME = 'OriginalFilename';
- VER_SPECIALBUILD = 'SpecialBuild';
-
-{TNT-WARN VerQueryValue}
-{TNT-WARN VerQueryValueA}
-{TNT-WARN VerQueryValueW}
-function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
- var lplpBuffer: Pointer; var puLen: UINT): BOOL;
-
-type
- TSHNameMappingHeaderA = record
- cNumOfMappings: Cardinal;
- lpNM: PSHNAMEMAPPINGA;
- end;
- PSHNameMappingHeaderA = ^TSHNameMappingHeaderA;
-
- TSHNameMappingHeaderW = record
- cNumOfMappings: Cardinal;
- lpNM: PSHNAMEMAPPINGW;
- end;
- PSHNameMappingHeaderW = ^TSHNameMappingHeaderW;
-
-{TNT-WARN SHFileOperation}
-{TNT-WARN SHFileOperationA}
-{TNT-WARN SHFileOperationW} // <-- no stub on early Windows 95
-function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;
-
-{TNT-WARN SHFreeNameMappings}
-procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);
-
-{TNT-WARN SHBrowseForFolder}
-{TNT-WARN SHBrowseForFolderA}
-{TNT-WARN SHBrowseForFolderW} // <-- no stub on early Windows 95
-function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;
-
-{TNT-WARN SHGetPathFromIDList}
-{TNT-WARN SHGetPathFromIDListA}
-{TNT-WARN SHGetPathFromIDListW} // <-- no stub on early Windows 95
-function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;
-
-{TNT-WARN SHGetFileInfo}
-{TNT-WARN SHGetFileInfoA}
-{TNT-WARN SHGetFileInfoW} // <-- no stub on early Windows 95
-function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
- var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;
-
-// ......... introduced .........
-function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
-
-function LANGIDFROMLCID(lcid: LCID): WORD;
-function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
-function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
-function PRIMARYLANGID(lgid: WORD): WORD;
-function SORTIDFROMLCID(lcid: LCID): WORD;
-function SUBLANGID(lgid: WORD): WORD;
-
-implementation
-
-uses
- SysUtils, Math, TntSysUtils,
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
-
-function _PAnsiCharWithNil(const S: AnsiString): PAnsiChar;
-begin
- if S = '' then
- Result := nil {Win9x needs nil for some parameters instead of empty strings}
- else
- Result := PAnsiChar(S);
-end;
-
-function _PWideCharWithNil(const S: WideString): PWideChar;
-begin
- if S = '' then
- Result := nil {Win9x needs nil for some parameters instead of empty strings}
- else
- Result := PWideChar(S);
-end;
-
-function _WStr(lpString: PWideChar; cchCount: Integer): WideString;
-begin
- if cchCount = -1 then
- Result := lpString
- else
- Result := Copy(WideString(lpString), 1, cchCount);
-end;
-
-procedure _MakeWideWin32FindData(var WideFindData: TWIN32FindDataW; AnsiFindData: TWIN32FindDataA);
-begin
- CopyMemory(@WideFindData, @AnsiFindData,
- Integer(@WideFindData.cFileName) - Integer(@WideFindData));
- WStrPCopy(WideFindData.cFileName, AnsiFindData.cFileName);
- WStrPCopy(WideFindData.cAlternateFileName, AnsiFindData.cAlternateFileName);
-end;
-
-function Tnt_SetWindowTextW(hWnd: HWND; lpString: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := SetWindowTextW{TNT-ALLOW SetWindowTextW}(hWnd, lpString)
- else
- Result := SetWindowTextA{TNT-ALLOW SetWindowTextA}(hWnd, PAnsiChar(AnsiString(lpString)));
-end;
-
-//-----------------------------
-
-type
- TPathLengthResultOption = (poAllowDirectoryMode, poZeroSmallBuff, poExactCopy, poExactCopySubPaths);
- TPathLengthResultOptions = set of TPathLengthResultOption;
-
-procedure _ExactStrCopyW(pDest, pSource: PWideChar; Count: Integer);
-var
- i: integer;
-begin
- for i := 1 to Count do begin
- pDest^ := pSource^;
- Inc(PSource);
- Inc(pDest);
- end;
-end;
-
-procedure _ExactCopySubPaths(pDest, pSource: PWideChar; Count: Integer);
-var
- i: integer;
- OriginalSource: PWideChar;
- PNextSlash: PWideChar;
-begin
- if Count >= 4 then begin
- OriginalSource := pSource;
- PNextSlash := WStrScan(pSource, '\');
- for i := 1 to Count - 1 do begin
- // determine next path delimiter
- if pSource > pNextSlash then begin
- PNextSlash := WStrScan(pSource, '\');
- end;
- // leave if no more sub paths
- if (PNextSlash = nil)
- or ((pNextSlash - OriginalSource) >= Count) then begin
- exit;
- end;
- // copy char
- pDest^ := pSource^;
- Inc(PSource);
- Inc(pDest);
- end;
- end;
-end;
-
-function _HandlePathLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
-var
- WideBuff: WideString;
-begin
- WideBuff := AnsiBuff;
- if nBufferLength > Cardinal(Length(WideBuff)) then begin
- // normal
- Result := Length(WideBuff);
- WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end else if (poExactCopy in Options) then begin
- // exact
- Result := nBufferLength;
- _ExactStrCopyW(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end else begin
- // other
- if (poAllowDirectoryMode in Options)
- and (nBufferLength = Cardinal(Length(WideBuff))) then begin
- Result := Length(WideBuff) + 1;
- WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength - 1);
- end else begin
- Result := Length(WideBuff) + 1;
- if (nBufferLength > 0) then begin
- if (poZeroSmallBuff in Options) then
- lpBuffer^ := #0
- else if (poExactCopySubPaths in Options) then
- _ExactCopySubPaths(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end;
- end;
- end;
-end;
-
-function _HandleStringLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
-var
- WideBuff: WideString;
-begin
- WideBuff := AnsiBuff;
- if nBufferLength >= Cardinal(Length(WideBuff)) then begin
- // normal
- Result := Length(WideBuff);
- WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end else if nBufferLength = 0 then
- Result := Length(WideBuff)
- else
- Result := 0;
-end;
-
-//-------------------------------------------
-
-function Tnt_RemoveDirectoryW(lpPathName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := RemoveDirectoryW{TNT-ALLOW RemoveDirectoryW}(PWideChar(lpPathName))
- else
- Result := RemoveDirectoryA{TNT-ALLOW RemoveDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
-end;
-
-function Tnt_GetShortPathNameW(lpszLongPath: PWideChar; lpszShortPath: PWideChar;
- cchBuffer: DWORD): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetShortPathNameW{TNT-ALLOW GetShortPathNameW}(lpszLongPath, lpszShortPath, cchBuffer)
- else begin
- SetLength(AnsiBuff, MAX_PATH * 2);
- SetLength(AnsiBuff, GetShortPathNameA{TNT-ALLOW GetShortPathNameA}(PAnsiChar(AnsiString(lpszLongPath)),
- PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(cchBuffer, lpszShortPath, AnsiBuff, [poExactCopySubPaths]);
- end;
-end;
-
-function Tnt_GetFullPathNameW(lpFileName: PWideChar; nBufferLength: DWORD;
- lpBuffer: PWideChar; var lpFilePart: PWideChar): DWORD;
-var
- AnsiBuff: AnsiString;
- AnsiFilePart: PAnsiChar;
- AnsiLeadingChars: Integer;
- WideLeadingChars: Integer;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFullPathNameW{TNT-ALLOW GetFullPathNameW}(lpFileName, nBufferLength, lpBuffer, lpFilePart)
- else begin
- SetLength(AnsiBuff, MAX_PATH * 2);
- SetLength(AnsiBuff, GetFullPathNameA{TNT-ALLOW GetFullPathNameA}(PAnsiChar(AnsiString(lpFileName)),
- Length(AnsiBuff), PAnsiChar(AnsiBuff), AnsiFilePart));
- Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poZeroSmallBuff]);
- // deal w/ lpFilePart
- if (AnsiFilePart = nil) or (nBufferLength < Result) then
- lpFilePart := nil
- else begin
- AnsiLeadingChars := AnsiFilePart - PAnsiChar(AnsiBuff);
- WideLeadingChars := Length(WideString(Copy(AnsiBuff, 1, AnsiLeadingChars)));
- lpFilePart := lpBuffer + WideLeadingChars;
- end;
- end;
-end;
-
-function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
- lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
- hTemplateFile: THandle): THandle;
-begin
- if Win32PlatformIsUnicode then
- Result := CreateFileW{TNT-ALLOW CreateFileW}(lpFileName, dwDesiredAccess, dwShareMode,
- lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
- else
- Result := CreateFileA{TNT-ALLOW CreateFileA}(PAnsiChar(AnsiString(lpFileName)), dwDesiredAccess, dwShareMode,
- lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
-end;
-
-function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
-var
- Ansi_lpFindFileData: TWIN32FindDataA;
-begin
- if Win32PlatformIsUnicode then
- Result := FindFirstFileW{TNT-ALLOW FindFirstFileW}(lpFileName, lpFindFileData)
- else begin
- Result := FindFirstFileA{TNT-ALLOW FindFirstFileA}(PAnsiChar(AnsiString(lpFileName)),
- Ansi_lpFindFileData);
- if Result <> INVALID_HANDLE_VALUE then
- _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
- end;
-end;
-
-function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
-var
- Ansi_lpFindFileData: TWIN32FindDataA;
-begin
- if Win32PlatformIsUnicode then
- Result := FindNextFileW{TNT-ALLOW FindNextFileW}(hFindFile, lpFindFileData)
- else begin
- Result := FindNextFileA{TNT-ALLOW FindNextFileA}(hFindFile, Ansi_lpFindFileData);
- if Result then
- _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
- end;
-end;
-
-function Tnt_GetFileAttributesW(lpFileName: PWideChar): DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFileAttributesW{TNT-ALLOW GetFileAttributesW}(lpFileName)
- else
- Result := GetFileAttributesA{TNT-ALLOW GetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)));
-end;
-
-function Tnt_SetFileAttributesW(lpFileName: PWideChar; dwFileAttributes: DWORD): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := SetFileAttributesW{TNT-ALLOW SetFileAttributesW}(lpFileName, dwFileAttributes)
- else
- Result := SetFileAttributesA{TNT-ALLOW SetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)), dwFileAttributes);
-end;
-
-function Tnt_CreateDirectoryW(lpPathName: PWideChar;
- lpSecurityAttributes: PSecurityAttributes): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := CreateDirectoryW{TNT-ALLOW CreateDirectoryW}(lpPathName, lpSecurityAttributes)
- else
- Result := CreateDirectoryA{TNT-ALLOW CreateDirectoryA}(PAnsiChar(AnsiString(lpPathName)), lpSecurityAttributes);
-end;
-
-function Tnt_MoveFileW(lpExistingFileName, lpNewFileName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := MoveFileW{TNT-ALLOW MoveFileW}(lpExistingFileName, lpNewFileName)
- else
- Result := MoveFileA{TNT-ALLOW MoveFileA}(PAnsiChar(AnsiString(lpExistingFileName)), PAnsiChar(AnsiString(lpNewFileName)));
-end;
-
-function Tnt_CopyFileW(lpExistingFileName, lpNewFileName: PWideChar; bFailIfExists: BOOL): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := CopyFileW{TNT-ALLOW CopyFileW}(lpExistingFileName, lpNewFileName, bFailIfExists)
- else
- Result := CopyFileA{TNT-ALLOW CopyFileA}(PAnsiChar(AnsiString(lpExistingFileName)),
- PAnsiChar(AnsiString(lpNewFileName)), bFailIfExists);
-end;
-
-function Tnt_DeleteFileW(lpFileName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := DeleteFileW{TNT-ALLOW DeleteFileW}(lpFileName)
- else
- Result := DeleteFileA{TNT-ALLOW DeleteFileA}(PAnsiChar(AnsiString(lpFileName)));
-end;
-
-function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
- var lpRect: TRect; uFormat: UINT): Integer;
-begin
- if Win32PlatformIsUnicode then
- Result := DrawTextW{TNT-ALLOW DrawTextW}(hDC, lpString, nCount, lpRect, uFormat)
- else
- Result := DrawTextA{TNT-ALLOW DrawTextA}(hDC,
- PAnsiChar(AnsiString(_WStr(lpString, nCount))), -1, lpRect, uFormat);
-end;
-
-function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
- lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := GetDiskFreeSpaceW{TNT-ALLOW GetDiskFreeSpaceW}(lpRootPathName,
- lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
- else
- Result := GetDiskFreeSpaceA{TNT-ALLOW GetDiskFreeSpaceA}(PAnsiChar(AnsiString(lpRootPathName)),
- lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
-end;
-
-function Tnt_GetVolumeInformationW(lpRootPathName: PWideChar; lpVolumeNameBuffer: PWideChar;
- nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
- var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: PWideChar;
- nFileSystemNameSize: DWORD): BOOL;
-var
- AnsiFileSystemNameBuffer: AnsiString;
- AnsiVolumeNameBuffer: AnsiString;
- AnsiBuffLen: DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetVolumeInformationW{TNT-ALLOW GetVolumeInformationW}(lpRootPathName, lpVolumeNameBuffer, nVolumeNameSize, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize)
- else begin
- SetLength(AnsiVolumeNameBuffer, MAX_COMPUTERNAME_LENGTH + 1);
- SetLength(AnsiFileSystemNameBuffer, MAX_COMPUTERNAME_LENGTH + 1);
- AnsiBuffLen := Length(AnsiFileSystemNameBuffer);
- Result := GetVolumeInformationA{TNT-ALLOW GetVolumeInformationA}(PAnsiChar(AnsiString(lpRootPathName)), PAnsiChar(AnsiVolumeNameBuffer), AnsiBuffLen, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, PAnsiChar(AnsiFileSystemNameBuffer), AnsiBuffLen);
- if Result then begin
- SetLength(AnsiFileSystemNameBuffer, AnsiBuffLen);
- if (nFileSystemNameSize <= AnsiBuffLen) or (Length(AnsiFileSystemNameBuffer) = 0) then
- Result := False
- else begin
- WStrPLCopy(lpFileSystemNameBuffer, AnsiFileSystemNameBuffer, nFileSystemNameSize);
- WStrPLCopy(lpVolumeNameBuffer, AnsiVolumeNameBuffer, nVolumeNameSize);
- end;
- end;
- end;
-end;
-
-function Tnt_GetModuleFileNameW(hModule: HINST; lpFilename: PWideChar; nSize: DWORD): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetModuleFileNameW{TNT-ALLOW GetModuleFileNameW}(hModule, lpFilename, nSize)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetModuleFileNameA{TNT-ALLOW GetModuleFileNameA}(hModule, PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(nSize, lpFilename, AnsiBuff, [poExactCopy]);
- end;
-end;
-
-function Tnt_GetTempPathW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetTempPathW{TNT-ALLOW GetTempPathW}(nBufferLength, lpBuffer)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetTempPathA{TNT-ALLOW GetTempPathA}(Length(AnsiBuff), PAnsiChar(AnsiBuff)));
- Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poAllowDirectoryMode, poZeroSmallBuff]);
- end;
-end;
-
-function Tnt_GetTempFileNameW(lpPathName, lpPrefixString: PWideChar; uUnique: UINT;
- lpTempFileName: PWideChar): UINT;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetTempFileNameW{TNT-ALLOW GetTempFileNameW}(lpPathName, lpPrefixString, uUnique, lpTempFileName)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- Result := GetTempFileNameA{TNT-ALLOW GetTempFileNameA}(PAnsiChar(AnsiString(lpPathName)), PAnsiChar(lpPrefixString), uUnique, PAnsiChar(AnsiBuff));
- AnsiBuff := PAnsiChar(AnsiBuff);
- _HandlePathLengthResult(MAX_PATH, lpTempFileName, AnsiBuff, [poZeroSmallBuff]);
- end;
-end;
-
-function Tnt_GetWindowsDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetWindowsDirectoryW{TNT-ALLOW GetWindowsDirectoryW}(lpBuffer, uSize)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetWindowsDirectoryA{TNT-ALLOW GetWindowsDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
- end;
-end;
-
-function Tnt_GetSystemDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetSystemDirectoryW{TNT-ALLOW GetSystemDirectoryW}(lpBuffer, uSize)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetSystemDirectoryA{TNT-ALLOW GetSystemDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
- end;
-end;
-
-function Tnt_GetCurrentDirectoryW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetCurrentDirectoryW{TNT-ALLOW GetCurrentDirectoryW}(nBufferLength, lpBuffer)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetCurrentDirectoryA{TNT-ALLOW GetCurrentDirectoryA}(Length(AnsiBuff), PAnsiChar(AnsiBuff)));
- Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poAllowDirectoryMode, poZeroSmallBuff]);
- end;
-end;
-
-function Tnt_SetCurrentDirectoryW(lpPathName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := SetCurrentDirectoryW{TNT-ALLOW SetCurrentDirectoryW}(lpPathName)
- else
- Result := SetCurrentDirectoryA{TNT-ALLOW SetCurrentDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
-end;
-
-function Tnt_GetComputerNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-var
- AnsiBuff: AnsiString;
- AnsiBuffLen: DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetComputerNameW{TNT-ALLOW GetComputerNameW}(lpBuffer, nSize)
- else begin
- SetLength(AnsiBuff, MAX_COMPUTERNAME_LENGTH + 1);
- AnsiBuffLen := Length(AnsiBuff);
- Result := GetComputerNameA{TNT-ALLOW GetComputerNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
- if Result then begin
- SetLength(AnsiBuff, AnsiBuffLen);
- if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
- nSize := AnsiBuffLen + 1;
- Result := False;
- end else begin
- WStrPLCopy(lpBuffer, AnsiBuff, nSize);
- nSize := WStrLen(lpBuffer);
- end;
- end;
- end;
-end;
-
-function Tnt_GetUserNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-var
- AnsiBuff: AnsiString;
- AnsiBuffLen: DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetUserNameW{TNT-ALLOW GetUserNameW}(lpBuffer, nSize)
- else begin
- SetLength(AnsiBuff, 255);
- AnsiBuffLen := Length(AnsiBuff);
- Result := GetUserNameA{TNT-ALLOW GetUserNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
- if Result then begin
- SetLength(AnsiBuff, AnsiBuffLen);
- if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
- nSize := AnsiBuffLen + 1;
- Result := False;
- end else begin
- WStrPLCopy(lpBuffer, AnsiBuff, nSize);
- nSize := WStrLen(lpBuffer);
- end;
- end;
- end;
-end;
-
-function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
- Directory: PWideChar; ShowCmd: Integer): HINST;
-begin
- if Win32PlatformIsUnicode then
- Result := ShellExecuteW{TNT-ALLOW ShellExecuteW}(hWnd, _PWideCharWithNil(WideString(Operation)),
- FileName, Parameters,
- Directory, ShowCmd)
- else begin
- Result := ShellExecuteA{TNT-ALLOW ShellExecuteA}(hWnd, _PAnsiCharWithNil(AnsiString(Operation)),
- _PAnsiCharWithNil(AnsiString(FileName)), _PAnsiCharWithNil(AnsiString(Parameters)),
- _PAnsiCharWithNil(AnsiString(Directory)), ShowCmd)
- end;
-end;
-
-function Tnt_LoadLibraryW(lpLibFileName: PWideChar): HMODULE;
-begin
- if Win32PlatformIsUnicode then
- Result := LoadLibraryW{TNT-ALLOW LoadLibraryW}(lpLibFileName)
- else
- Result := LoadLibraryA{TNT-ALLOW LoadLibraryA}(PAnsiChar(AnsiString(lpLibFileName)));
-end;
-
-function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
-begin
- if Win32PlatformIsUnicode then
- Result := LoadLibraryExW{TNT-ALLOW LoadLibraryExW}(lpLibFileName, hFile, dwFlags)
- else
- Result := LoadLibraryExA{TNT-ALLOW LoadLibraryExA}(PAnsiChar(AnsiString(lpLibFileName)), hFile, dwFlags);
-end;
-
-function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
- var lpProcessInformation: TProcessInformation): BOOL;
-var
- AnsiStartupInfo: TStartupInfoA;
-begin
- if Win32PlatformIsUnicode then begin
- Result := CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName, lpCommandLine,
- lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
- lpCurrentDirectory, lpStartupInfo, lpProcessInformation)
- end else begin
- CopyMemory(@AnsiStartupInfo, @lpStartupInfo, SizeOf(TStartupInfo));
- AnsiStartupInfo.lpReserved := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpReserved));
- AnsiStartupInfo.lpDesktop := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpDesktop));
- AnsiStartupInfo.lpTitle := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpTitle));
- Result := CreateProcessA{TNT-ALLOW CreateProcessA}(_PAnsiCharWithNil(AnsiString(lpApplicationName)),
- _PAnsiCharWithNil(AnsiString(lpCommandLine)),
- lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
- _PAnsiCharWithNil(AnsiString(lpCurrentDirectory)), AnsiStartupInfo, lpProcessInformation);
- end;
-end;
-
-function Tnt_GetCurrencyFormatW(Locale: LCID; dwFlags: DWORD; lpValue: PWideChar;
- lpFormat: PCurrencyFmtW; lpCurrencyStr: PWideChar; cchCurrency: Integer): Integer;
-const
- MAX_ANSI_BUFF_SIZE = 64; // can a currency string actually be larger?
-var
- AnsiFormat: TCurrencyFmtA;
- PAnsiFormat: PCurrencyFmtA;
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue, lpFormat, lpCurrencyStr, cchCurrency)
- else begin
- if lpFormat = nil then
- PAnsiFormat := nil
- else begin
- ZeroMemory(@AnsiFormat, SizeOf(AnsiFormat));
- AnsiFormat.NumDigits := lpFormat.NumDigits;
- AnsiFormat.LeadingZero := lpFormat.LeadingZero;
- AnsiFormat.Grouping := lpFormat.Grouping;
- AnsiFormat.lpDecimalSep := PAnsiChar(AnsiString(lpFormat.lpDecimalSep));
- AnsiFormat.lpThousandSep := PAnsiChar(AnsiString(lpFormat.lpThousandSep));
- AnsiFormat.NegativeOrder := lpFormat.NegativeOrder;
- AnsiFormat.PositiveOrder := lpFormat.PositiveOrder;
- AnsiFormat.lpCurrencySymbol := PAnsiChar(AnsiString(lpFormat.lpCurrencySymbol));
- PAnsiFormat := @AnsiFormat;
- end;
- SetLength(AnsiBuff, MAX_ANSI_BUFF_SIZE);
- SetLength(AnsiBuff, GetCurrencyFormatA{TNT-ALLOW GetCurrencyFormatA}(Locale, dwFlags,
- PAnsiChar(AnsiString(lpValue)), PAnsiFormat, PAnsiChar(AnsiBuff), MAX_ANSI_BUFF_SIZE));
- Result := _HandleStringLengthResult(cchCurrency, lpCurrencyStr, AnsiBuff, []);
- end;
-end;
-
-function Tnt_CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
- cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer;
-var
- WideStr1, WideStr2: WideString;
- AnsiStr1, AnsiStr2: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := CompareStringW{TNT-ALLOW CompareStringW}(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2)
- else begin
- WideStr1 := _WStr(lpString1, cchCount1);
- WideStr2 := _WStr(lpString2, cchCount2);
- if (dwCmpFlags = 0) then begin
- // binary comparison
- if WideStr1 < WideStr2 then
- Result := 1
- else if WideStr1 = WideStr2 then
- Result := 2
- else
- Result := 3;
- end else begin
- AnsiStr1 := WideStr1;
- AnsiStr2 := WideStr2;
- Result := CompareStringA{TNT-ALLOW CompareStringA}(Locale, dwCmpFlags,
- PAnsiChar(AnsiStr1), -1, PAnsiChar(AnsiStr2), -1);
- end;
- end;
-end;
-
-function Tnt_CharUpperW(lpsz: PWideChar): PWideChar;
-var
- AStr: AnsiString;
- WStr: WideString;
-begin
- if Win32PlatformIsUnicode then
- Result := CharUpperW{TNT-ALLOW CharUpperW}(lpsz)
- else begin
- if HiWord(Cardinal(lpsz)) = 0 then begin
- // literal char mode
- Result := lpsz;
- if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
- AStr := WideChar(lpsz); // single character may be more than one byte
- CharUpperA{TNT-ALLOW CharUpperA}(PAnsiChar(AStr));
- WStr := AStr; // should always be single wide char
- if Length(WStr) = 1 then
- Result := PWideChar(WStr[1]);
- end
- end else begin
- // null-terminated string mode
- Result := lpsz;
- while lpsz^ <> #0 do begin
- lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
- end;
-end;
-
-function Tnt_CharUpperBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-var
- i: integer;
-begin
- if Win32PlatformIsUnicode then
- Result := CharUpperBuffW{TNT-ALLOW CharUpperBuffW}(lpsz, cchLength)
- else begin
- Result := cchLength;
- for i := 1 to cchLength do begin
- lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
-end;
-
-function Tnt_CharLowerW(lpsz: PWideChar): PWideChar;
-var
- AStr: AnsiString;
- WStr: WideString;
-begin
- if Win32PlatformIsUnicode then
- Result := CharLowerW{TNT-ALLOW CharLowerW}(lpsz)
- else begin
- if HiWord(Cardinal(lpsz)) = 0 then begin
- // literal char mode
- Result := lpsz;
- if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
- AStr := WideChar(lpsz); // single character may be more than one byte
- CharLowerA{TNT-ALLOW CharLowerA}(PAnsiChar(AStr));
- WStr := AStr; // should always be single wide char
- if Length(WStr) = 1 then
- Result := PWideChar(WStr[1]);
- end
- end else begin
- // null-terminated string mode
- Result := lpsz;
- while lpsz^ <> #0 do begin
- lpsz^ := WideChar(Tnt_CharLowerW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
- end;
-end;
-
-function Tnt_CharLowerBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-var
- i: integer;
-begin
- if Win32PlatformIsUnicode then
- Result := CharLowerBuffW{TNT-ALLOW CharLowerBuffW}(lpsz, cchLength)
- else begin
- Result := cchLength;
- for i := 1 to cchLength do begin
- lpsz^ := WideChar(Tnt_CharLowerW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
-end;
-
-function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
- lpSrcStr: PWideChar; cchSrc: Integer; var lpCharType): BOOL;
-var
- AStr: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetStringTypeExW{TNT-ALLOW GetStringTypeExW}(Locale, dwInfoType, lpSrcStr, cchSrc, lpCharType)
- else begin
- AStr := _WStr(lpSrcStr, cchSrc);
- Result := GetStringTypeExA{TNT-ALLOW GetStringTypeExA}(Locale, dwInfoType,
- PAnsiChar(AStr), -1, lpCharType);
- end;
-end;
-
-function Win9x_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
-// This function originated by the WINE Project.
-// It was translated to Pascal by Francisco Leong.
-// It was further modified by Troy Wolbrink.
-var
- hmem: HGLOBAL;
- hrsrc: THandle;
- p: PWideChar;
- string_num, i: Integer;
- block: Integer;
-begin
- Result := 0;
- // Netscape v3 fix...
- if (HIWORD(uID) = $FFFF) then begin
- uID := UINT(-(Integer(uID)));
- end;
- // figure block, string_num
- block := ((uID shr 4) and $FFFF) + 1; // bits 4 - 19, mask out bits 20 - 31, inc by 1
- string_num := uID and $000F;
- // get handle & pointer to string block
- hrsrc := FindResource{TNT-ALLOW FindResource}(hInstance, MAKEINTRESOURCE(block), RT_STRING);
- if (hrsrc <> 0) then
- begin
- hmem := LoadResource(hInstance, hrsrc);
- if (hmem <> 0) then
- begin
- p := LockResource(hmem);
- // walk the block to the requested string
- for i := 0 to string_num - 1 do begin
- p := p + Integer(p^) + 1;
- end;
- Result := Integer(p^); { p points to the length of string }
- Inc(p); { p now points to the actual string }
- if (lpBuffer <> nil) and (nBufferMax > 0) then
- begin
- Result := min(nBufferMax - 1, Result); { max length to copy }
- if (Result > 0) then begin
- CopyMemory(lpBuffer, p, Result * sizeof(WideChar));
- end;
- lpBuffer[Result] := WideChar(0); { null terminate }
- end;
- end;
- end;
-end;
-
-function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
-begin
- if Win32PlatformIsUnicode then
- Result := Windows.LoadStringW{TNT-ALLOW LoadStringW}(hInstance, uID, lpBuffer, nBufferMax)
- else
- Result := Win9x_LoadStringW(hInstance, uID, lpBuffer, nBufferMax);
-end;
-
-function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: TMenuItemInfoW): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition, lpmii)
- else begin
- TMenuItemInfoA(lpmii).dwTypeData := PAnsiChar(AnsiString(lpmii.dwTypeData));
- Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition, TMenuItemInfoA(lpmii));
- end;
-end;
-
-function Tnt_ExtractIconExW(lpszFile: PWideChar; nIconIndex: Integer;
- var phiconLarge, phiconSmall: HICON; nIcons: UINT): UINT;
-begin
- if Win32PlatformIsUnicode then
- Result := ExtractIconExW{TNT-ALLOW ExtractIconExW}(lpszFile,
- nIconIndex, phiconLarge, phiconSmall, nIcons)
- else
- Result := ExtractIconExA{TNT-ALLOW ExtractIconExA}(PAnsiChar(AnsiString(lpszFile)),
- nIconIndex, phiconLarge, phiconSmall, nIcons);
-end;
-
-function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
- var lpiIcon: Word): HICON;
-begin
- if Win32PlatformIsUnicode then
- Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst, lpIconPath, lpiIcon)
- else
- Result := ExtractAssociatedIconA{TNT-ALLOW ExtractAssociatedIconA}(hInst,
- PAnsiChar(AnsiString(lpIconPath)), lpiIcon)
-end;
-
-function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFileVersionInfoSizeW{TNT-ALLOW GetFileVersionInfoSizeW}(lptstrFilename, lpdwHandle)
- else
- Result := GetFileVersionInfoSizeA{TNT-ALLOW GetFileVersionInfoSizeA}(PAnsiChar(AnsiString(lptstrFilename)), lpdwHandle);
-end;
-
-function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
- lpData: Pointer): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFileVersionInfoW{TNT-ALLOW GetFileVersionInfoW}(lptstrFilename, dwHandle, dwLen, lpData)
- else
- Result := GetFileVersionInfoA{TNT-ALLOW GetFileVersionInfoA}(PAnsiChar(AnsiString(lptstrFilename)), dwHandle, dwLen, lpData);
-end;
-
-var
- Last_VerQueryValue_String: WideString;
-
-function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
- var lplpBuffer: Pointer; var puLen: UINT): BOOL;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := VerQueryValueW{TNT-ALLOW VerQueryValueW}(pBlock, lpSubBlock, lplpBuffer, puLen)
- else begin
- Result := VerQueryValueA{TNT-ALLOW VerQueryValueA}(pBlock, PAnsiChar(AnsiString(lpSubBlock)), lplpBuffer, puLen);
- if WideTextPos(VQV_STRINGFILEINFO, lpSubBlock) <> 1 then
- else begin
- { /StringFileInfo, convert ansi result to unicode }
- SetString(AnsiBuff, PAnsiChar(lplpBuffer), puLen);
- Last_VerQueryValue_String := AnsiBuff;
- lplpBuffer := PWideChar(Last_VerQueryValue_String);
- puLen := Length(Last_VerQueryValue_String);
- end;
- end;
-end;
-
-//---------------------------------------------------------------------------------------
-// Wide functions from Shell32.dll should be loaded dynamically (no stub on early Win95)
-//---------------------------------------------------------------------------------------
-
-type
- TSHFileOperationW = function(var lpFileOp: TSHFileOpStructW): Integer; stdcall;
- TSHBrowseForFolderW = function(var lpbi: TBrowseInfoW): PItemIDList; stdcall;
- TSHGetPathFromIDListW = function(pidl: PItemIDList; pszPath: PWideChar): BOOL; stdcall;
- TSHGetFileInfoW = function(pszPath: PWideChar; dwFileAttributes: DWORD;
- var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD; stdcall;
-
-var
- Safe_SHFileOperationW: TSHFileOperationW = nil;
- Safe_SHBrowseForFolderW: TSHBrowseForFolderW = nil;
- Safe_SHGetPathFromIDListW: TSHGetPathFromIDListW = nil;
- Safe_SHGetFileInfoW: TSHGetFileInfoW = nil;
-
-var Shell32DLL: HModule = 0;
-
-procedure LoadWideShell32Procs;
-begin
- if Shell32DLL = 0 then begin
- Shell32DLL := WinCheckH(Tnt_LoadLibraryW('shell32.dll'));
- Safe_SHFileOperationW := WinCheckP(GetProcAddress(Shell32DLL, 'SHFileOperationW'));
- Safe_SHBrowseForFolderW := WinCheckP(GetProcAddress(Shell32DLL, 'SHBrowseForFolderW'));
- Safe_SHGetPathFromIDListW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetPathFromIDListW'));
- Safe_SHGetFileInfoW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetFileInfoW'));
- end;
-end;
-
-function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;
-var
- AnsiFileOp: TSHFileOpStructA;
- MapCount: Integer;
- PAnsiMap: PSHNameMappingA;
- PWideMap: PSHNameMappingW;
- OldPath: WideString;
- NewPath: WideString;
- i: integer;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHFileOperationW(lpFileOp);
- end else begin
- AnsiFileOp := TSHFileOpStructA(lpFileOp);
- // convert PChar -> PWideChar
- if lpFileOp.pFrom = nil then
- AnsiFileOp.pFrom := nil
- else
- AnsiFileOp.pFrom := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pFrom)));
- if lpFileOp.pTo = nil then
- AnsiFileOp.pTo := nil
- else
- AnsiFileOp.pTo := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pTo)));
- AnsiFileOp.lpszProgressTitle := PAnsiChar(AnsiString(lpFileOp.lpszProgressTitle));
- Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}(AnsiFileOp);
- // return struct results
- lpFileOp.fAnyOperationsAborted := AnsiFileOp.fAnyOperationsAborted;
- lpFileOp.hNameMappings := nil;
- if (AnsiFileOp.hNameMappings <> nil)
- and ((FOF_WANTMAPPINGHANDLE and AnsiFileOp.fFlags) <> 0) then begin
- // alloc mem
- MapCount := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).cNumOfMappings;
- lpFileOp.hNameMappings :=
- AllocMem(SizeOf({hNameMappings}Cardinal) + SizeOf(TSHNameMappingW) * MapCount);
- PSHNameMappingHeaderW(lpFileOp.hNameMappings).cNumOfMappings := MapCount;
- // init pointers
- PAnsiMap := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).lpNM;
- PWideMap := PSHNameMappingHeaderW(lpFileOp.hNameMappings).lpNM;
- for i := 1 to MapCount do begin
- // old path
- OldPath := Copy(PAnsiMap.pszOldPath, 1, PAnsiMap.cchOldPath);
- PWideMap.pszOldPath := WStrNew(PWideChar(OldPath));
- PWideMap.cchOldPath := WStrLen(PWideMap.pszOldPath);
- // new path
- NewPath := Copy(PAnsiMap.pszNewPath, 1, PAnsiMap.cchNewPath);
- PWideMap.pszNewPath := WStrNew(PWideChar(NewPath));
- PWideMap.cchNewPath := WStrLen(PWideMap.pszNewPath);
- // next record
- Inc(PAnsiMap);
- Inc(PWideMap);
- end;
- end;
- end;
-end;
-
-procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);
-var
- i: integer;
- MapCount: Integer;
- PWideMap: PSHNameMappingW;
-begin
- if Win32PlatformIsUnicode then
- SHFreeNameMappings{TNT-ALLOW SHFreeNameMappings}(hNameMappings)
- else begin
- // free strings
- MapCount := PSHNameMappingHeaderW(hNameMappings).cNumOfMappings;
- PWideMap := PSHNameMappingHeaderW(hNameMappings).lpNM;
- for i := 1 to MapCount do begin
- WStrDispose(PWideMap.pszOldPath);
- WStrDispose(PWideMap.pszNewPath);
- Inc(PWideMap);
- end;
- // free struct
- FreeMem(Pointer(hNameMappings));
- end;
-end;
-
-function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;
-var
- AnsiInfo: TBrowseInfoA;
- AnsiBuffer: array[0..MAX_PATH] of AnsiChar;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHBrowseForFolderW(lpbi);
- end else begin
- AnsiInfo := TBrowseInfoA(lpbi);
- AnsiInfo.lpszTitle := PAnsiChar(AnsiString(lpbi.lpszTitle));
- if lpbi.pszDisplayName <> nil then
- AnsiInfo.pszDisplayName := AnsiBuffer;
- Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}(AnsiInfo);
- if lpbi.pszDisplayName <> nil then
- WStrPCopy(lpbi.pszDisplayName, AnsiInfo.pszDisplayName);
- lpbi.iImage := AnsiInfo.iImage;
- end;
-end;
-
-function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;
-var
- AnsiPath: AnsiString;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHGetPathFromIDListW(pidl, pszPath);
- end else begin
- SetLength(AnsiPath, MAX_PATH);
- Result := SHGetPathFromIDListA{TNT-ALLOW SHGetPathFromIDListA}(pidl, PAnsiChar(AnsiPath));
- if Result then
- WStrPCopy(pszPath, PAnsiChar(AnsiPath))
- end;
-end;
-
-function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
- var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;
-var
- SHFileInfoA: TSHFileInfoA;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHGetFileInfoW(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags)
- end else begin
- Result := SHGetFileInfoA{TNT-ALLOW SHGetFileInfoA}(PAnsiChar(AnsiString(pszPath)),
- dwFileAttributes, SHFileInfoA, SizeOf(TSHFileInfoA), uFlags);
- // update pfsi...
- ZeroMemory(@psfi, SizeOf(TSHFileInfoW));
- psfi.hIcon := SHFileInfoA.hIcon;
- psfi.iIcon := SHFileInfoA.iIcon;
- psfi.dwAttributes := SHFileInfoA.dwAttributes;
- WStrPLCopy(psfi.szDisplayName, SHFileInfoA.szDisplayName, MAX_PATH);
- WStrPLCopy(psfi.szTypeName, SHFileInfoA.szTypeName, 80);
- end;
-end;
-
-
-function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
-begin
- Result := HiWord(Cardinal(ResStr)) = 0;
-end;
-
-function LANGIDFROMLCID(lcid: LCID): WORD;
-begin
- Result := LoWord(lcid);
-end;
-
-function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
-begin
- Result := (usSubLanguage shl 10) or usPrimaryLanguage;
-end;
-
-function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
-begin
- Result := MakeLong(wLanguageID, wSortID);
-end;
-
-function PRIMARYLANGID(lgid: WORD): WORD;
-begin
- Result := lgid and $03FF;
-end;
-
-function SORTIDFROMLCID(lcid: LCID): WORD;
-begin
- Result := HiWord(lcid);
-end;
-
-function SUBLANGID(lgid: WORD): WORD;
-begin
- Result := lgid shr 10;
-end;
-
-initialization
-
-finalization
- if Shell32DLL <> 0 then
- FreeLibrary(Shell32DLL);
-
-end.
|