[utf8vcl-cvs] utf8vcl UTF8VCLControls.pas, NONE, 1.1 MissingMethods-incomplete.txt, 1.5, 1.6 TestForm.dfm, 1.10, 1.11 TestForm.pas, 1.15, 1.16 UTF8Test.dpr, 1.2, 1.3 UTF8VCL.pas, 1.14, 1.15 UTF8VCLCommCtrl.pas, 1.1, 1.2

[Bart v. d. W. <blu...@us...>]

Update of /cvsroot/utf8vcl/utf8vcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv5893

Modified Files:
	MissingMethods-incomplete.txt TestForm.dfm TestForm.pas 
	UTF8Test.dpr UTF8VCL.pas UTF8VCLCommCtrl.pas 
Added Files:
	UTF8VCLControls.pas 
Log Message:
Try to enable support for extended typed characters, a problem in TWinControl was removed, but now you won't get a key event for extended keys, no way to put those keys into a Char argument.


--- NEW FILE: UTF8VCLControls.pas ---
unit UTF8VCLControls;

interface

uses
  Forms, Controls, Messages;

type
  TWinControlPatch = class(TWinControl)
  private
    procedure HookTWinControlDoKeyPress;
    function DoKeyPressPatch(var Message: TWMKey): Boolean;
  end;

procedure HookTWinControlDoKeyPress;

implementation

uses
  UTF8VCLUtils;

type
  TProc = function(var Message: TWMKey): Boolean of Object;
  TProcBreaker = packed record
    Proc, Self: Pointer;
  end;

procedure HookTWinControlDoKeyPress;
begin
  TWinControlPatch(nil).HookTWinControlDoKeyPress;
end;

function TWinControlPatch.DoKeyPressPatch(var Message: TWMKey): Boolean;
var
  Form: TCustomForm;
  Ch: Char;
begin
  Result := True;
  Form := GetParentForm(Self);
  if (Form <> nil) and (Form <> TWinControl(Self)) and Form.KeyPreview and
    TWinControlPatch(Form).DoKeyPress(Message) then Exit;
  if not (csNoStdEvents in ControlStyle) then
    with Message do
    begin
      if CharCode < 256 then
      begin
        Ch := Char(CharCode);
        KeyPress(Ch);
        CharCode := Word(Ch);
        if Char(CharCode) = #0 then Exit;
      end;
    end;
  Result := False;
end;

procedure TWinControlPatch.HookTWinControlDoKeyPress;
var
  a, b: TProc;
  m: TWMKey;
begin
  a := DoKeyPress;
  b := DoKeyPressPatch;
  InjectJumpHook(TProcBreaker(a).Proc, TProcBreaker(b).Proc);
end;

end.

Index: MissingMethods-incomplete.txt
===================================================================
RCS file: /cvsroot/utf8vcl/utf8vcl/MissingMethods-incomplete.txt,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** MissingMethods-incomplete.txt	15 Mar 2007 12:09:49 -0000	1.5
--- MissingMethods-incomplete.txt	16 Mar 2007 23:39:11 -0000	1.6
***************
*** 1,2 ****
--- 1,7 ----
+ Special methods that need patching:
+ Controls.TWinControl.DoKeyPress
+ 
+ 
+ 
  GetTextMetricsA
  CompareStringA

Index: UTF8VCL.pas
===================================================================
RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8VCL.pas,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** UTF8VCL.pas	15 Mar 2007 12:09:49 -0000	1.14
--- UTF8VCL.pas	16 Mar 2007 23:39:11 -0000	1.15
***************
*** 17,21 ****
  uses
    Windows, Messages, SysUtils, Classes,
