paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-03 07:38:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32 interface: 64 bit fixes from Florian

Browse Source 
git-svn-id: trunk@9920 -
This commit is contained in:
vincents 2006-09-17 20:47:15 +00:00
parent 0e8e873507
commit 436f4fbaef
4 changed files with 94 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -265,12 +265,12 @@ Var
if PopupMenu<>nil then //processing popup menu
begin
WindowInfo^.PopupMenu := nil;
Result := PopupMenu.FindItem(Lo(WParam), fkCommand);
Result := PopupMenu.FindItem(LOWORD(WParam), fkCommand);
end;
if Result=nil then //if Result is still nil, process main menu
begin
MainMenuHandle := GetMenu(Window);
if GetMenuItemInfo(MainMenuHandle, Lo(WParam), false, @MenuInfo) then
if GetMenuItemInfo(MainMenuHandle, LOWORD(WParam), false, @MenuInfo) then
Result := TObject(MenuInfo.dwItemData);
end;
end;
@ -580,18 +580,18 @@ Var
with LMScroll do
begin
Msg := LMsg;
ScrollCode := SmallInt(Lo(WParam));
ScrollCode := LOWORD(WParam);
SmallPos := 0;
ScrollBar := ScrollbarHandle;
Pos := 0;
end;
if not (Lo(WParam) in [SB_THUMBTRACK, SB_THUMBPOSITION])
if not (LOWORD(WParam) in [SB_THUMBTRACK, SB_THUMBPOSITION])
then begin
WindowInfo^.TrackValid := False;
Exit;
end;
// Note on thumb tracking
// When using the scrollwheel, windows sends SB_THUMBTRACK
// messages, but only when scroll.max < 32K. So in that case
@ -615,17 +615,17 @@ Var
ScrollInfo.cbSize := SizeOf(ScrollInfo);
if Lo(WParam) = SB_THUMBTRACK
if LOWORD(WParam) = SB_THUMBTRACK
then begin
ScrollInfo.fMask := SIF_TRACKPOS;
// older windows versions may not support trackpos, so fill it with some default
if WindowInfo^.TrackValid
then ScrollInfo.nTrackPos := (WindowInfo^.TrackPos and $FFFF0000) or Hi(WParam)
else ScrollInfo.nTrackPos := Hi(WParam);
then ScrollInfo.nTrackPos := (WindowInfo^.TrackPos and $FFFF0000) or HIWORD(WParam)
else ScrollInfo.nTrackPos := HIWORD(WParam);
end
else begin
ScrollInfo.fMask := SIF_POS;
ScrollInfo.nPos := Hi(WParam);
ScrollInfo.nPos := HIWORD(WParam);
end;
if ScrollbarHandle <> 0
@ -640,7 +640,7 @@ Var
else GetScrollInfo(Window, SB_VERT, ScrollInfo);
end;
if Lo(WParam) = SB_THUMBTRACK
if LOWORD(WParam) = SB_THUMBTRACK
then begin
LMScroll.Pos := ScrollInfo.nTrackPos;
WindowInfo^.TrackPos := ScrollInfo.nTrackPos;
@ -648,8 +648,8 @@ Var
end
else begin
if WindowInfo^.TrackValid
then LMScroll.Pos := (WindowInfo^.TrackPos and $FFFF0000) or Hi(WParam)
else LMScroll.Pos := (ScrollInfo.nPos and $FFFF0000) or Hi(WParam);
then LMScroll.Pos := (WindowInfo^.TrackPos and $FFFF0000) or HIWORD(WParam)
else LMScroll.Pos := (ScrollInfo.nPos and $FFFF0000) or HIWORD(WParam);
end;
if LMScroll.Pos < High(LMScroll.SmallPos)
@ -663,7 +663,7 @@ Var
BoundsOffset: TRect;
begin
if (lWinControl <> nil) and not (csDesigning in lWinControl.ComponentState)
and (Lo(LParam) = HTCLIENT) then
and (LOWORD(LParam) = HTCLIENT) then
begin
Windows.GetCursorPos(Windows.POINT(P));
Windows.ScreenToClient(Window, Windows.POINT(P));
@ -921,12 +921,12 @@ begin
Assert(False, 'Trace:WindowProc - Getting Callback Object');
Assert(False, 'Trace:WindowProc - Checking Proc');
Assert(False, Format('Trace:WindowProc - Window Value: $%S-%d; Msg Value: %S; WParam: $%S; LParam: $%S', [IntToHex(Window, 4), Window, WM_To_String(Msg), IntToHex(WParam, 4), IntToHex(LParam, 4)]));
Assert(False, Format('Trace:WindowProc - Window Value: $%S-%d; Msg Value: %S; WParam: $%S; LParam: $%S', [IntToHex(Window, 4), Window, WM_To_String(Msg), IntToHex(WParam, sizeof(WParam)*4), IntToHex(LParam, sizeof(LParam)*4)]));
Case Msg Of
WM_ACTIVATE:
Begin
Case Lo(WParam) Of
Case LOWORD(WParam) Of
WA_ACTIVE, WA_CLICKACTIVE:
Begin
LMessage.Msg := LM_ACTIVATE
@ -993,7 +993,7 @@ begin
End;
WM_MENUCHAR:
Begin
PLMsg^.Result := FindMenuItemAccelerator(chr(lo(WParam)), LParam);
PLMsg^.Result := FindMenuItemAccelerator(chr(LOWORD(WParam)), LParam);
WinProcess := false;
End;
WM_CLOSE:
@ -1016,7 +1016,7 @@ begin
TargetObject := GetMenuItemObject;
if TargetObject is TMenuItem then
begin
if (Hi(WParam) = 0) or (Hi(WParam) = 1) then
if (HIWORD(WParam) = 0) or (HIWORD(WParam) = 1) then
begin
LMessage.Msg := LM_ACTIVATE;
TargetObject.Dispatch(LMessage);
@ -1029,29 +1029,29 @@ begin
if lWinControl = nil then
lWinControl := GetWindowInfo(LParam)^.AWinControl;
if lWinControl is TCustomButton then
case Hi(WParam) of
case HIWORD(WParam) of
BN_CLICKED: LMessage.Msg := LM_CLICKED;
BN_KILLFOCUS: LMessage.Msg := LM_EXIT;
end
else if (lWinControl is TCustomEdit) then
case Hi(WParam) of
case HIWORD(WParam) of
EN_CHANGE: LMessage.Msg := CM_TEXTCHANGED;
end
else if (lWinControl is TCustomFloatSpinEdit) then
case Hi(WParam) of
case HIWORD(WParam) of
EN_CHANGE: HandleSpinEditChange(TCustomFloatSpinEdit(lWinControl));
end
else if (lWinControl is TCustomMemo) then
case Hi(WParam) of
case HIWORD(WParam) of
// multiline edit doesn't send EN_CHANGE, so use EN_UPDATE
EN_UPDATE: LMessage.Msg := CM_TEXTCHANGED;
end
else if (lWinControl is TCustomListBox) then
case Hi(WParam) of
case HIWORD(WParam) of
LBN_SELCHANGE: LMessage.Msg := LM_SELCHANGE;
end
else if lWinControl is TCustomCombobox then
case Hi(WParam) of
case HIWORD(WParam) of
CBN_EDITCHANGE: LMessage.Msg := LM_CHANGED;
{ CBN_EDITCHANGE is only sent after the user changes the edit box.
CBN_SELCHANGE is sent when the user changes the text by
@ -1117,10 +1117,12 @@ begin
Windows.SetTextColor(HDC(WParam), Windows.COLORREF(ColorToRGB(ChildWinControl.Font.Color)));
Windows.SetBkColor(HDC(WParam), Windows.COLORREF(ColorToRGB(ChildWinControl.Brush.Color)));
LMessage.Result := LResult(ChildWinControl.Brush.Handle);
DebugLn(['WindowProc ', ChildWinControl.Name, ' Brush: ', LMessage.Result]);
// Override default handling
WinProcess := false;
end;
end;
if (Msg = WM_CTLCOLORSCROLLBAR) then WinProcess := true;
end;
WM_CLEAR:
begin
@ -1344,8 +1346,8 @@ begin
With LMMouse Do
Begin
Msg := LM_LBUTTONDBLCLK;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
@ -1374,8 +1376,8 @@ begin
With LMMouse Do
Begin
Msg := LM_LBUTTONDOWN;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
@ -1396,8 +1398,8 @@ begin
With LMMouse Do
Begin
Msg := LM_LBUTTONUP;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
End;
@ -1408,8 +1410,8 @@ begin
With LMMouse Do
Begin
Msg := LM_MBUTTONDBLCLK;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
End;
@ -1420,8 +1422,8 @@ begin
With LMMouse Do
Begin
Msg := LM_MBUTTONDOWN;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
End;
@ -1432,8 +1434,8 @@ begin
With LMMouse Do
Begin
Msg := LM_MBUTTONUP;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
End;
@ -1454,8 +1456,8 @@ begin
With LMMouseMove Do
Begin
Msg := LM_MOUSEMOVE;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
// check if this is a spurious WM_MOUSEMOVE message, pos not actually changed
if (XPos = WindowInfo^.MouseX) and (YPos = WindowInfo^.MouseY) then
@ -1478,8 +1480,8 @@ begin
PLMsg:=@LMMouseEvent;
With LMMouseEvent Do
Begin
X := SmallInt(Lo(LParam));
Y := SmallInt(Hi(LParam));
X := GET_X_LPARAM(LParam);
Y := GET_Y_LPARAM(LParam);
// check if mouse cursor within this window, otherwise send message to window the mouse is hovering over
P.X := X;
P.Y := Y;
@ -1503,8 +1505,8 @@ begin
if lWinControl.FCompStyle <> csComboBox then
begin
Msg := LM_MOUSEWHEEL;
Button := Lo(WParam);
WheelDelta := SmallInt(Hi(WParam));
Button := LOWORD(WParam);
WheelDelta := SmallInt(HIWORD(WParam));
State := GetShiftState;
UserData := Pointer(GetWindowLong(Window, GWL_USERDATA));
WinProcess := false;
@ -1581,7 +1583,7 @@ begin
idFrom := ShowHideTabPage(HWndFrom, true);
NM_CUSTOMDRAW:
begin
if WindowInfo^.WinControl is TCustomListView
if WindowInfo^.WinControl is TCustomListView
then HandleListViewCustomDraw(TCustomListViewAccess(WindowInfo^.WinControl));
end;
end;
@ -1604,8 +1606,8 @@ begin
With LMMouse Do
Begin
Msg := LM_RBUTTONDBLCLK;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
End;
@ -1616,8 +1618,8 @@ begin
With LMMouse Do
Begin
Msg := LM_RBUTTONDOWN;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
End;
End;
@ -1629,8 +1631,8 @@ begin
With LMMouse Do
Begin
Msg := LM_RBUTTONUP;
XPos := SmallInt(Lo(LParam));
YPos := SmallInt(Hi(LParam));
XPos := GET_X_LPARAM(LParam);
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
Result := 0;
End;
@ -2086,7 +2088,7 @@ function WindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
begin
DebugLn(MessageStackDepth, 'WindowProc called for window=', IntToHex(Window, 8),' msg=',
WM_To_String(msg),' wparam=', IntToHex(WParam, 8), ' lparam=', IntToHex(lparam, 8));
WM_To_String(msg),' wparam=', IntToHex(WParam, sizeof(WParam)*4), ' lparam=', IntToHex(lparam, sizeof(lparam)*4));
MessageStackDepth := MessageStackDepth + ' ';
Result := RealWindowProc(Window, Msg, WParam, LParam);

