Support compiling on Win32 widgetset with -Sy option.

This commit is contained in:
JuhaManninen 2023-05-21 08:39:30 +03:00
parent db2bca3949
commit dd362403a3
6 changed files with 60 additions and 65 deletions

View File

@ -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;

View File

@ -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;

View File

@ -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;
{*******************************************************************

View File

@ -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;

View File

@ -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;

View File

@ -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);