paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 18:59:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Modified utf patch from Felipe Monteiro de Carvalho

Browse Source 
git-svn-id: trunk@10196 -
This commit is contained in:
marc 2006-11-14 00:31:49 +00:00
parent b2dd5fc016
commit 1c99781bc5
4 changed files with 109 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/interfaces/win32/win32callback.inc
View File

@ -81,8 +81,12 @@ begin
MessageStackDepth[depthLen] := '#';
{$endif}
PrevWndProc := GetWindowInfo(Window)^.DefWndProc;
if PrevWndProc = nil then
Result := Windows.DefWindowProc(Window, Msg, WParam, LParam)
if PrevWndProc = nil
then begin
if UnicodeEnabledOS
then Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam)
else Result := Windows.DefWindowProc(Window, Msg, WParam, LParam)
end
else begin
// combobox child edit weirdness: combobox handling WM_SIZE will compare text
// to list of strings, and if appears in there, will set the text, and select it
@ -2127,8 +2131,10 @@ begin
// free our own data associated with window
DisposeWindowInfo(Window);
end;
else
Result := Windows.DefWindowProc(Window, Msg, WParam, LParam);
else
if UnicodeEnabledOS
then Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam)
else Result := Windows.DefWindowProc(Window, Msg, WParam, LParam);
end;
end;

60
lcl/interfaces/win32/win32object.inc
View File

@ -409,7 +409,13 @@ End;
procedure TWin32WidgetSet.AppSetTitle(const ATitle: string);
begin
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS
then Windows.SetWindowTextW(FAppHandle, Utf8ToPWideChar(ATitle))
else Windows.SetWindowText(FAppHandle, PChar(Utf8ToAnsi(ATitle)));
{$else}
Windows.SetWindowText(FAppHandle, PChar(ATitle));
{$endif}
end;
{------------------------------------------------------------------------------
@ -499,24 +505,46 @@ end;
Function TWin32WidgetSet.WinRegister: Boolean;
Var
WindowClass: WndClass;
WindowClassW: WndClassW;
Begin
Assert(False, 'Trace:WinRegister - Start');
With WindowClass Do
Begin
Style := CS_DBLCLKS{CS_HRedraw or CS_VRedraw};
LPFnWndProc := @WindowProc;
CbClsExtra := 0;
CbWndExtra := 0;
hInstance := System.HInstance;
hIcon := Windows.LoadIcon(MainInstance, 'MAINICON');
if hIcon = 0 then
hIcon := Windows.LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := 0; {GetSysColorBrush(Color_BtnFace);}
LPSzMenuName := Nil;
LPSzClassName := @ClsName;
End;
Result := Windows.RegisterClass(@WindowClass) <> 0;
if UnicodeEnabledOS
then begin
with WindowClassW do
begin
Style := CS_DBLCLKS{CS_HRedraw or CS_VRedraw};
LPFnWndProc := @WindowProc;
CbClsExtra := 0;
CbWndExtra := 0;
hInstance := System.HInstance;
hIcon := Windows.LoadIcon(MainInstance, 'MAINICON');
if hIcon = 0 then
hIcon := Windows.LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := 0; {GetSysColorBrush(Color_BtnFace);}
LPSzMenuName := Nil;
LPSzClassName := Utf8PCharToPWideChar(@ClsName);
end;
Result := Windows.RegisterClassW(@WindowClassW) <> 0;
end
else begin
with WindowClass do
begin
Style := CS_DBLCLKS{CS_HRedraw or CS_VRedraw};
LPFnWndProc := @WindowProc;
CbClsExtra := 0;
CbWndExtra := 0;
hInstance := System.HInstance;
hIcon := Windows.LoadIcon(MainInstance, 'MAINICON');
if hIcon = 0 then
hIcon := Windows.LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := 0; {GetSysColorBrush(Color_BtnFace);}
LPSzMenuName := Nil;
LPSzClassName := @ClsName;
end;
Result := Windows.RegisterClass(@WindowClass) <> 0;
end;
Assert(False, 'Trace:WinRegister - Exit');
End;

41
lcl/interfaces/win32/win32proc.pp
View File

@ -107,6 +107,11 @@ procedure RedrawMenus;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
function GetControlText(AHandle: HWND): string;
// String functions
function Utf8PCharToPWideChar(param: PChar): PWideChar;
function Utf8ToPWideChar(param: string): PWideChar;
type
PDisableWindowsInfo = ^TDisableWindowsInfo;
TDisableWindowsInfo = record
@ -118,6 +123,7 @@ var
DefaultWindowInfo: TWindowInfo;
WindowInfoAtom: ATOM;
ChangedMenus: TList; // list of HWNDs which menus needs to be redrawn
UnicodeEnabledOS: Boolean = False;
implementation
@ -1130,6 +1136,34 @@ begin
GetWindowText(AHandle, PChar(Result), TextLen + 1);
end;
function Utf8PCharToPWideChar(param: PChar): PWideChar;
begin
Result := PWideChar(Utf8Decode(string(param)));
end;
function Utf8ToPWideChar(param: string): PWideChar;
begin
Result := PWideChar(Utf8Decode(param));
end;
procedure DoInitialization;
var
WinVersion: TOSVersionInfo;
begin
FillChar(DefaultWindowInfo, sizeof(DefaultWindowInfo), 0);
DefaultWindowInfo.DrawItemIndex := -1;
WindowInfoAtom := Windows.GlobalAddAtom('WindowInfo');
ChangedMenus := TList.Create;
{$ifdef WindowsUnicodeSupport}
WinVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(WinVersion);
UnicodeEnabledOS := (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_NT);
{$endif}
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
@ -1137,11 +1171,8 @@ end;
{$ENDIF}
initialization
FillChar(DefaultWindowInfo, sizeof(DefaultWindowInfo), 0);
DefaultWindowInfo.DrawItemIndex := -1;
WindowInfoAtom := Windows.GlobalAddAtom('WindowInfo');
ChangedMenus := TList.Create;
DoInitialization;
finalization

20
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -200,8 +200,20 @@ begin
end else begin
MenuHandle := HMENU(nil);
end;
Window := CreateWindowEx(FlagsEx, pClassName, WindowTitle, Flags,
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
Window := CreateWindowExW(FlagsEx, Utf8PCharToPWideChar(pClassName),
Utf8PCharToPWideChar(WindowTitle), Flags,
Left, Top, Width, Height, Parent, MenuHandle, HInstance, Nil)
else
Window := CreateWindowEx(FlagsEx, pClassName, PChar(Utf8ToAnsi(WindowTitle)), Flags,
Left, Top, Width, Height, Parent, MenuHandle, HInstance, Nil);
{$else}
Window := CreateWindowEx(FlagsEx, pClassName, WindowTitle, Flags,
Left, Top, Width, Height, Parent, MenuHandle, HInstance, Nil);
{$endif}
if Window = 0 then
begin
raise exception.create('failed to create win32 control, error: '+IntToStr(GetLastError()));
@ -415,7 +427,13 @@ class procedure TWin32WSWinControl.SetText(const AWinControl: TWinControl; const
Begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS
then Windows.SetWindowTextW(AWinControl.Handle, Utf8ToPWideChar(AText))
else Windows.SetWindowText(AWinControl.Handle, PChar(Utf8ToAnsi(AText)));
{$else}
Windows.SetWindowText(AWinControl.Handle, PChar(AText));
{$endif}
End;
class procedure TWin32WSWinControl.ConstraintsChange(const AWinControl: TWinControl);