david
2e21f1b77a
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.TntUnicodeControls@3 efe25200-c253-4202-ad9d-beff95d3544d
1100 lines
37 KiB
ObjectPascal
1100 lines
37 KiB
ObjectPascal
|
|
{*****************************************************************************}
|
|
{ }
|
|
{ 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.
|