*** empty log message ***

1 files changed, 482 insertions, 0 deletions

diff --git a/apps/windoze/CBuilder5/BibleCS/TntUnicodeControls/TntControls.pas b/apps/windoze/CBuilder5/BibleCS/TntUnicodeControls/TntControls.pas
new file mode 100644
index 0000000..9ae2017
--- /dev/null
+++ b/apps/windoze/CBuilder5/BibleCS/TntUnicodeControls/TntControls.pas
@@ -0,0 +1,482 @@
+
+{*******************************************************}
+{    The Delphi Unicode Controls Project                }
+{                                                       }
+{      http://home.ccci.org/wolbrink                    }
+{                                                       }
+{ Copyright (c) 2002, Troy Wolbrink (wolbrink@ccci.org) }
+{                                                       }
+{*******************************************************}
+
+unit TntControls;
+
+{
+  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 perorm 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 subclasses 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.
+}
+
+interface
+
+uses Windows, Messages, Classes, Controls, Forms, TntForms, TntClasses;
+
+const
+  UNICODE_CLASS_EXT = '.UnicodeClass';
+
+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);
+function HandleIMEComposition(hWnd: THandle; Message: TMessage): Boolean;
+
+procedure SubClassUnicodeControl(Control: TWinControl);
+procedure CreateUnicodeHandle(Control: TWinControl; const Params: TCreateParams;
+                                                                   const SubClass: WideString);
+
+function WideGetWindowText(Control: TWinControl): WideString;
+procedure WideSetWindowText(Control: TWinControl; const Text: WideString);
+
+function TntAdjustLineBreaks(const S: WideString): WideString;
+
+implementation
+
+uses SysUtils, Graphics, Imm;
+
+procedure DestroyUnicodeHandle(Control: TWinControl); forward;
+
+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);
+    Assert(Unused = 0);
+    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;
+
+function HandleIMEComposition(hWnd: THandle; Message: TMessage): Boolean;
+var
+  IMC: HIMC;
+  Buff: WideString;
+  i: integer;
+begin
+  Result := False;
+  if  (Win32Platform = VER_PLATFORM_WIN32_NT)
+  and (Message.Msg = WM_IME_COMPOSITION)
+  and ((Message.lParam and GCS_RESULTSTR) <> 0) then
+  begin
+    IMC := ImmGetContext(hWnd);
+    if IMC <> 0 then begin
+      try
+        Result := True;
+        // Get the result string
+        SetLength(Buff, ImmGetCompositionStringW(IMC, GCS_RESULTSTR, nil, 0) div SizeOf(WideChar));
+        ImmGetCompositionStringW(IMC, GCS_RESULTSTR, PWideChar(Buff), Length(Buff) * SizeOf(WideChar));
+      finally
+        ImmReleaseContext(hWnd, IMC);
+      end;
+      // send WM_CHAR messages for each char in string
+      for i := 1 to Length(Buff) do begin
+        SendMessageW(hWnd, WM_CHAR, Integer(Buff[i]), 0);
+      end;
+    end;
+  end;
+end;
+
+//-----------------------------------------------------------------------------------
+type
+  TWinControlTrap = class
+  private
+    ObjectInstance: Pointer;
+    DefObjectInstance: Pointer;
+    FControl: TWinControl;
+    Handle: THandle;
+    PrevWin32Proc: Pointer;
+    PrevDefWin32Proc: Pointer;
+    PrevWindowProc: TWndMethod;
+    LastWin32Msg: UINT;
+    procedure Win32Proc(var Message: TMessage);
+    procedure DefWin32Proc(var Message: TMessage);
+    procedure WindowProc(var Message: TMessage);
+    procedure HandleWMDestroy(var Message: TMessage);
+  end;
+
+procedure TWinControlTrap.HandleWMDestroy(var Message: TMessage);
+var
+  ThisPrevWin32Proc: Pointer;
+  ThisHandle: THandle;
+begin
+  with Message do begin
+    Assert(Msg = WM_DESTROY);
+    // store local copies of values, since this object is about to be freed
+    ThisPrevWin32Proc := PrevWin32Proc;
+    ThisHandle := Handle;
+
+    // handle destruction
+    DestroyUnicodeHandle(FControl);
+
+    // pass on the WM_DESTROY message
+    Result := CallWindowProc(ThisPrevWin32Proc, ThisHandle, Msg, wParam, lParam);
+  end;
+end;
+
+procedure TWinControlTrap.Win32Proc(var Message: TMessage);
+begin
+  with Message do begin
+    if Msg = WM_DESTROY then begin
+      HandleWMDestroy(Message);
+      exit; { Do not access any data in object. Object is freed. }
+    end;
+    if not HandleIMEComposition(Handle, Message) then begin
+      LastWin32Msg := Msg;
+      Result := CallWindowProcW(PrevWin32Proc, Handle, Msg, wParam, lParam);
+    end;
+  end;
+end;
+
+procedure TWinControlTrap.DefWin32Proc(var Message: TMessage);
+begin
+  with Message do begin
+    if (Msg = WM_CHAR) then begin
+      RestoreWMCharMsg(Message)
+    end;
+    Result := CallWindowProcW(PrevDefWin32Proc, Handle, Msg, wParam, lParam);
+  end;
+end;
+
+procedure TWinControlTrap.WindowProc(var Message: TMessage);
+var
+  CameFromWindows: Boolean;
+begin
+  CameFromWindows := LastWin32Msg <> WM_NULL;
+  LastWin32Msg := WM_NULL;
+  with Message do begin
+    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;
+  end;
+end;
+
+{$IFDEF VER140}
+function MakeObjectInstance(Method: TWndMethod): Pointer;
+begin
+  Result := Classes.MakeObjectInstance(Method);
+end;
+procedure FreeObjectInstance(ObjectInstance: Pointer);
+begin
+  Classes.FreeObjectInstance(ObjectInstance);
+end;
+{$ENDIF}
+
+//----------------------------------------------------------------------------------
+var
+  WinControlTrap_Atom: TAtom = 0;
+
+type TAccessWinControl = class(TWinControl);
+
+procedure SubClassUnicodeControl(Control: TWinControl);
+var
+  WinControlTrap: TWinControlTrap;
+begin
+  if IsWindowUnicode(Control.Handle) then begin
+    // create trap object, save reference
+    WinControlTrap := TWinControlTrap.Create;
+    SetProp(Control.Handle, MakeIntAtom(WinControlTrap_Atom), Cardinal(WinControlTrap));
+
+    with WinControlTrap do begin
+      // initialize trap object
+      FControl := Control;
+      Handle := Control.Handle;
+      PrevWin32Proc := Pointer(GetWindowLong(Control.Handle, GWL_WNDPROC));
+      PrevDefWin32Proc := TAccessWinControl(Control).DefWndProc;
+      PrevWindowProc := Control.WindowProc;
+
+      // subclass Window Procedures
+      ObjectInstance := MakeObjectInstance(Win32Proc);
+      SetWindowLongW(Control.Handle, GWL_WNDPROC, Integer(ObjectInstance));
+      DefObjectInstance := MakeObjectInstance(DefWin32Proc);
+      TAccessWinControl(Control).DefWndProc := DefObjectInstance;
+      Control.WindowProc := WindowProc;
+    end;
+  end;
+end;
+
+procedure UnSubClassUnicodeControl(Control: TWinControl);
+var
+  WinControlTrap: TWinControlTrap;
+begin
+  if IsWindowUnicode(Control.Handle) then begin
+    // get referenct to trap object
+    WinControlTrap := TWinControlTrap(GetProp(Control.Handle, MakeIntAtom(WinControlTrap_Atom)));
+    RemoveProp(Control.Handle, MakeIntAtom(WinControlTrap_Atom));
+
+    with WinControlTrap do begin
+      // restore window procs
+      Control.WindowProc := PrevWindowProc;
+      TAccessWinControl(Control).DefWndProc := PrevDefWin32Proc;
+      SetWindowLongW(Control.Handle, GWL_WNDPROC, Integer(PrevWin32Proc));
+      FreeObjectInstance(ObjectInstance);
+      FreeObjectInstance(DefObjectInstance);
+
+      // free trap object
+      Free;
+    end;
+  end;
+end;
+
+//----------------------------------------------- CREATE/DESTROY UNICODE HANDLE
+type
+  TWideCaptionHolder = class(TComponent)
+  private
+    WideCaption: WideString;
+  end;
+
+function FindWideCaptionHolder(Control: TWinControl; Default: WideString = ''): TWideCaptionHolder;
+var
+  i: integer;
+begin
+  result := nil;
+  for i := 0 to Control.ComponentCount - 1 do begin
+    if (Control.Components[i] is TWideCaptionHolder) then begin
+      result := TWideCaptionHolder(Control.Components[i]);
+      exit; // found it!
+    end;
+  end;
+  if result = nil then begin
+    result := TWideCaptionHolder.Create(Control);
+    result.WideCaption := Default;
+  end;
+end;
+
+procedure CreateUnicodeHandle(Control: TWinControl; const Params: TCreateParams;
+                                                                   const SubClass: WideString);
+var
+  WideSubClass: TWndClassW;
+  WideWinClassName: WideString;
+  WideClass: TWndClassW;
+  TempClass: TWndClassW;
+  Handle: THandle;
+begin
+  if Win32Platform <> VER_PLATFORM_WIN32_NT 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 <> '' then begin
+      GetClassInfoW(hInstance, PWideChar(SubClass), WideSubClass);
+      TAccessWinControl(Control).DefWndProc := WideSubClass.lpfnWndProc;
+    end else
+      TAccessWinControl(Control).DefWndProc := @DefWindowProcW;
+
+    with Params do begin
+      WideWinClassName := WinClassName + UNICODE_CLASS_EXT;
+      if not GetClassInfoW(Params.WindowClass.hInstance, PWideChar(WideWinClassName), TempClass)
+      then begin
+        // Prepare a TWndClassW record
+        WideClass := TWndClassW(WindowClass);
+        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;
+
+      // Create UNICODE window
+      Handle := CreateWindowExW(ExStyle, PWideChar(WideWinClassName), nil,
+        Style, X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
+
+      // SetWindowLongW needs to be called because InitWndProc converts control to ANSI
+      //  CallingSetWindowLongA(.., GWL_WNDPROC) makes Windows think it is an ANSI window
+      //    But CallingSetWindowLongW(.., GWL_WNDPROC) make Windows think it is a UNICODE window.
+      SetWindowLongW(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_WNDPROC));
+
+      // set handle for control
+      TAccessWinControl(Control).WindowHandle := Handle;
+
+      // sub-class
+      SubClassUnicodeControl(Control);
+
+      // For some reason, caption gets garbled after calling SetWindowLongW(.., GWL_WNDPROC).
+      WideSetWindowText(Control, FindWideCaptionHolder(Control, Caption).WideCaption);
+    end;
+  end;
+end;
+
+procedure DestroyUnicodeHandle(Control: TWinControl);
+begin
+  if Win32Platform = VER_PLATFORM_WIN32_NT then begin
+    // remember caption for future window creation
+    if not (csDestroying in Control.ComponentState) then
+      FindWideCaptionHolder(Control).WideCaption := WideGetWindowText(Control);
+    // un sub-class
+    UnSubClassUnicodeControl(Control);
+  end;
+end;
+
+//----------------------------------------------- GET/SET WINDOW TEXT
+
+function WideGetWindowText(Control: TWinControl): WideString;
+begin
+  if (not Control.HandleAllocated)
+  or (not IsWindowUnicode(Control.Handle)) then begin
+    // NO HANDLE -OR- NOT UNICODE
+    result := TAccessWinControl(Control).Text;
+    if Win32Platform = VER_PLATFORM_WIN32_NT then
+      result := FindWideCaptionHolder(Control, result).WideCaption
+  end else begin
+    // UNICODE & HANDLE
+    SetLength(Result, GetWindowTextLengthW(Control.Handle) + 1);
+    GetWindowTextW(Control.Handle, PWideChar(Result), Length(Result));
+    SetLength(Result, Length(Result) - 1);
+  end;
+end;
+
+procedure WideSetWindowText(Control: TWinControl; const Text: WideString);
+begin
+  if (not Control.HandleAllocated)
+  or (not IsWindowUnicode(Control.Handle)) then begin
+    // NO HANDLE -OR- NOT UNICODE
+    TAccessWinControl(Control).Text := Text;
+    if Win32Platform = VER_PLATFORM_WIN32_NT then
+      FindWideCaptionHolder(Control).WideCaption := Text;
+  end else if WideGetWindowText(Control) <> Text then begin
+    // UNICODE & HANDLE
+    SetWindowTextW(Control.Handle, PWideChar(Text));
+    Control.Perform(CM_TEXTCHANGED, 0, 0);
+  end;
+end;
+
+function TntAdjustLineBreaks(const S: WideString): WideString;
+var
+  Source, SourceEnd, Dest: PWideChar;
+  Extra: Integer;
+begin
+  Source := Pointer(S);
+  SourceEnd := Source + Length(S);
+  Extra := 0;
+  while Source < SourceEnd do
+  begin
+    case Source^ of
+      #10:
+        Inc(Extra);
+      #13:
+        if Source[1] = #10 then Inc(Source) else Inc(Extra);
+    end;
+    Inc(Source);
+  end;
+  if Extra = 0 then Result := S else
+  begin
+    Source := Pointer(S);
+    SetString(Result, nil, SourceEnd - Source + Extra);
+    Dest := Pointer(Result);
+    while Source < SourceEnd do
+      case Source^ of
+        #10:
+          begin
+            Dest^ := #13;
+            Inc(Dest);
+            Dest^ := #10;
+            Inc(Dest);
+            Inc(Source);
+          end;
+        #13:
+          begin
+            Dest^ := #13;
+            Inc(Dest);
+            Dest^ := #10;
+            Inc(Dest);
+            Inc(Source);
+            if Source^ = #10 then Inc(Source);
+          end;
+      else
+        Dest^ := Source^;
+        Inc(Dest);
+        Inc(Source);
+      end;
+  end;
+end;
+
+var
+  AtomText: array[0..127] of AnsiChar;
+
+initialization
+  WinControlTrap_Atom := GlobalAddAtom(StrFmt(AtomText, 'WinControlTrap.UnicodeClass.%d',
+    [GetCurrentProcessID]));
+
+finalization
+  GlobalDeleteAtom(WinControlTrap_Atom);
+
+end.