!   UTF8VCLUtils, UTF8VCLMessages;
  
  {
--- 17,21 ----
  uses
    Windows, Messages, SysUtils, Classes,
!   UTF8VCLUtils, UTF8VCLMessages, UTF8VCLControls;
  
  {
***************
*** 508,511 ****
--- 508,513 ----
    if Active then
    begin
+     HookTWinControlDoKeyPress;
+ 
      HookUser32Func('SendMessageA', @SendMessageAIntercept); // do not localize
      HookUser32Func('PostMessageA', @PostMessageAIntercept); // do not localize

Index: TestForm.dfm
===================================================================
RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.dfm,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** TestForm.dfm	15 Mar 2007 12:09:49 -0000	1.10
--- TestForm.dfm	16 Mar 2007 23:39:11 -0000	1.11
***************
*** 5,10 ****
    BorderStyle = bsSingle
    Caption = 'Form1'
!   ClientHeight = 435
!   ClientWidth = 657
    Color = clBtnFace
    Font.Charset = ANSI_CHARSET
--- 5,10 ----
    BorderStyle = bsSingle
    Caption = 'Form1'
!   ClientHeight = 406
!   ClientWidth = 613
    Color = clBtnFace
    Font.Charset = ANSI_CHARSET
***************
*** 17,41 ****
    Position = poScreenCenter
    PixelsPerInch = 96
!   TextHeight = 15
    object Label1: TLabel
!     Left = 8
!     Top = 8
      Width = 32
!     Height = 15
      Caption = 'Label1'
    end
    object Edit1: TEdit
!     Left = 8
!     Top = 30
!     Width = 210
!     Height = 23
      TabOrder = 0
      Text = 'Edit1'
    end
    object Memo1: TMemo
!     Left = 8
!     Top = 60
!     Width = 210
!     Height = 45
      Ctl3D = True
      Lines.Strings = (
--- 17,42 ----
    Position = poScreenCenter
    PixelsPerInch = 96
!   TextHeight = 14
    object Label1: TLabel
!     Left = 7
!     Top = 7
      Width = 32
!     Height = 14
      Caption = 'Label1'
    end
    object Edit1: TEdit
!     Left = 7
!     Top = 28
!     Width = 196
!     Height = 22
      TabOrder = 0
      Text = 'Edit1'
+     OnChange = Edit1Change
    end
    object Memo1: TMemo
!     Left = 7
!     Top = 56
!     Width = 196
!     Height = 42
      Ctl3D = True
      Lines.Strings = (
***************
*** 45,77 ****
    end
    object Button1: TButton
!     Left = 8
!     Top = 113
!     Width = 69
!     Height = 22
      Caption = 'Button1'
      TabOrder = 2
    end
    object CheckBox1: TCheckBox
!     Left = 83
!     Top = 113
!     Width = 135
!     Height = 15
      Caption = 'CheckBox1'
      TabOrder = 3
    end
    object RadioButton1: TRadioButton
!     Left = 224
!     Top = 172
!     Width = 174
!     Height = 16
      Caption = 'RadioButton1'
      TabOrder = 4
    end
    object ListBox1: TListBox
!     Left = 8
!     Top = 143
!     Width = 210
!     Height = 45
!     ItemHeight = 15
      Items.Strings = (
        'ListBox1')
--- 46,78 ----
    end
    object Button1: TButton
!     Left = 7
!     Top = 105
!     Width = 65
!     Height = 21
      Caption = 'Button1'
      TabOrder = 2
    end
    object CheckBox1: TCheckBox
!     Left = 77
!     Top = 105
!     Width = 126
!     Height = 14
      Caption = 'CheckBox1'
      TabOrder = 3
    end
    object RadioButton1: TRadioButton
!     Left = 209
!     Top = 161
!     Width = 162
!     Height = 14
      Caption = 'RadioButton1'
      TabOrder = 4
    end
    object ListBox1: TListBox
!     Left = 7
!     Top = 133
!     Width = 196
!     Height = 42
!     ItemHeight = 14
      Items.Strings = (
        'ListBox1')
***************
*** 79,87 ****
    end
    object ComboBox1: TComboBox
!     Left = 224
!     Top = 143
!     Width = 174
!     Height = 23
!     ItemHeight = 15
      TabOrder = 6
      Text = 'ComboBox1'
--- 80,88 ----
    end
    object ComboBox1: TComboBox
!     Left = 209
!     Top = 133
!     Width = 162
!     Height = 22
!     ItemHeight = 14
      TabOrder = 6
      Text = 'ComboBox1'
***************
*** 90,105 ****
    end
    object GroupBox1: TGroupBox
!     Left = 224
!     Top = 90
!     Width = 174
!     Height = 45
      Caption = 'GroupBox1'
      TabOrder = 7
    end
    object Button2: TButton
!     Left = 567
!     Top = 399
!     Width = 71
!     Height = 24
      Caption = 'Translate'
      TabOrder = 8
--- 91,106 ----
    end
    object GroupBox1: TGroupBox
!     Left = 209
!     Top = 84
!     Width = 162
!     Height = 42
      Caption = 'GroupBox1'
      TabOrder = 7
    end
    object Button2: TButton
!     Left = 529
!     Top = 372
!     Width = 66
!     Height = 23
      Caption = 'Translate'
      TabOrder = 8
***************
*** 107,114 ****
    end
    object Button3: TButton
!     Left = 473
!     Top = 398
!     Width = 70
!     Height = 24
      Caption = 'SomeTests'
      TabOrder = 9
--- 108,115 ----
    end
    object Button3: TButton
!     Left = 441
!     Top = 371
!     Width = 66
!     Height = 23
      Caption = 'SomeTests'
      TabOrder = 9
***************
*** 116,123 ****
    end
    object RichEdit1: TRichEdit
!     Left = 224
      Top = 0
!     Width = 174
!     Height = 83
      Lines.Strings = (
        'RichEdit1')
--- 117,124 ----
    end
    object RichEdit1: TRichEdit
!     Left = 209
      Top = 0
!     Width = 162
!     Height = 77
      Lines.Strings = (
        'RichEdit1')
***************
*** 125,132 ****
    end
    object StringGrid1: TStringGrid
!     Left = 403
      Top = 0
!     Width = 232
!     Height = 129
      ColCount = 3
      RowCount = 4
--- 126,133 ----
    end
    object StringGrid1: TStringGrid
!     Left = 376
      Top = 0
!     Width = 217
!     Height = 120
      ColCount = 3
      RowCount = 4
***************
*** 139,152 ****
    end
    object ListView1: TListView
!     Left = 400
!     Top = 136
!     Width = 241
!     Height = 113
      Columns = <
        item
          Caption = 'Column1'
        end
        item
          Caption = 'Column2'
        end>
      GridLines = True
--- 140,155 ----
    end
    object ListView1: TListView
!     Left = 373
!     Top = 127
!     Width = 225
!     Height = 105
      Columns = <
        item
          Caption = 'Column1'
+         Width = 47
        end
        item
          Caption = 'Column2'
+         Width = 47
        end>
      GridLines = True
***************
*** 159,166 ****
    end
    object Activate: TButton
!     Left = 8
!     Top = 400
!     Width = 137
!     Height = 25
      Caption = 'Activate UTF8 support'
      Enabled = False
--- 162,169 ----
    end
    object Activate: TButton
!     Left = 7
!     Top = 373
!     Width = 128
!     Height = 24
      Caption = 'Activate UTF8 support'
      Enabled = False
***************
*** 168,175 ****
    end
    object Deactivate: TButton
!     Left = 152
!     Top = 400
!     Width = 137
!     Height = 25
      Caption = 'Deactivate UTF8 support'
      Enabled = False
--- 171,178 ----
    end
    object Deactivate: TButton
!     Left = 142
!     Top = 373
!     Width = 128
!     Height = 24
      Caption = 'Deactivate UTF8 support'
      Enabled = False
***************
*** 177,184 ****
    end
    object Button4: TButton
!     Left = 385
!     Top = 398
!     Width = 70
!     Height = 24
      Caption = 'FatalAppExit'
      TabOrder = 15
--- 180,187 ----
    end
    object Button4: TButton
!     Left = 359
!     Top = 371
!     Width = 66
!     Height = 23
      Caption = 'FatalAppExit'
      TabOrder = 15

Index: UTF8Test.dpr
===================================================================
RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8Test.dpr,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** UTF8Test.dpr	7 Mar 2007 19:28:19 -0000	1.2
--- UTF8Test.dpr	16 Mar 2007 23:39:11 -0000	1.3
***************
*** 1,4 ****
--- 1,7 ----
  program UTF8Test;
  
+ {%File 'MissingMethods-incomplete.txt'}
+ {%File 'MissingWindowMessages-incomplete.txt'}
+ 
  uses
    ShareMem,
***************
*** 7,11 ****
    UTF8VCLUtils in 'UTF8VCLUtils.pas',
    Forms,
!   TestForm in 'TestForm.pas' {Form1};
  
  {$R *.res}
--- 10,15 ----
    UTF8VCLUtils in 'UTF8VCLUtils.pas',
    Forms,
!   TestForm in 'TestForm.pas' {Form1},
!   UTF8VCLControls in 'UTF8VCLControls.pas';
  
  {$R *.res}

Index: UTF8VCLCommCtrl.pas
===================================================================
RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8VCLCommCtrl.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** UTF8VCLCommCtrl.pas	13 Mar 2007 21:30:42 -0000	1.1
--- UTF8VCLCommCtrl.pas	16 Mar 2007 23:39:11 -0000	1.2
***************
*** 1,49 ****
! function CreatePropertySheetPage; external cctrl name 'CreatePropertySheetPageA';
! function CreatePropertySheetPageA; external cctrl name 'CreatePropertySheetPageA';
! function CreatePropertySheetPageW; external cctrl name 'CreatePropertySheetPageW';
! function DestroyPropertySheetPage; external cctrl name 'DestroyPropertySheetPage';
! function PropertySheet; external cctrl name 'PropertySheetA';
! function PropertySheetA; external cctrl name 'PropertySheetA';
! function PropertySheetW; external cctrl name 'PropertySheetW';
! 
! function ImageList_LoadImage; external cctrl name 'ImageList_LoadImageA';
! function ImageList_LoadImageA; external cctrl name 'ImageList_LoadImageA';
! function ImageList_LoadImageW; external cctrl name 'ImageList_LoadImageW';
! 
! procedure DrawStatusText; external cctrl name 'DrawStatusTextA';
! procedure DrawStatusTextA; external cctrl name 'DrawStatusTextA';
! procedure DrawStatusTextW; external cctrl name 'DrawStatusTextW';
! function CreateStatusWindow; external cctrl name 'CreateStatusWindowA';
! function CreateStatusWindowA; external cctrl name 'CreateStatusWindowA';
! function CreateStatusWindowW; external cctrl name 'CreateStatusWindowW';
! 
! 
! delphi seems to use the callback method to provide windows with the text
! 
! LVM_SETUNICODEFORMAT
! 
! LVM_GETITEM
! LVM_SETITEM
! LVM_INSERTITEM
! 
! LVM_FINDITEM
! LVM_GETSTRINGWIDTH
! LVM_HITTEST?
! 
! LVM_GETCOLUMN
! LVM_SETCOLUMN
! LVM_INSERTCOLUMN
! 
! LVM_GETITEMTEXT
! LVM_SETITEMTEXT
! 
! LVM_SORTITEMS
! LVM_GETISEARCHSTRING
! 
! and the callback of
! 
! LVN_GETDISPINFO
! LVN_ODFINDITEM
! 
! 
! and alot more of the HDM_* and TVM_*
--- 1,49 ----
! function CreatePropertySheetPage; external cctrl name 'CreatePropertySheetPageA';
! function CreatePropertySheetPageA; external cctrl name 'CreatePropertySheetPageA';
! function CreatePropertySheetPageW; external cctrl name 'CreatePropertySheetPageW';
! function DestroyPropertySheetPage; external cctrl name 'DestroyPropertySheetPage';
! function PropertySheet; external cctrl name 'PropertySheetA';
! function PropertySheetA; external cctrl name 'PropertySheetA';
! function PropertySheetW; external cctrl name 'PropertySheetW';
! 
! function ImageList_LoadImage; external cctrl name 'ImageList_LoadImageA';
! function ImageList_LoadImageA; external cctrl name 'ImageList_LoadImageA';
! function ImageList_LoadImageW; external cctrl name 'ImageList_LoadImageW';
! 
! procedure DrawStatusText; external cctrl name 'DrawStatusTextA';
! procedure DrawStatusTextA; external cctrl name 'DrawStatusTextA';
! procedure DrawStatusTextW; external cctrl name 'DrawStatusTextW';
! function CreateStatusWindow; external cctrl name 'CreateStatusWindowA';
! function CreateStatusWindowA; external cctrl name 'CreateStatusWindowA';
! function CreateStatusWindowW; external cctrl name 'CreateStatusWindowW';
! 
! 
! delphi seems to use the callback method to provide windows with the text
! 
! LVM_SETUNICODEFORMAT
! 
! LVM_GETITEM
! LVM_SETITEM
! LVM_INSERTITEM
! 
! LVM_FINDITEM
! LVM_GETSTRINGWIDTH
! LVM_HITTEST?
! 
! LVM_GETCOLUMN
! LVM_SETCOLUMN
! LVM_INSERTCOLUMN
! 
! LVM_GETITEMTEXT
! LVM_SETITEMTEXT
! 
! LVM_SORTITEMS
! LVM_GETISEARCHSTRING
! 
! and the callback of
! 
! LVN_GETDISPINFO
! LVN_ODFINDITEM
! 
! 
! and alot more of the HDM_* and TVM_*

Index: TestForm.pas
===================================================================
RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.pas,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** TestForm.pas	15 Mar 2007 12:09:49 -0000	1.15
--- TestForm.pas	16 Mar 2007 23:39:11 -0000	1.16
***************
*** 38,41 ****
--- 38,42 ----
      procedure Button3Click(Sender: TObject);
      procedure Button4Click(Sender: TObject);
+     procedure Edit1Change(Sender: TObject);
    public
    end;
***************
*** 115,118 ****
--- 116,120 ----
    ListView1.Items[1].Caption := TestText;
    ListView1.Items[0].SubItems[0] := TestText;
+   CheckTranslation(ListView1.Name, ListView1.Items[0].SubItems[0]);
    ListView1.Items[1].SubItems[0] := TestText;
  end;
***************
*** 238,241 ****
--- 240,248 ----
  end;
  
+ procedure TForm1.Edit1Change(Sender: TObject);
+ begin
+   Sender := Sender;
+ end;
+ 
  end.