2
lcl/interfaces/win32/win32int.pp
View File

@ -96,7 +96,7 @@ const
Type
PInitCommonControlsEx = ^TInitCommonControlsEx;
TInitCommonControlsEx = packed record
TInitCommonControlsEx = record
dwSize: dword;
dwICC: dword;
end;

48
lcl/interfaces/win32/win32wsbuttons.pp
View File

@ -141,23 +141,23 @@ const
BCM_SETTEXTMARGIN = BCM_FIRST + 4;
BCM_GETTEXTMARGIN = BCM_FIRST + 5;
{ - you do need to destroy the imagelist yourself.
{ - you do need to destroy the imagelist yourself.
- you'll need 5 images to support all themed xp button states...
Image 0 = normal
Image 1 = mouse hover
Image 2 = button down
Image 3 = button disabled
Image 4 = button focus
Image 4 = button focus
}
XPBitBtn_ImageIndexToState: array[1..6] of TButtonState =
XPBitBtn_ImageIndexToState: array[1..6] of TButtonState =
(bsUp, bsExclusive, bsDown, bsDisabled, bsUp, bsUp);
BitBtnEnabledToButtonState: array[boolean] of TButtonState =
(bsDisabled, bsUp);
type
BUTTON_IMAGELIST = packed record
BUTTON_IMAGELIST = record
himl: Windows.HIMAGELIST;
margin: Windows.RECT;
uAlign: UINT;
@ -199,7 +199,7 @@ var
MonoDC: HDC;
MonoBmp, OldMonoBmp: HBITMAP;
BkColor: TColorRef;
TextFlags: integer; // flags for caption (enabled or disabled)
numGlyphs, glyphLeft, glyphWidth, glyphHeight: integer;
themesActive, emulateDisabled: boolean;
@ -213,9 +213,9 @@ var
case AState of
bsDisabled:
begin
if numGlyphs > 1 then
glyphLeft := glyphWidth
else
if numGlyphs > 1 then
glyphLeft := glyphWidth
else
emulateDisabled := true;
TextFlags := TextFlags or DSS_DISABLED;
end;
@ -226,17 +226,17 @@ var
// fill with background color
OldBitmapHandle := SelectObject(hdcNewBitmap, NewBitmap);
Windows.FillRect(hdcNewBitmap, BitmapRect, BitBtn.Brush.Handle);
if not emulateDisabled then
if not emulateDisabled then
begin
if MaskBmp <> 0 then
BitBlt(hdcNewBitmap, XDestBitmap, YDestBitmap, glyphWidth,
if MaskBmp <> 0 then
BitBlt(hdcNewBitmap, XDestBitmap, YDestBitmap, glyphWidth,
glyphHeight, MaskDC, glyphLeft, 0, SRCCOPY);
end else begin
// when not themed, windows wants a white background picture for disabled button image
themesActive := TWin32WidgetSet(WidgetSet).ThemesActive;
if not themesActive then
FillRect(hdcNewBitmap, BitmapRect, GetStockObject(WHITE_BRUSH));
if BitmapHandle <> 0 then
if BitmapHandle <> 0 then
begin
// Create a Mono DC
MonoBmp := CreateBitmap(glyphWidth, glyphHeight, 1, 1, nil);
@ -255,20 +255,20 @@ var
end;
// Draw the black and white image
BitBlt(hdcNewBitmap, XDestBitmap, YDestBitmap, glyphWidth, glyphHeight,
MonoDC, 0, 0, SRCCOPY);
MonoDC, 0, 0, SRCCOPY);
SelectObject(MonoDC, OldMonoBmp);
DeleteDC(MonoDC);
DeleteObject(MonoBmp);
end;
end;
end;
SetBkMode(hdcNewBitmap, TRANSPARENT);
SetTextColor(hdcNewBitmap, 0);
DrawState(hdcNewBitmap, 0, nil, LPARAM(ButtonCaption), 0, XDestText, YDestText, 0, 0, TextFlags);
SelectObject(hdcNewBitmap, OldBitmapHandle);
end;
begin
// gather info about bitbtn
BitBtnHandle := BitBtn.Handle;
@ -306,7 +306,7 @@ begin
YDestBitmap := (newHeight - BitmapInfo.bmHeight) div 2;
YDestText := (newHeight - TextSize.cy) div 2;
case BitBtnLayout of
blGlyphLeft:
blGlyphLeft:
begin
XDestBitmap := 0;
XDestText := srcWidth;
@ -315,7 +315,7 @@ begin
else
inc(XDestText, BitBtn.Spacing);
end;
blGlyphRight:
blGlyphRight:
begin
XDestBitmap := newWidth - srcWidth;
XDestText := XDestBitmap - TextSize.cx;
@ -340,7 +340,7 @@ begin
XDestBitmap := (newWidth - srcWidth) shr 1;
XDestText := (newWidth - TextSize.cx) shr 1;
case BitBtnLayout of
blGlyphTop:
blGlyphTop:
begin
YDestBitmap := 0;
YDestText := BitmapInfo.bmHeight;
@ -349,7 +349,7 @@ begin
else
inc(YDestText, BitBtn.Spacing);
end;
blGlyphBottom:
blGlyphBottom:
begin
YDestBitmap := newHeight - BitmapInfo.bmHeight;
YDestText := YDestBitmap - TextSize.cy;
@ -385,7 +385,7 @@ begin
SrcDC := CreateCompatibleDC(hdcNewBitmap);
OldSrcBmp := SelectObject(SrcDC, BitmapHandle);
FillRect(MaskDC, BitmapRect, BitBtn.Brush.Handle);
TWin32WidgetSet(WidgetSet).MaskBlt(MaskDC, 0, 0, BitmapInfo.bmWidth, BitmapInfo.bmHeight, SrcDC,
TWin32WidgetSet(WidgetSet).MaskBlt(MaskDC, 0, 0, BitmapInfo.bmWidth, BitmapInfo.bmHeight, SrcDC,
0, 0, BitBtn.Glyph.MaskHandle, 0, 0);
end else begin
MaskBmp := BitmapHandle;
@ -393,7 +393,7 @@ begin
end;
SelectObject(hdcNewBitmap, OldBitmapHandle);
end;
// destroy previous bitmap, set new bitmap
if TWin32WidgetSet(WidgetSet).ThemesActive then
begin

18
lcl/interfaces/win32/winext.pas
View File

@ -236,6 +236,11 @@ Function Replace(Const Str, OrigStr, ReplStr: String; Const Global: Boolean): St
Str into substrings around SplitStr }
Function Split(Const Str: String; SplitStr: String; Count: Integer; Const CaseSensitive: Boolean): TStringList;
{$ifdef VER2_0}
function GET_X_LPARAM(lp : Windows.LParam) : longint;
function GET_Y_LPARAM(lp : Windows.LParam) : longint;
{$endif VER2_0}
Implementation
Uses SysUtils;
@ -333,6 +338,19 @@ Begin
End;
End;
{$ifdef VER2_0}
function GET_X_LPARAM(lp : Windows.LParam) : longint;
begin
result:=smallint(LOWORD(lp));
end;
function GET_Y_LPARAM(lp : Windows.LParam) : longint;
begin
result:=smallint(HIWORD(lp));
end;
{$endif VER2_0}
Initialization
TmpStr := StrNew('');