mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 17:55:55 +02:00
Support compiling on Win32 widgetset with -Sy option.
This commit is contained in:
JuhaManninen
parent
db2bca3949
commit
dd362403a3
@ -91,7 +91,7 @@ function TOLEStream.Read(var Buffer; Count: Integer): Integer;
|
||||
var
|
||||
Res: HRESULT;
|
||||
begin
|
||||
Res:=FSrcStream.Read(@Buffer, Count, @Result);
|
||||
Res:=FSrcStream.Read(@Buffer, Count, @Cardinal(Result));
|
||||
if Res <> S_OK then
|
||||
Raise Exception.Create('TOLEStream - Error while reading: '+ErrorString(Res));
|
||||
end;
|
||||
@ -144,7 +144,7 @@ function TOLEStream.Write(const Buffer; Count: Integer): Integer;
|
||||
var
|
||||
Res: HRESULT;
|
||||
begin
|
||||
Res:=FSrcStream.Write(@Buffer,Count,@Result);
|
||||
Res:=FSrcStream.Write(@Buffer,Count,@Cardinal(Result));
|
||||
if Res <> S_OK then
|
||||
Raise Exception.Create('TOLEStream - Error while writing: '+ErrorString(Res));
|
||||
end;
|
||||
|
||||
@ -82,13 +82,11 @@ end;
|
||||
procedure TSynEditStringSystemWidthChars.DoGetPhysicalCharWidths(Line: PChar; LineLen,
|
||||
Index: Integer; PWidths: PPhysicalCharWidth);
|
||||
var
|
||||
//s: UnicodeString;// wideString;
|
||||
i: DWORD;
|
||||
cpRes: TGCPRESULTS;
|
||||
cpRes: TGCPRESULTSW;
|
||||
outs: array of widechar;
|
||||
order, dx, caret: array of integer;
|
||||
cclass, glyph: array of word;
|
||||
|
||||
s: WideString;
|
||||
j, k: Integer;
|
||||
l: SizeUInt;
|
||||
@ -106,20 +104,19 @@ begin
|
||||
if TextDrawer= nil then exit;;
|
||||
|
||||
SetLength(s, LineLen+1); // wide chars of UTF-16 <= bytes of UTF-8 string
|
||||
if ConvertUTF8ToUTF16(PWideChar(S), LineLen+1, Line, LineLen, [toInvalidCharToSymbol], l) <> trNoError then
|
||||
if ConvertUTF8ToUTF16(PWideChar(s), LineLen+1, Line, LineLen, [toInvalidCharToSymbol], l) <> trNoError then
|
||||
exit;
|
||||
SetLength(s, l - 1);
|
||||
|
||||
cpRes.lStructSize := sizeof(cpRes);
|
||||
SetLength(outs, Length(s)+1); cpRes.lpOutString := @outs[0];
|
||||
SetLength(order, Length(s)+1); cpRes.lpOrder := @order[0];
|
||||
SetLength(order, Length(s)+1); cpRes.lpOrder := PCardinal(@order[0]);
|
||||
SetLength(dx, Length(s)+1); cpRes.lpDx := @dx[0];
|
||||
SetLength(caret, Length(s)+1); cpRes.lpCaretPos := @caret[0];
|
||||
SetLength(cclass, Length(s)+1); cpRes.lpClass := @cclass[0];
|
||||
SetLength(glyph, Length(s)+1); cpRes.lpGlyphs := @glyph[0];
|
||||
SetLength(cclass, Length(s)+1); cpRes.lpClass := PChar(@cclass[0]);
|
||||
SetLength(glyph, Length(s)+1); cpRes.lpGlyphs := Pwidechar(@glyph[0]);
|
||||
cpRes.nGlyphs := length(s);
|
||||
|
||||
//exit;
|
||||
{$IFDEF WithSynExperimentalCharWidth}
|
||||
// Need to find fallback font(s), and measure with them too.
|
||||
TextDrawer.BeginDrawing(FHandleOwner.Handle);
|
||||
@ -127,18 +124,16 @@ if TextDrawer= nil then exit;;
|
||||
if (i and GCP_ERROR) <> 0 then i := 0; //exit;
|
||||
i := i and FLI_MASK or GCP_GLYPHSHAPE;
|
||||
|
||||
i := GetCharacterPlacementW(
|
||||
textdrawer.StockDC, //FHandleOwner.Handle,
|
||||
pwidechar(s), length(s), 0, @cpRes, i); //GCP_DIACRITIC + GCP_KASHIDA + GCP_LIGATE);
|
||||
i := GetCharacterPlacementW(textdrawer.StockDC, //FHandleOwner.Handle,
|
||||
pwidechar(s), length(s), 0, @cpRes, i); //GCP_DIACRITIC + GCP_KASHIDA + GCP_LIGATE);
|
||||
TextDrawer.EndDrawing;
|
||||
{$endif}
|
||||
if i = 0 then begin
|
||||
debugln(LOG_SynSystemWidthChars, ['TSynEditStringSystemWidthChars FAILED for line ', Index]);
|
||||
exit;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
k := 0; // index for order
|
||||
|
||||
for j := 0 to LineLen-1 do begin
|
||||
if Line^ in [#$00..#$7F, #$C0..#$FF] then begin
|
||||
if PWidths^ <> 0 then begin
|
||||
@ -151,7 +146,6 @@ if TextDrawer= nil then exit;;
|
||||
end;
|
||||
inc(k);
|
||||
end;
|
||||
|
||||
inc(PWidths);
|
||||
inc(Line);
|
||||
end;
|
||||
|
||||
@ -169,15 +169,15 @@ begin
|
||||
tnidw.hIcon := ATrayIcon.Icon.Handle;
|
||||
|
||||
WideBuffer := UTF8ToUTF16(ATrayIcon.Hint);
|
||||
WideStrLCopy(@tnidw.szTip, PWideChar(WideBuffer), 127);
|
||||
WideStrLCopy(@tnidw.szTip[0], PWideChar(WideBuffer), SizeOf(tnidw.szTip));
|
||||
|
||||
Result := Shell_NotifyIconW(NIM_ADD, @tnidw);
|
||||
Result := Shell_NotifyIconW(NIM_ADD, PNotifyIconDataW(@tnidw));
|
||||
if not Result then
|
||||
begin
|
||||
// Try old version of TNotifyIconDataW
|
||||
tnidw.cbSize := SizeOf(TNotifyIconDataW);
|
||||
WideStrLCopy(@tnidw.szTip, PWideChar(WideBuffer), 63);
|
||||
Result := Shell_NotifyIconW(NIM_MODIFY, @tnidw);
|
||||
WideStrLCopy(@tnidw.szTip[0], PWideChar(WideBuffer), 63);
|
||||
Result := Shell_NotifyIconW(NIM_MODIFY, PNotifyIconDataW(@tnidw));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -222,11 +222,11 @@ end;
|
||||
*******************************************************************}
|
||||
class function TWin32WSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
|
||||
var
|
||||
Window: Windows.TWndClassEx;
|
||||
Window: Windows.TWNDClassEx; // lp: LPWNDCLASS;
|
||||
begin
|
||||
if not GetClassInfo(hInstance, szClassName, @Window) then
|
||||
if not GetClassInfoEx(hInstance, szClassName, @Window) then
|
||||
begin
|
||||
ZeroMemory(@Window, SizeOf(TWndClassEx));
|
||||
Window := Default(Windows.TWNDClassEx);
|
||||
Window.cbSize := SizeOf(TWndClassEx);
|
||||
Window.style := CS_OWNDC;
|
||||
Window.lpfnWndProc := @TrayWndProc;
|
||||
@ -278,14 +278,14 @@ begin
|
||||
tnidw.uFlags := NIF_TIP or NIF_ICON;
|
||||
|
||||
WideBuffer := UTF8ToUTF16(ATrayIcon.Hint);
|
||||
WideStrLCopy(@tnidw.szTip, PWideChar(WideBuffer), 127);
|
||||
WideStrLCopy(@tnidw.szTip[0], PWideChar(WideBuffer), SizeOf(tnidw.szTip));
|
||||
|
||||
if not Shell_NotifyIconW(NIM_MODIFY, @tnidw) then
|
||||
if not Shell_NotifyIconW(NIM_MODIFY, PNotifyIconDataW(@tnidw)) then
|
||||
begin
|
||||
// Try old version of TNotifyIconDataW
|
||||
tnidw.cbSize := SizeOf(TNotifyIconDataW);
|
||||
WideStrLCopy(@tnidw.szTip, PWideChar(WideBuffer), 63);
|
||||
Shell_NotifyIconW(NIM_MODIFY, @tnidw);
|
||||
WideStrLCopy(@tnidw.szTip[0], PWideChar(WideBuffer), 63);
|
||||
Shell_NotifyIconW(NIM_MODIFY, PNotifyIconDataW(@tnidw));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -311,12 +311,12 @@ begin
|
||||
NotifyData.uFlags:=NIF_INFO;
|
||||
NotifyData.u.uTimeout:=ATrayIcon.BalloonTimeout;
|
||||
w:=UTF8ToUTF16(ATrayIcon.BalloonHint);
|
||||
WideStrLCopy(@NotifyData.szInfo, PWideChar(w), High(NotifyData.szInfo));
|
||||
WideStrLCopy(@NotifyData.szInfo[0], PWideChar(w), High(NotifyData.szInfo));
|
||||
w:=UTF8ToUTF16(ATrayIcon.BalloonTitle);
|
||||
WideStrLCopy(@NotifyData.szInfoTitle, PWideChar(w), High(NotifyData.szInfoTitle));
|
||||
WideStrLCopy(@NotifyData.szInfoTitle[0], PWideChar(w), High(NotifyData.szInfoTitle));
|
||||
NotifyData.dwInfoFlags:=FlagsMap[ATrayIcon.BalloonFlags];
|
||||
|
||||
Result:= Shell_NotifyIconW(NIM_MODIFY, @NotifyData);
|
||||
Result:= Shell_NotifyIconW(NIM_MODIFY, PNotifyIconDataW(@NotifyData));
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
|
||||
@ -186,6 +186,7 @@ var
|
||||
AErrorCode: Cardinal;
|
||||
NCCreateParams: TNCCreateParams;
|
||||
WindowClassW, DummyClassW: WndClassW;
|
||||
lp: LPWNDCLASSW;
|
||||
begin
|
||||
NCCreateParams.DefWndProc := nil;
|
||||
NCCreateParams.WinControl := AWinControl;
|
||||
@ -197,10 +198,12 @@ begin
|
||||
begin
|
||||
if SubClass then
|
||||
begin
|
||||
if GetClassInfoW(System.HInstance, PWideChar(WideString(pClassName)), @WindowClassW) then
|
||||
if GetClassInfoW(System.HInstance, PWideChar(WideString(pClassName)),
|
||||
LPWNDCLASSW(@WindowClassW)) then
|
||||
begin
|
||||
NCCreateParams.DefWndProc := WndProc(WindowClassW.lpfnWndProc);
|
||||
if not GetClassInfoW(System.HInstance, PWideChar(WideString(pSubClassName)), @DummyClassW) then
|
||||
if not GetClassInfoW(System.HInstance, PWideChar(WideString(pSubClassName)),
|
||||
LPWNDCLASSW(@DummyClassW)) then
|
||||
begin
|
||||
with WindowClassW do
|
||||
begin
|
||||
@ -208,7 +211,7 @@ begin
|
||||
hInstance := System.HInstance;
|
||||
lpszClassName := PWideChar(WideString(pSubClassName));
|
||||
end;
|
||||
Windows.RegisterClassW(@WindowClassW);
|
||||
Windows.RegisterClassW(LPWNDCLASSW(@WindowClassW));
|
||||
end;
|
||||
pClassName := pSubClassName;
|
||||
end;
|
||||
|
||||
@ -818,9 +818,9 @@ class function TWin32WSOpenDialog.GetFileName(ShellItem: IShellItem): String;
|
||||
var
|
||||
FilePath: LPWStr;
|
||||
begin
|
||||
if Succeeded(ShellItem.GetDisplayName(SIGDN(SIGDN_FILESYSPATH), @FilePath)) then
|
||||
if Succeeded(ShellItem.GetDisplayName(SIGDN(SIGDN_FILESYSPATH), FilePath)) then
|
||||
begin
|
||||
Result := UTF16ToUTF8(WideString(FilePath));
|
||||
Result := UTF16ToUTF8(FilePath);
|
||||
CoTaskMemFree(FilePath);
|
||||
end
|
||||
else
|
||||
@ -1202,6 +1202,7 @@ var
|
||||
CF: TChooseFontA absolute CFW;
|
||||
LF: LogFontA absolute LFW;
|
||||
UserResult: WINBOOL;
|
||||
TempName: String;
|
||||
begin
|
||||
with TFontDialog(ACommonDialog) do
|
||||
begin
|
||||
@ -1252,7 +1253,7 @@ begin
|
||||
debugln(['TWin32WSFontDialog.CreateHandle calling DoShow']);
|
||||
{$endif}
|
||||
TFontDialog(ACommonDialog).DoShow;
|
||||
UserResult := ChooseFontW(@CFW);
|
||||
UserResult := ChooseFontW(LPCHOOSEFONT(@CFW)); // ChooseFontW signature may be wrong.
|
||||
// we need to update LF now
|
||||
LF.lfFaceName := UTF16ToUTF8(LFW.lfFaceName);
|
||||
end;
|
||||
@ -1265,14 +1266,12 @@ begin
|
||||
if not Win32WidgetSet.MetricsFailed and IsFontNameDefault(Name) then
|
||||
begin
|
||||
if Sysutils.strlcomp(
|
||||
@Win32WidgetSet.Metrics.lfMessageFont.lfFaceName,
|
||||
@LF.lfFaceName,
|
||||
@Win32WidgetSet.Metrics.lfMessageFont.lfFaceName[0],
|
||||
@LF.lfFaceName[0],
|
||||
Length(LF.lfFaceName)) = 0 then
|
||||
begin
|
||||
Sysutils.StrLCopy(
|
||||
@LF.lfFaceName,
|
||||
PAnsiChar(Name), // Dialog.Font.Name
|
||||
Length(LF.lfFaceName));
|
||||
TempName := Name; // Dialog.Font.Name is a property and has getter method.
|
||||
Sysutils.StrLCopy(@LF.lfFaceName[0], PChar(TempName), Length(LF.lfFaceName));
|
||||
end;
|
||||
if LF.lfHeight = Win32WidgetSet.Metrics.lfMessageFont.lfHeight then
|
||||
LF.lfHeight := 0;
|
||||
|
||||
@ -214,7 +214,7 @@ end;
|
||||
function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer;
|
||||
var
|
||||
MenuItemIndex: integer;
|
||||
ItemInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
ItemInfo: MENUITEMINFOW; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
FirstMenuItem: TMenuItem;
|
||||
SiblingMenuItem: TMenuItem;
|
||||
i: integer;
|
||||
@ -222,7 +222,7 @@ var
|
||||
begin
|
||||
Result := MakeLResult(0, MNC_IGNORE);
|
||||
MenuItemIndex := -1;
|
||||
ItemInfo.cbSize := sizeof(TMenuItemInfo);
|
||||
ItemInfo.cbSize := sizeof(TMenuItemInfoW);
|
||||
ItemInfo.fMask := MIIM_DATA;
|
||||
if not GetMenuItemInfoW(AMenuHandle, 0, true, @ItemInfo) then Exit;
|
||||
|
||||
@ -1382,10 +1382,10 @@ end;
|
||||
|
||||
function ChangeMenuFlag(const AMenuItem: TMenuItem; Flag: Cardinal; Value: boolean): boolean;
|
||||
var
|
||||
MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
MenuInfo: MENUITEMINFOW; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
begin
|
||||
MenuInfo := Default(MENUITEMINFO);
|
||||
MenuInfo.cbSize := sizeof(TMenuItemInfo);
|
||||
MenuInfo := Default(MENUITEMINFOW);
|
||||
MenuInfo.cbSize := sizeof(TMenuItemInfoW);
|
||||
MenuInfo.fMask := MIIM_FTYPE; // don't retrieve caption (MIIM_STRING not included)
|
||||
GetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo);
|
||||
if Value then
|
||||
@ -1405,10 +1405,10 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure SetMenuFlag(const Menu: HMenu; Flag: Cardinal; Value: boolean);
|
||||
var
|
||||
MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
MenuInfo: MENUITEMINFOW; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
begin
|
||||
MenuInfo := Default(MENUITEMINFO);
|
||||
MenuInfo.cbSize := sizeof(TMenuItemInfo);
|
||||
MenuInfo := Default(MENUITEMINFOW);
|
||||
MenuInfo.cbSize := sizeof(TMenuItemInfoW);
|
||||
MenuInfo.fMask := MIIM_TYPE; //MIIM_FTYPE not work here please use only MIIM_TYPE, caption not retrieved (dwTypeData = nil)
|
||||
GetMenuItemInfoW(Menu, 0, True, @MenuInfo);
|
||||
if Value then
|
||||
@ -1422,16 +1422,16 @@ end;
|
||||
|
||||
procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String);
|
||||
var
|
||||
MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
MenuInfo: MENUITEMINFOW; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
WideBuffer: widestring;
|
||||
begin
|
||||
if (AMenuItem.MergedParent = nil) or not AMenuItem.MergedParent.HandleAllocated then
|
||||
Exit;
|
||||
|
||||
MenuInfo := Default(MENUITEMINFO);
|
||||
MenuInfo := Default(MENUITEMINFOW);
|
||||
with MenuInfo do
|
||||
begin
|
||||
cbSize := sizeof(TMenuItemInfo);
|
||||
cbSize := sizeof(TMenuItemInfoW);
|
||||
fMask := MIIM_FTYPE or MIIM_STATE; // don't retrieve current caption
|
||||
end;
|
||||
GetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo);
|
||||
@ -1445,11 +1445,10 @@ begin
|
||||
fState := EnabledToStateFlag[AMenuItem.Enabled];
|
||||
if AMenuItem.Checked then
|
||||
fState := fState or MFS_CHECKED;
|
||||
// AMenuItem.Caption := ACaption; // Already set
|
||||
WideBuffer := UTF8ToUTF16(CompleteMenuItemStringCaption(AMenuItem, ACaption, #9));
|
||||
dwTypeData := PChar(WideBuffer); // PWideChar forced to PChar
|
||||
cch := length(WideBuffer);
|
||||
|
||||
//AMenuItem.Caption := ACaption; // Already set
|
||||
WideBuffer := UTF8ToUTF16(CompleteMenuItemStringCaption(AMenuItem, ACaption, #9));
|
||||
dwTypeData := PWideChar(WideBuffer);
|
||||
cch := length(WideBuffer);
|
||||
fMask := fMask or MIIM_STRING; // caption updated too
|
||||
end
|
||||
else
|
||||
@ -1481,7 +1480,7 @@ end;
|
||||
|
||||
class procedure TWin32WSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
|
||||
var
|
||||
MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
MenuInfo: MENUITEMINFOW; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
ParentMenuHandle: HMenu;
|
||||
ParentOfParent: HMenu;
|
||||
CallMenuRes: Boolean;
|
||||
@ -1491,8 +1490,8 @@ begin
|
||||
if AMenuItem.MergedParent=nil then
|
||||
Exit;
|
||||
ParentMenuHandle := AMenuItem.MergedParent.Handle;
|
||||
MenuInfo := Default(MENUITEMINFO);
|
||||
MenuInfo.cbSize := sizeof(TMenuItemInfo);
|
||||
MenuInfo := Default(MENUITEMINFOW);
|
||||
MenuInfo.cbSize := sizeof(TMenuItemInfoW);
|
||||
|
||||
// Following part fixes the case when an item is added in runtime
|
||||
// but the parent item has not defined the submenu flag (hSubmenu=0)
|
||||
@ -1552,7 +1551,7 @@ begin
|
||||
fState := fState or MFS_DISABLED;
|
||||
end;
|
||||
WideBuffer := UTF8ToUTF16(CompleteMenuItemCaption(AMenuItem, #9));
|
||||
dwTypeData := PChar(WideBuffer); // PWideChar forced to PChar
|
||||
dwTypeData := PWideChar(WideBuffer);
|
||||
cch := length(WideBuffer);
|
||||
|
||||
if AMenuItem.RadioItem then
|
||||
@ -1584,7 +1583,7 @@ end;
|
||||
class procedure TWin32WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
|
||||
var
|
||||
ParentOfParentHandle, ParentHandle: HMENU;
|
||||
MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
MenuInfo: MENUITEMINFOW; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
|
||||
CallMenuRes: Boolean;
|
||||
begin
|
||||
if Assigned(AMenuItem.MergedParent) then
|
||||
@ -1596,10 +1595,10 @@ begin
|
||||
AMenuItem.MergedParent.MergedParent.HandleAllocated then
|
||||
begin
|
||||
ParentOfParentHandle := AMenuItem.MergedParent.MergedParent.Handle;
|
||||
MenuInfo := Default(MENUITEMINFO);
|
||||
MenuInfo := Default(MENUITEMINFOW);
|
||||
with MenuInfo do
|
||||
begin
|
||||
cbSize := sizeof(TMenuItemInfo);
|
||||
cbSize := sizeof(TMenuItemInfoW);
|
||||
fMask := MIIM_SUBMENU;
|
||||
end;
|
||||
GetMenuItemInfoW(ParentOfParentHandle, AMenuItem.MergedParent.Command, False, @MenuInfo);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user