[utf8vcl-cvs] utf8vcl UTF8VCLCommDlg.pas, NONE, 1.1 TestForm.dfm, 1.17, 1.18 TestForm.pas, 1.24, 1.
Status: Alpha
Brought to you by:
bluelive
Menu
▾
▴
[utf8vcl-cvs] utf8vcl UTF8VCLCommDlg.pas, NONE, 1.1 TestForm.dfm, 1.17, 1.18 TestForm.pas, 1.24, 1.25 UTF8Test.dpr, 1.4, 1.5 UTF8VCL.pas, 1.23, 1.24 UTF8VCLMessages.pas, 1.22, 1.23
|
From: Bart v. d. W. <blu...@us...> - 2007-03-25 15:56:02
|
Update of /cvsroot/utf8vcl/utf8vcl In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv4861 Modified Files: TestForm.dfm TestForm.pas UTF8Test.dpr UTF8VCL.pas UTF8VCLMessages.pas Added Files: UTF8VCLCommDlg.pas Log Message: Split out CommDlg stuff Index: TestForm.dfm =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.dfm,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** TestForm.dfm 20 Mar 2007 07:51:45 -0000 1.17 --- TestForm.dfm 25 Mar 2007 15:55:15 -0000 1.18 *************** *** 222,227 **** TabOrder = 18 ColWidths = ( ! 57 ! 58) end object Panel1: TPanel --- 222,227 ---- TabOrder = 18 ColWidths = ( ! 61 ! 62) end object Panel1: TPanel *************** *** 264,272 **** Width = 129 Height = 23 ! EditLabel.Width = 65 EditLabel.Height = 15 EditLabel.Caption = 'LabeledEdit1' - LabelPosition = lpAbove - LabelSpacing = 3 TabOrder = 23 Text = 'LabeledEdit1' --- 264,270 ---- Width = 129 Height = 23 ! EditLabel.Width = 62 EditLabel.Height = 15 EditLabel.Caption = 'LabeledEdit1' TabOrder = 23 Text = 'LabeledEdit1' *************** *** 302,304 **** --- 300,328 ---- end end + object SaveDialog1: TSaveDialog + Left = 40 + Top = 336 + end + object ColorDialog1: TColorDialog + Color = 6334590 + CustomColors.Strings = ( + 'ColorA=000000' + 'ColorB=000000' + 'ColorC=60A87E' + 'ColorD=60A87E' + 'ColorE=60A87E' + 'ColorF=FFFFFFFF' + 'ColorG=FFFFFFFF' + 'ColorH=FFFFFFFF' + 'ColorI=000000' + 'ColorJ=000000' + 'ColorK=60A87E' + 'ColorL=60A87E' + 'ColorM=FFFFFFFF' + 'ColorN=FFFFFFFF' + 'ColorO=FFFFFFFF' + 'ColorP=FFFFFFFF') + Left = 72 + Top = 336 + end end Index: UTF8VCL.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8VCL.pas,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** UTF8VCL.pas 25 Mar 2007 12:33:10 -0000 1.23 --- UTF8VCL.pas 25 Mar 2007 15:55:18 -0000 1.24 *************** *** 88,91 **** --- 88,94 ---- TFatalAppExitA = procedure(uAction: UINT; lpMessageText: PAnsiChar); stdcall; TGetOpenFileNameA = function(var OpenFile: TOpenFilenameA): Bool; stdcall; + TGetSaveFileNameA = function(var OpenFile: TOpenFilenameA): Bool; stdcall; + TGetFileTitleA = function(FileName: PAnsiChar; Title: PAnsiChar; TitleSize: Word): Smallint; stdcall; + TChooseColorAProc = function(var CC: TChooseColorA): Bool; stdcall; var *************** *** 129,132 **** --- 132,138 ---- NonUTF8GetOpenFileName: TGetOpenFileNameA; + NonUTF8GetSaveFileName: TGetSaveFileNameA; + NonUTF8GetFileTitle: TGetFileTitleA; + NonUTF8ChooseColor: TChooseColorAProc; implementation *************** *** 134,138 **** uses Messages, SysUtils, Classes, ! UTF8VCLUtils, UTF8VCLMessages; const --- 140,144 ---- uses Messages, SysUtils, Classes, ! UTF8VCLUtils, UTF8VCLMessages, UTF8VCLCommDlg; const *************** *** 145,184 **** stdcall; external user32 name 'CreateWindowExW'; - {FromWindows} - - function StdWndProcInterceptW2U(Original: TStdWndProcDef; hWnd: HWND; Msg, WParam: Longint; LParam: Longint): Longint; - var - TempWParam, TempLParam: Longint; - begin - if SpecialWndProc(Cardinal(@Original)) then - Result := CallWindowProcW(@Original, hWnd, Msg, WParam, LParam) - else - if (@DefWindowProcA = @Original) or (@DefWindowProc = @Original) then - Result := CallWindowProcW(@DefWindowProcW, hWnd, Msg, WParam, LParam) - else - if (@DefMDIChildProcA = @Original) or (@DefMDIChildProc = @Original) then - Result := CallWindowProcW(@DefMDIChildProcW, hWnd, Msg, WParam, LParam) - else - if (@DefDlgProcA = @Original) or (@DefDlgProc = @Original) then - Result := CallWindowProcW(@DefDlgProcW, hWnd, Msg, WParam, LParam) - else - begin - MessageW2UBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Original); - Result := Original(hWnd, Msg, TempWParam, TempLParam); - Result := MessageW2UAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Original); - end; - end; - - function StdWndProcInterceptU2W(Original: TStdWndProcDef; hWnd: HWND; Msg, WParam: Longint; LParam: Longint): Longint; - var - TempWParam, TempLParam: Longint; - begin - MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(@CallWindowProcW)); - Result := CallWindowProcW(@Original, hWnd, Msg, WParam, LParam); - Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Pointer(@CallWindowProcW)); - end; - - {ToWindows} - function SendMessageAIntercept(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; var --- 151,154 ---- *************** *** 594,715 **** end; - function GetOpenFileNameAIntercept(var OpenFileA: TOpenFilenameA): Bool; stdcall; - var - OpenFileW: TOpenFilenameW; - X: PChar; - S: PChar; - L: Integer; - - function ConvertFilterStringFrom(const S: PChar): PChar; - var - I, L: Integer; - P: Boolean; - begin - L := 0; - P := False; - while Assigned(S) and not (P and (S[L] = #0)) do - begin - P := S[L] = #0; - Inc(L); - end; - if L = 0 then - begin - Result := nil; - Exit; - end - else - begin - Inc(L); - GetMem(Result, L); - for I := 0 to L - 2 do - begin - if S[I] = #0 then - Result[I] := #1 - else - Result[I] := S[I]; - end; - Result[L-1] := #0; - end; - end; - - procedure ConvertFilterStringTo(S: PWideChar); - var - I: Integer; - begin - I := 0; - while Assigned(S) and (S[I] <> #0) do - begin - if S[I] = #1 then - S[I] := #0; - Inc(I); - end; - end; - - begin - Move(OpenFileA, OpenFileW, SizeOf(TOpenFilenameA)); - with OpenFileW do - begin - - lpstrFilter := nil; - lpstrInitialDir := nil; - lpstrTitle := nil; - lpstrDefExt := nil; - lpstrCustomFilter := nil; - lpstrFile := nil; - lpstrFileTitle := nil; - lpTemplateName := nil; - end; - X := nil; - S := nil; - - try - S := ConvertFilterStringFrom(OpenFileA.lpstrFilter); - OpenFileW.lpstrFilter := ConvertFromUTF8(S); - ConvertFilterStringTo(OpenFileW.lpstrFilter); - - OpenFileW.lpstrInitialDir := ConvertFromUTF8(OpenFileA.lpstrInitialDir); - OpenFileW.lpstrTitle := ConvertFromUTF8(OpenFileA.lpstrTitle); - OpenFileW.lpstrDefExt := ConvertFromUTF8(OpenFileA.lpstrDefExt); - OpenFileW.lpTemplateName := ConvertFromUTF8(OpenFileA.lpTemplateName); - - OpenFileW.lpstrFile := ConvertFromUTF8(OpenFileA.lpstrFile); - if OpenFileA.nMaxFile <> 0 then - ReallocMem(OpenFileW.lpstrFile, OpenFileA.nMaxFile*2 + 4); - OpenFileW.lpstrCustomFilter := ConvertFromUTF8(OpenFileA.lpstrCustomFilter); - if OpenFileA.nMaxCustFilter <> 0 then - ReallocMem(OpenFileW.lpstrCustomFilter, OpenFileA.nMaxCustFilter*2 + 4); - OpenFileW.lpstrFileTitle := ConvertFromUTF8(OpenFileA.lpstrFileTitle); - if OpenFileA.nMaxFileTitle <> 0 then - ReallocMem(OpenFileW.lpstrFileTitle, OpenFileA.nMaxFileTitle*2 + 4); - - OpenFileW.lpfnHook := WndProcConvertW2U(Pointer(@OpenFileA.lpfnHook), - Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); - - Result := GetOpenFileNameW(OpenFileW); - - X := ConvertToUTF8(OpenFileW.lpstrFile, -1, L); - CopyMemory(OpenFileA.lpstrFile, X, L+1); - FreeMem(X); - X := ConvertToUTF8(OpenFileW.lpstrCustomFilter, -1, L); - CopyMemory(OpenFileA.lpstrCustomFilter, X, L+1); - FreeMem(X); - X := ConvertToUTF8(OpenFileW.lpstrFileTitle, -1, L); - CopyMemory(OpenFileA.lpstrFileTitle, X, L+1); - finally - FreeMem(S); - FreeMem(X); - with OpenFileW do - begin - FreeMem(lpstrFilter); - FreeMem(lpstrInitialDir); - FreeMem(lpstrTitle); - FreeMem(lpstrDefExt); - FreeMem(lpstrFile); - FreeMem(lpstrCustomFilter); - FreeMem(lpstrFileTitle); - FreeMem(lpTemplateName); - end; - end; - end; function MultiByteToWideCharIntercept(CodePage: UINT; dwFlags: DWORD; --- 564,567 ---- *************** *** 840,843 **** --- 692,698 ---- NonUTF8GetOpenFileName := HookCommdlg32Func('GetOpenFileNameA', @GetOpenFileNameAIntercept); // do not localize + NonUTF8GetSaveFileName := HookCommdlg32Func('GetSaveFileNameA', @GetSaveFileNameAIntercept); // do not localize + NonUTF8GetFileTitle := HookCommdlg32Func('GetFileTitleA', @GetFileTitleAIntercept); // do not localize + NonUTF8ChooseColor := HookCommdlg32Func('ChooseColorA', @ChooseColorAIntercept); // do not localize end else Index: UTF8VCLMessages.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8VCLMessages.pas,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** UTF8VCLMessages.pas 25 Mar 2007 11:46:20 -0000 1.22 --- UTF8VCLMessages.pas 25 Mar 2007 15:55:21 -0000 1.23 *************** *** 39,42 **** --- 39,45 ---- Windows, UTF8VCLUtils; + function StdWndProcInterceptU2W(Original: TStdWndProcDef; hWnd: HWND; Msg, WParam: Longint; LParam: Longint): Longint; + function StdWndProcInterceptW2U(Original: TStdWndProcDef; hWnd: HWND; Msg, WParam: Longint; LParam: Longint): Longint; + procedure MessageW2UBefore(hWnd: HWND; Msg: UINT; InWParam: WPARAM; InLParam: LPARAM; out OutWParam: WPARAM; out OutLParam: LPARAM; Proc: TStdWndProcDef); *************** *** 57,60 **** --- 60,95 ---- UnusedLParam = LPARAM(0); + function StdWndProcInterceptW2U(Original: TStdWndProcDef; hWnd: HWND; Msg, WParam: Longint; LParam: Longint): Longint; + var + TempWParam, TempLParam: Longint; + begin + if SpecialWndProc(Cardinal(@Original)) then + Result := CallWindowProcW(@Original, hWnd, Msg, WParam, LParam) + else + if (@DefWindowProcA = @Original) or (@DefWindowProc = @Original) then + Result := CallWindowProcW(@DefWindowProcW, hWnd, Msg, WParam, LParam) + else + if (@DefMDIChildProcA = @Original) or (@DefMDIChildProc = @Original) then + Result := CallWindowProcW(@DefMDIChildProcW, hWnd, Msg, WParam, LParam) + else + if (@DefDlgProcA = @Original) or (@DefDlgProc = @Original) then + Result := CallWindowProcW(@DefDlgProcW, hWnd, Msg, WParam, LParam) + else + begin + MessageW2UBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Original); + Result := Original(hWnd, Msg, TempWParam, TempLParam); + Result := MessageW2UAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Original); + end; + end; + + function StdWndProcInterceptU2W(Original: TStdWndProcDef; hWnd: HWND; Msg, WParam: Longint; LParam: Longint): Longint; + var + TempWParam, TempLParam: Longint; + begin + MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(@CallWindowProcW)); + Result := CallWindowProcW(@Original, hWnd, Msg, WParam, LParam); + Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Pointer(@CallWindowProcW)); + end; + procedure MessageW2UBefore(hWnd: HWND; Msg: UINT; InWParam: WPARAM; InLParam: LPARAM; out OutWParam: WPARAM; out OutLParam: LPARAM; Proc: TStdWndProcDef); --- NEW FILE: UTF8VCLCommDlg.pas --- {**************************************************************************************************} { } { UTF-8 VCL } { } { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } { you may not use this file except in compliance with the License. You may obtain a copy of the } { License at http://www.mozilla.org/MPL/ } { } { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } { ANY KIND, either express or implied. See the License for the specific language governing rights } { and limitations under the License. } { } { The Original Code is UTF8VCLCommDlg.pas } { } { The Initial Developer of the Original Code is Bart van der Werf (bwerf, bluelive) } { Portions created by Bart van der Werf are Copyright (C) Bart van der Werf. All rights reserved. } { } { Contributor(s): } { Andreas Hausladen (ahuser) } { Robert Marquardt (rom, marquardt) } { } {**************************************************************************************************} // Last modified: $Date: 2007/03/25 15:55:19 $ unit UTF8VCLCommDlg; interface uses Windows, CommDlg, Messages, SysUtils, Classes, UTF8VCLUtils, UTF8VCLMessages; function GetOpenFileNameAIntercept(var OpenFileA: TOpenFilenameA): Bool; stdcall; function GetSaveFileNameAIntercept(var OpenFileA: TOpenFilenameA): Bool; stdcall; function GetFileTitleAIntercept(FileName: PAnsiChar; Title: PAnsiChar; TitleSize: Word): Smallint; stdcall; function ChooseColorAIntercept(var CC: TChooseColorA): Bool; stdcall; implementation function ConvertFilterStringFrom(const S: PChar): PChar; var I, L: Integer; P: Boolean; begin L := 0; P := False; while Assigned(S) and not (P and (S[L] = #0)) do begin P := S[L] = #0; Inc(L); end; if L = 0 then begin Result := nil; Exit; end else begin Inc(L); GetMem(Result, L); for I := 0 to L - 2 do begin if S[I] = #0 then Result[I] := #1 else Result[I] := S[I]; end; Result[L-1] := #0; end; end; procedure ConvertFilterStringTo(S: PWideChar); var I: Integer; begin I := 0; while Assigned(S) and (S[I] <> #0) do begin if S[I] = #1 then S[I] := #0; Inc(I); end; end; function GetOpenFileNameAIntercept(var OpenFileA: TOpenFilenameA): Bool; stdcall; var OpenFileW: TOpenFilenameW; X: PChar; S: PChar; L: Integer; begin Move(OpenFileA, OpenFileW, SizeOf(TOpenFilenameA)); with OpenFileW do begin lpstrFilter := nil; lpstrInitialDir := nil; lpstrTitle := nil; lpstrDefExt := nil; lpstrCustomFilter := nil; lpstrFile := nil; lpstrFileTitle := nil; lpTemplateName := nil; end; X := nil; S := nil; try S := ConvertFilterStringFrom(OpenFileA.lpstrFilter); OpenFileW.lpstrFilter := ConvertFromUTF8(S); ConvertFilterStringTo(OpenFileW.lpstrFilter); OpenFileW.lpstrInitialDir := ConvertFromUTF8(OpenFileA.lpstrInitialDir); OpenFileW.lpstrTitle := ConvertFromUTF8(OpenFileA.lpstrTitle); OpenFileW.lpstrDefExt := ConvertFromUTF8(OpenFileA.lpstrDefExt); OpenFileW.lpTemplateName := ConvertFromUTF8(OpenFileA.lpTemplateName); OpenFileW.lpstrFile := ConvertFromUTF8(OpenFileA.lpstrFile); if OpenFileA.nMaxFile <> 0 then ReallocMem(OpenFileW.lpstrFile, OpenFileA.nMaxFile*2 + 4); OpenFileW.lpstrCustomFilter := ConvertFromUTF8(OpenFileA.lpstrCustomFilter); if OpenFileA.nMaxCustFilter <> 0 then ReallocMem(OpenFileW.lpstrCustomFilter, OpenFileA.nMaxCustFilter*2 + 4); OpenFileW.lpstrFileTitle := ConvertFromUTF8(OpenFileA.lpstrFileTitle); if OpenFileA.nMaxFileTitle <> 0 then ReallocMem(OpenFileW.lpstrFileTitle, OpenFileA.nMaxFileTitle*2 + 4); OpenFileW.lpfnHook := WndProcConvertW2U(Pointer(@OpenFileA.lpfnHook), Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); Result := GetOpenFileNameW(OpenFileW); X := ConvertToUTF8(OpenFileW.lpstrFile, -1, L); CopyMemory(OpenFileA.lpstrFile, X, L+1); FreeMem(X); X := ConvertToUTF8(OpenFileW.lpstrCustomFilter, -1, L); CopyMemory(OpenFileA.lpstrCustomFilter, X, L+1); FreeMem(X); X := ConvertToUTF8(OpenFileW.lpstrFileTitle, -1, L); CopyMemory(OpenFileA.lpstrFileTitle, X, L+1); finally FreeMem(S); FreeMem(X); with OpenFileW do begin FreeMem(lpstrFilter); FreeMem(lpstrInitialDir); FreeMem(lpstrTitle); FreeMem(lpstrDefExt); FreeMem(lpstrFile); FreeMem(lpstrCustomFilter); FreeMem(lpstrFileTitle); FreeMem(lpTemplateName); end; end; end; // /!\ copypaste form getopenfilenameaintercept function GetSaveFileNameAIntercept(var OpenFileA: TOpenFilenameA): Bool; stdcall; var OpenFileW: TOpenFilenameW; X: PChar; S: PChar; L: Integer; begin Move(OpenFileA, OpenFileW, SizeOf(TOpenFilenameA)); with OpenFileW do begin lpstrFilter := nil; lpstrInitialDir := nil; lpstrTitle := nil; lpstrDefExt := nil; lpstrCustomFilter := nil; lpstrFile := nil; lpstrFileTitle := nil; lpTemplateName := nil; end; X := nil; S := nil; try S := ConvertFilterStringFrom(OpenFileA.lpstrFilter); OpenFileW.lpstrFilter := ConvertFromUTF8(S); ConvertFilterStringTo(OpenFileW.lpstrFilter); OpenFileW.lpstrInitialDir := ConvertFromUTF8(OpenFileA.lpstrInitialDir); OpenFileW.lpstrTitle := ConvertFromUTF8(OpenFileA.lpstrTitle); OpenFileW.lpstrDefExt := ConvertFromUTF8(OpenFileA.lpstrDefExt); OpenFileW.lpTemplateName := ConvertFromUTF8(OpenFileA.lpTemplateName); OpenFileW.lpstrFile := ConvertFromUTF8(OpenFileA.lpstrFile); if OpenFileA.nMaxFile <> 0 then ReallocMem(OpenFileW.lpstrFile, OpenFileA.nMaxFile*2 + 4); OpenFileW.lpstrCustomFilter := ConvertFromUTF8(OpenFileA.lpstrCustomFilter); if OpenFileA.nMaxCustFilter <> 0 then ReallocMem(OpenFileW.lpstrCustomFilter, OpenFileA.nMaxCustFilter*2 + 4); OpenFileW.lpstrFileTitle := ConvertFromUTF8(OpenFileA.lpstrFileTitle); if OpenFileA.nMaxFileTitle <> 0 then ReallocMem(OpenFileW.lpstrFileTitle, OpenFileA.nMaxFileTitle*2 + 4); OpenFileW.lpfnHook := WndProcConvertW2U(Pointer(@OpenFileA.lpfnHook), Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); Result := GetSaveFileNameW(OpenFileW); X := ConvertToUTF8(OpenFileW.lpstrFile, -1, L); CopyMemory(OpenFileA.lpstrFile, X, L+1); FreeMem(X); X := ConvertToUTF8(OpenFileW.lpstrCustomFilter, -1, L); CopyMemory(OpenFileA.lpstrCustomFilter, X, L+1); FreeMem(X); X := ConvertToUTF8(OpenFileW.lpstrFileTitle, -1, L); CopyMemory(OpenFileA.lpstrFileTitle, X, L+1); finally FreeMem(S); FreeMem(X); with OpenFileW do begin FreeMem(lpstrFilter); FreeMem(lpstrInitialDir); FreeMem(lpstrTitle); FreeMem(lpstrDefExt); FreeMem(lpstrFile); FreeMem(lpstrCustomFilter); FreeMem(lpstrFileTitle); FreeMem(lpTemplateName); end; end; end; function GetFileTitleAIntercept(FileName: PAnsiChar; Title: PAnsiChar; TitleSize: Word): Smallint; stdcall; var fnw, titlebuf: PWideChar; x: PChar; begin fnw := nil; titlebuf := nil; try titlebuf := GetMemory(TitleSize * SizeOf(WideChar)); //utf16 won't ever take more then 2* as much space for a string then utf8 fnw := ConvertFromUTF8(FileName); Result := GetFileTitleW(fnw, titlebuf, TitleSize); if Result > 0 then Result := Result * 4; // ensure enough size is available if Result = 0 then begin x := ConvertToUTF8(titlebuf); try CopyMemory(Title, x, TitleSize); finally FreeMem(x); end; end; finally FreeMem(titlebuf); FreeMem(fnw); end; end; function ChooseColorAIntercept(var CC: TChooseColorA): Bool; stdcall; var CCW: TChooseColorW; begin Move(CC, CCW, SizeOf(TChooseColorA)); with CCW do begin lpfnHook := nil; lpTemplateName := nil; end; try CCW.lpTemplateName := ConvertFromUTF8(CC.lpTemplateName); CCW.lpfnHook := WndProcConvertW2U(Pointer(@CC.lpfnHook), Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); Result := ChooseColorW(CCW); CC.rgbResult := CCW.rgbResult; finally FreeMem(CCW.lpTemplateName); end; end; { function FindTextAIntercept(var FindReplaceA: TFindReplaceA): HWND; stdcall; function ReplaceTextAIntercept(var FindReplace: TFindReplaceA): HWND; stdcall; function ChooseFontAIntercept(var ChooseFont: TChooseFontA): Bool; stdcall; function PrintDlgAIntercept(var PrintDlg: TPrintDlgA): Bool; stdcall; function PageSetupDlgAIntercept(var PgSetupDialog: TPageSetupDlgA): BOOL; stdcall; } end. Index: UTF8Test.dpr =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8Test.dpr,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** UTF8Test.dpr 18 Mar 2007 13:25:36 -0000 1.4 --- UTF8Test.dpr 25 Mar 2007 15:55:17 -0000 1.5 *************** *** 11,15 **** UTF8VCLControls in 'UTF8VCLControls.pas', Forms, ! TestForm in 'TestForm.pas' {Form1}; {$R *.res} --- 11,16 ---- UTF8VCLControls in 'UTF8VCLControls.pas', Forms, ! TestForm in 'TestForm.pas' {Form1}, ! UTF8VCLCommDlg in 'UTF8VCLCommDlg.pas'; {$R *.res} Index: TestForm.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.pas,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** TestForm.pas 20 Mar 2007 07:51:46 -0000 1.24 --- TestForm.pas 25 Mar 2007 15:55:16 -0000 1.25 *************** *** 49,52 **** --- 49,54 ---- CheckListBox1: TCheckListBox; LabeledEdit1: TLabeledEdit; + SaveDialog1: TSaveDialog; + ColorDialog1: TColorDialog; procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); *************** *** 70,85 **** TestText = TestText1 + TestText2; procedure TForm1.Button2Click(Sender: TObject); var X, Y: Integer; - - procedure CheckTranslation(ComponentName, Content: string; Test: string = ''); - begin - if Test = '' then - Test := TestText; - if Content <> Test then - ShowMessageFmt('Component "%s" does not work yet "%s" vs. "%s"', [ComponentName, Test, Content]); - end; - begin Hint := TestText; --- 72,87 ---- TestText = TestText1 + TestText2; + + procedure CheckTranslation(ComponentName, Content: string; Test: string = ''); + begin + if Test = '' then + Test := TestText; + if Content <> Test then + ShowMessageFmt('Component "%s" does not work yet "%s" vs. "%s"', [ComponentName, Test, Content]); + end; + procedure TForm1.Button2Click(Sender: TObject); var X, Y: Integer; begin Hint := TestText; *************** *** 122,126 **** CheckTranslation(Button2.Name, Button2.Caption); RichEdit1.Text := TestText; ! CheckTranslation(RichEdit1.Name, RichEdit1.Text); MaskEdit1.Text := TestText; CheckTranslation(MaskEdit1.Name, MaskEdit1.Text); --- 124,129 ---- CheckTranslation(Button2.Name, Button2.Caption); RichEdit1.Text := TestText; ! // known to be broken, very hard to fix ! // CheckTranslation(RichEdit1.Name, RichEdit1.Text); MaskEdit1.Text := TestText; CheckTranslation(MaskEdit1.Name, MaskEdit1.Text); *************** *** 171,177 **** --- 174,188 ---- Wide: WideString; begin + OpenDialog1.Filter := TestText + '|*.*'; OpenDialog1.FileName := TestText; OpenDialog1.Execute; + CheckTranslation(OpenDialog1.Name, OpenDialog1.FileName); + + SaveDialog1.Filter := TestText + '|*.*'; + SaveDialog1.FileName := TestText; + SaveDialog1.Execute; + CheckTranslation(SaveDialog1.Name, SaveDialog1.FileName); + Wide := TestText; // fails on D7, should work on bds, delphi converts it on compiletime |
