paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-08 22:10:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed snapshot building of win16-i8086 in the medium memory model, via the use of FarAddr()

Browse Source 
git-svn-id: trunk@37630 -
This commit is contained in:
nickysn 2017-11-28 00:03:19 +00:00
parent b571f48735
commit 07c18c8689
2 changed files with 18 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
packages/rtl-console/src/win16/keyboard.pp
View File

@ -80,8 +80,8 @@ begin
VK_MENU: VK_MENU:
KbdShiftState:=KbdShiftState or %1000; KbdShiftState:=KbdShiftState or %1000;
end; end;
GetKeyboardState(@KbdState); GetKeyboardState(FarAddr(KbdState));
charcount:=ToAscii(wParam,Byte(lParam shr 16),@KbdState,@charbuf,0); charcount:=ToAscii(wParam,Byte(lParam shr 16),FarAddr(KbdState),FarAddr(charbuf),0);
if charcount>0 then if charcount>0 then
for i:=0 to charcount-1 do for i:=0 to charcount-1 do
KbdBufEnqueue((kbPhys shl 24) or charbuf[i] or (KbdShiftState shl 16)); KbdBufEnqueue((kbPhys shl 24) or charbuf[i] or (KbdShiftState shl 16));
@ -118,10 +118,10 @@ function SysGetKeyEvent: TKeyEvent;
var var
m: MSG; m: MSG;
begin begin
while KbdBufEmpty and GetMessage(@m,0,0,0) do while KbdBufEmpty and GetMessage(FarAddr(m),0,0,0) do
begin begin
TranslateMessage(@m); TranslateMessage(FarAddr(m));
DispatchMessage(@m); DispatchMessage(FarAddr(m));
end; end;
if KbdBufEmpty then if KbdBufEmpty then
SysGetKeyEvent:=0 SysGetKeyEvent:=0
@ -134,10 +134,10 @@ function SysPollKeyEvent: TKeyEvent;
var var
m: MSG; m: MSG;
begin begin
while PeekMessage(@m,0,0,0,1) do while PeekMessage(FarAddr(m),0,0,0,1) do
begin begin
TranslateMessage(@m); TranslateMessage(FarAddr(m));
DispatchMessage(@m); DispatchMessage(FarAddr(m));
end; end;
if KbdBufEmpty then if KbdBufEmpty then
SysPollKeyEvent:=0 SysPollKeyEvent:=0

20
packages/rtl-console/src/win16/video.pp
View File

@ -51,9 +51,9 @@ var
ch: TVideoCell; ch: TVideoCell;
CharWidth,CharHeight: SmallInt; CharWidth,CharHeight: SmallInt;
begin begin
dc:=BeginPaint(hwnd,@ps); dc:=BeginPaint(hwnd,FarAddr(ps));
oldfont:=SelectObject(dc,GetStockObject(OEM_FIXED_FONT)); oldfont:=SelectObject(dc,GetStockObject(OEM_FIXED_FONT));
GetTextMetrics(dc,@Metrics); GetTextMetrics(dc,FarAddr(Metrics));
CharWidth:=Metrics.tmMaxCharWidth; CharWidth:=Metrics.tmMaxCharWidth;
CharHeight:=Metrics.tmHeight+Metrics.tmExternalLeading; CharHeight:=Metrics.tmHeight+Metrics.tmExternalLeading;
x1:=ps.rcPaint.left div CharWidth; x1:=ps.rcPaint.left div CharWidth;
@ -76,12 +76,12 @@ begin
ch:=videobuf^[y*ScreenWidth+x]; ch:=videobuf^[y*ScreenWidth+x];
SetTextColor(dc,ColorRefs[(ch shr 8) and 15]); SetTextColor(dc,ColorRefs[(ch shr 8) and 15]);
SetBkColor(dc,ColorRefs[(ch shr 12) and 15]); SetBkColor(dc,ColorRefs[(ch shr 12) and 15]);
TextOut(dc,x*CharWidth,y*CharHeight,@ch,1); TextOut(dc,x*CharWidth,y*CharHeight,FarAddr(ch),1);
end; end;
SetTextColor(dc,oldtextcolor); SetTextColor(dc,oldtextcolor);
SetBkColor(dc,oldbkcolor); SetBkColor(dc,oldbkcolor);
SelectObject(dc,oldfont); SelectObject(dc,oldfont);
EndPaint(hwnd,@ps); EndPaint(hwnd,FarAddr(ps));
end; end;
function MainWndProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; export; function MainWndProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; export;
@ -115,7 +115,7 @@ begin
wc.hbrBackground:=GetStockObject(BLACK_BRUSH); wc.hbrBackground:=GetStockObject(BLACK_BRUSH);
wc.lpszMenuName:=nil; wc.lpszMenuName:=nil;
wc.lpszClassName:='FPCConsoleWndClass'; wc.lpszClassName:='FPCConsoleWndClass';
if not RegisterClass(wc) then if not RegisterClass(FarAddr(wc)) then
begin begin
MessageBox(0,'Error registering window class',nil,MB_OK or MB_ICONHAND or MB_TASKMODAL); MessageBox(0,'Error registering window class',nil,MB_OK or MB_ICONHAND or MB_TASKMODAL);
Halt(1); Halt(1);
@ -149,10 +149,10 @@ procedure ProcessMessages;
var var
m: MSG; m: MSG;
begin begin
while PeekMessage(@m,0,0,0,1) do while PeekMessage(FarAddr(m),0,0,0,1) do
begin begin
TranslateMessage(@m); TranslateMessage(FarAddr(m));
DispatchMessage(@m); DispatchMessage(FarAddr(m));
end; end;
end; end;
@ -182,7 +182,7 @@ var
begin begin
dc:=GetDC(VideoWindow); dc:=GetDC(VideoWindow);
oldfont:=SelectObject(dc,GetStockObject(OEM_FIXED_FONT)); oldfont:=SelectObject(dc,GetStockObject(OEM_FIXED_FONT));
GetTextMetrics(dc,@Metrics); GetTextMetrics(dc,FarAddr(Metrics));
CharWidth:=Metrics.tmMaxCharWidth; CharWidth:=Metrics.tmMaxCharWidth;
CharHeight:=Metrics.tmHeight+Metrics.tmExternalLeading; CharHeight:=Metrics.tmHeight+Metrics.tmExternalLeading;
oldtextcolor:=GetTextColor(dc); oldtextcolor:=GetTextColor(dc);
@ -196,7 +196,7 @@ begin
oldvideobuf^[y*ScreenWidth+x]:=videobuf^[y*ScreenWidth+x]; oldvideobuf^[y*ScreenWidth+x]:=videobuf^[y*ScreenWidth+x];
SetTextColor(dc,ColorRefs[(ch shr 8) and 15]); SetTextColor(dc,ColorRefs[(ch shr 8) and 15]);
SetBkColor(dc,ColorRefs[(ch shr 12) and 15]); SetBkColor(dc,ColorRefs[(ch shr 12) and 15]);
TextOut(dc,x*CharWidth,y*CharHeight,@ch,1); TextOut(dc,x*CharWidth,y*CharHeight,FarAddr(ch),1);
end; end;
end; end;
SetTextColor(dc,oldtextcolor); SetTextColor(dc,oldtextcolor);