paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 00:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* in the win16 video unit, don't ever try to update the window, after it has

Browse Source 
received a WM_DESTROY message

git-svn-id: trunk@37712 -
This commit is contained in:
nickysn 2017-12-11 16:54:32 +00:00
parent 0f8c31a374
commit 4cdfe1b025
1 changed files with 32 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -102,7 +102,10 @@ begin
WM_PAINT:
WindowPaint(hwnd);
WM_DESTROY:
PostQuitMessage(0);
begin
VideoWindow:=0;
PostQuitMessage(0);
end;
else
MainWndProc:=DefWindowProc(hwnd,msg,wParam,lParam);
end;
@ -193,34 +196,37 @@ var
ch: TVideoCell;
CharWidth,CharHeight: SmallInt;
begin
dc:=GetDC(VideoWindow);
if dc=0 then
if VideoWindow<>0 then
begin
MessageBox(0,'GetDC() failed',nil,MB_OK or MB_ICONHAND or MB_TASKMODAL);
exit;
end;
oldfont:=SelectObject(dc,GetStockObject(OEM_FIXED_FONT));
GetTextMetrics(dc,FarAddr(Metrics));
CharWidth:=Metrics.tmMaxCharWidth;
CharHeight:=Metrics.tmHeight+Metrics.tmExternalLeading;
oldtextcolor:=GetTextColor(dc);
oldbkcolor:=GetBkColor(dc);
for y:=0 to ScreenHeight-1 do
for x:=0 to ScreenWidth-1 do
dc:=GetDC(VideoWindow);
if dc=0 then
begin
ch:=videobuf^[y*ScreenWidth+x];
if force or (ch<>oldvideobuf^[y*ScreenWidth+x]) then
begin
oldvideobuf^[y*ScreenWidth+x]:=videobuf^[y*ScreenWidth+x];
SetTextColor(dc,ColorRefs[(ch shr 8) and 15]);
SetBkColor(dc,ColorRefs[(ch shr 12) and 15]);
TextOut(dc,x*CharWidth,y*CharHeight,FarAddr(ch),1);
end;
MessageBox(0,'GetDC() failed',nil,MB_OK or MB_ICONHAND or MB_TASKMODAL);
exit;
end;
SetTextColor(dc,oldtextcolor);
SetBkColor(dc,oldbkcolor);
SelectObject(dc,oldfont);
ReleaseDC(VideoWindow,dc);
oldfont:=SelectObject(dc,GetStockObject(OEM_FIXED_FONT));
GetTextMetrics(dc,FarAddr(Metrics));
CharWidth:=Metrics.tmMaxCharWidth;
CharHeight:=Metrics.tmHeight+Metrics.tmExternalLeading;
oldtextcolor:=GetTextColor(dc);
oldbkcolor:=GetBkColor(dc);
for y:=0 to ScreenHeight-1 do
for x:=0 to ScreenWidth-1 do
begin
ch:=videobuf^[y*ScreenWidth+x];
if force or (ch<>oldvideobuf^[y*ScreenWidth+x]) then
begin
oldvideobuf^[y*ScreenWidth+x]:=videobuf^[y*ScreenWidth+x];
SetTextColor(dc,ColorRefs[(ch shr 8) and 15]);
SetBkColor(dc,ColorRefs[(ch shr 12) and 15]);
TextOut(dc,x*CharWidth,y*CharHeight,FarAddr(ch),1);
end;
end;
SetTextColor(dc,oldtextcolor);
SetBkColor(dc,oldbkcolor);
SelectObject(dc,oldfont);
ReleaseDC(VideoWindow,dc);
end;
ProcessMessages;
end;