From 707675a501b918c6f285382bd8443c25c56168d2 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 3 Nov 1999 20:23:01 +0000 Subject: [PATCH] + first release of win32 gui support --- rtl/inc/graph/extgraph.pp | 113 ++++++++ rtl/inc/graph/graph.inc | 7 +- rtl/inc/graph/graph.pp | 40 ++- rtl/inc/graph/vesa.inc | 7 +- rtl/inc/graph/win32.inc | 527 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 686 insertions(+), 8 deletions(-) create mode 100644 rtl/inc/graph/extgraph.pp create mode 100644 rtl/inc/graph/win32.inc diff --git a/rtl/inc/graph/extgraph.pp b/rtl/inc/graph/extgraph.pp new file mode 100644 index 0000000000..58e443e9b7 --- /dev/null +++ b/rtl/inc/graph/extgraph.pp @@ -0,0 +1,113 @@ +unit extgraph; + + interface + + function readkey : char; + function keypressed : boolean; + procedure delay(ms : word); + + var + directvideo : boolean; + + implementation + + uses + windows,graph; + + const + keybuffersize = 16; + + var + keyboardhandling : TCriticalSection; + keybuffer : array[1..keybuffersize] of char; + nextfree,nexttoread : longint; + + procedure inccyclic(var i : longint); + + begin + inc(i); + if i>keybuffersize then + i:=1; + end; + + procedure addchar(c : char); + + begin + EnterCriticalSection(keyboardhandling); + keybuffer[nextfree]:=c; + inccyclic(nextfree); + { skip old chars } + if nexttoread=nextfree then + inccyclic(nexttoread); + LeaveCriticalSection(keyboardhandling); + end; + + function readkey : char; + + begin + while true do + begin + EnterCriticalSection(keyboardhandling); + if nexttoread<>nextfree then + begin + readkey:=keybuffer[nexttoread]; + inccyclic(nexttoread); + LeaveCriticalSection(keyboardhandling); + exit; + end; + LeaveCriticalSection(keyboardhandling); + { give other threads a chance } + Windows.Sleep(0); + end; + end; + + function keypressed : boolean; + + begin + EnterCriticalSection(keyboardhandling); + keypressed:=nexttoread<>nextfree; + LeaveCriticalSection(keyboardhandling); + end; + + procedure delay(ms : word); + + begin + Sleep(ms); + end; + + function msghandler(Window: hwnd; AMessage, WParam, + LParam: Longint): Longint; + + begin + case amessage of + WM_CHAR: + begin + addchar(chr(wparam)); + writeln('got char message: ',wparam); + end; + WM_KEYDOWN: + begin + + writeln('got key message'); + end; + end; + msghandler:=0; + end; + + var + oldexitproc : pointer; + + procedure myexitproc; + + begin + exitproc:=oldexitproc; + DeleteCriticalSection(keyboardhandling); + end; +begin + charmessagehandler:=@msghandler; + nextfree:=1; + nexttoread:=1; + InitializeCriticalSection(keyboardhandling); + oldexitproc:=exitproc; + exitproc:=@myexitproc; +end. diff --git a/rtl/inc/graph/graph.inc b/rtl/inc/graph/graph.inc index 6cde8e300a..d1088b659e 100644 --- a/rtl/inc/graph/graph.inc +++ b/rtl/inc/graph/graph.inc @@ -17,7 +17,7 @@ { 1. Allocate a descriptor } { 2. Set segment limit } { 3. Set base linear address } - const +const InternalDriverName = 'DOSGX'; {$ifdef fpc} {$ifdef asmgraph} @@ -2460,7 +2460,10 @@ const CrtAddress: word = 0; { $Log$ -Revision 1.24 1999-10-24 15:51:22 carl +Revision 1.25 1999-11-03 20:23:01 florian + + first release of win32 gui support + +Revision 1.24 1999/10/24 15:51:22 carl * Bugfix of mode m800x600x64k - wrong vide mode would be used. + TP compilable. diff --git a/rtl/inc/graph/graph.pp b/rtl/inc/graph/graph.pp index 58e64f4c99..7c1c0fd659 100644 --- a/rtl/inc/graph/graph.pp +++ b/rtl/inc/graph/graph.pp @@ -199,6 +199,11 @@ Unit Graph; Interface + {$ifdef win32} + uses + windows; + {$endif win32} + const { error codes } grOk = 0; @@ -585,6 +590,12 @@ VAR RestoreVideoState: RestoreStateProc; ExitSave: pointer; +{$ifdef win32} + { this procedure allows to hook keyboard message of the graph unit window } + charmessagehandler : function(Window: hwnd; AMessage, WParam, + LParam: Longint): Longint; +{$endif win32} + Procedure Closegraph; procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word); @@ -672,14 +683,22 @@ Function GetDriverName: string; procedure OutText(const TextString : string); - Implementation + +{ what a mess ... it would be much better if the graph unit } +{ would follow the structure of the FPC system unit: } +{ the main file is system depended and the system independend part } +{ is included (FK) } {$ifdef fpc} {$ifdef go32v2} {$define dpmi} uses go32,ports; Type TDPMIRegisters = go32.registers; {$endif go32v2} + {$ifdef win32} + uses + strings; + {$endif} {$else fpc} {$IFDEF DPMI} uses WinAPI; @@ -2103,13 +2122,20 @@ end; DefaultHooks; end; +{$i modes.inc} +{$i palette.inc} + +{$ifdef win32} +{$i win32.inc} +{$else win32} + {$ifdef DPMI} {$i vesah.inc} {$endif DPMI} -{$i modes.inc} {$i graph.inc} +{$endif win32} function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer; begin @@ -2537,8 +2563,6 @@ end; {--------------------------------------------------------------------------} - {$i palette.inc} - procedure SetColor(Color: Word); Begin @@ -2937,6 +2961,9 @@ begin {$ifdef testsave} savevideostate; {$endif testsave} +{$ifdef win32} + charmessagehandler:=nil; +{$endif win32} end. @@ -2945,7 +2972,10 @@ SetGraphBufSize { $Log$ - Revision 1.33 1999-10-17 10:20:13 jonas + Revision 1.34 1999-11-03 20:23:01 florian + + first release of win32 gui support + + Revision 1.33 1999/10/17 10:20:13 jonas * fixed clipping for thickwidth lines (bug 659) * fixed the faster internalellipsedefault, but it doesn't plot all pixels (there are gaps in the ellipses) diff --git a/rtl/inc/graph/vesa.inc b/rtl/inc/graph/vesa.inc index d9c482a1eb..daefc6e958 100644 --- a/rtl/inc/graph/vesa.inc +++ b/rtl/inc/graph/vesa.inc @@ -1577,7 +1577,9 @@ end; sub ax,004Fh cmp ax,1 sbb al,al +{$ifndef ver0_99_12} mov @RESULT,al +{$endif ver0_99_12} end; end; end; @@ -1936,7 +1938,10 @@ end; { $Log$ -Revision 1.20 1999-10-24 15:50:23 carl +Revision 1.21 1999-11-03 20:23:01 florian + + first release of win32 gui support + +Revision 1.20 1999/10/24 15:50:23 carl * Bugfix in TP mode SaveStateVESA Revision 1.19 1999/10/24 03:37:15 carl diff --git a/rtl/inc/graph/win32.inc b/rtl/inc/graph/win32.inc new file mode 100644 index 0000000000..7df88f1ddb --- /dev/null +++ b/rtl/inc/graph/win32.inc @@ -0,0 +1,527 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999 by Florian Klaempfl + + This file implements the win32 gui support for the graph unit + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +{ + Remarks: + Colors in 16 color mode: + ------------------------ + - the behavior of xor/or/and put isn't 100%: + it is done using the RGB color getting from windows + instead of the palette index! + - palette operations aren't supported + To solve these drawbacks, setpalette must be implemented + by exchanging the colors in the DCs, further GetPaletteEntry + must be used when doing xor/or/and operations +} + +const + InternalDriverName = 'WIN32GUI'; + +var + savedscreen : hbitmap; + graphrunning : boolean; + graphdrawing : tcriticalsection; + bitmapdc : hdc; + oldbitmap : hgdiobj; + mainwindow : HWnd; + pal : ^rgbrec; + SavePtr : pointer; { we don't use that pointer } + MessageThreadHandle : Handle; + MessageThreadID : DWord; + windc : hdc; + +function GetPaletteEntry(r,g,b : word) : word; + + var + dist,i,index,currentdist : longint; + + begin + dist:=$7fffffff; + index:=0; + for i:=0 to maxcolors-1 do + begin + currentdist:=abs(r-pal[i].red)+abs(g-pal[i].green)+ + abs(b-pal[i].blue); + if currentdist(startxviewport+viewwidth)) or + (y(startyviewport+viewheight)) then + exit; + end; + if graphrunning then + begin + EnterCriticalSection(graphdrawing); + c:=RGB(pal[pixel].red,pal[pixel].green,pal[pixel].blue); + SetPixel(bitmapdc,x,y,c); + SetPixel(windc,x,y,c); + LeaveCriticalSection(graphdrawing); + end; + end; + +function GetPixel16Win32GUI(x,y : integer) : word; + + var + c : COLORREF; + + begin + x:=x+startxviewport; + y:=y+startyviewport; + { convert to absolute coordinates and then verify clipping...} + if clippixels then + begin + if (x(startxviewport+viewwidth)) or + (y(startyviewport+viewheight)) then + exit; + end; + if graphrunning then + begin + EnterCriticalSection(graphdrawing); + c:=Windows.GetPixel(bitmapdc,x,y); + GetPixel16Win32GUI:=GetPaletteEntry(GetRValue(c),GetGValue(c),GetBValue(c)); + LeaveCriticalSection(graphdrawing); + end + else + begin + _graphresult:=grerror; + exit; + end; + end; + +procedure DirectPutPixel16Win32GUI(x,y : integer); + + var + col : longint; + c,c2 : COLORREF; + + begin + if graphrunning then + begin + EnterCriticalSection(graphdrawing); + case currentwritemode of + XorPut: + Begin + c2:=Windows.GetPixel(bitmapdc,x,y); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2; + SetPixel(bitmapdc,x,y,c); + SetPixel(windc,x,y,c); + End; + AndPut: + Begin + c2:=Windows.GetPixel(bitmapdc,x,y); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2; + SetPixel(bitmapdc,x,y,c); + SetPixel(windc,x,y,c); + End; + OrPut: + Begin + c2:=Windows.GetPixel(bitmapdc,x,y); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2; + SetPixel(bitmapdc,x,y,c); + SetPixel(windc,x,y,c); + End + else + Begin + If CurrentWriteMode<>NotPut Then + col:=CurrentColor + Else col := Not(CurrentColor); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue); + SetPixel(bitmapdc,x,y,c); + SetPixel(windc,x,y,c); + End + end; + LeaveCriticalSection(graphdrawing); + end; + end; + +procedure HLine16Win32GUI(x,x2,y: integer); + + var + c,c2 : COLORREF; + col,i : longint; + oldpen,pen : HPEN; + + Begin + if graphrunning then + begin + { must we swap the values? } + if x>x2 then + Begin + x:=x xor x2; + x2:=x xor x2; + x:=x xor x2; + end; + { First convert to global coordinates } + X:=X+StartXViewPort; + X2:=X2+StartXViewPort; + Y:=Y+StartYViewPort; + if ClipPixels then + Begin + if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort, + StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then + exit; + end; + Case CurrentWriteMode of + AndPut: + Begin + EnterCriticalSection(graphdrawing); + for i:=x to x2 do + begin + c2:=Windows.GetPixel(bitmapdc,i,y); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2; + SetPixel(bitmapdc,i,y,c); + SetPixel(windc,i,y,c); + end; + LeaveCriticalSection(graphdrawing); + End; + XorPut: + Begin + EnterCriticalSection(graphdrawing); + for i:=x to x2 do + begin + c2:=Windows.GetPixel(bitmapdc,i,y); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2; + SetPixel(bitmapdc,i,y,c); + SetPixel(windc,i,y,c); + end; + LeaveCriticalSection(graphdrawing); + End; + OrPut: + Begin + EnterCriticalSection(graphdrawing); + for i:=x to x2 do + begin + c2:=Windows.GetPixel(bitmapdc,i,y); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2; + SetPixel(bitmapdc,i,y,c); + SetPixel(windc,i,y,c); + end; + LeaveCriticalSection(graphdrawing); + End + Else + Begin + If CurrentWriteMode<>NotPut Then + col:=CurrentColor + Else col:=Not(CurrentColor); + EnterCriticalSection(graphdrawing); + c:=RGB(pal[col].red,pal[col].green,pal[col].blue); + pen:=CreatePen(PS_SOLID,1,c); + oldpen:=SelectObject(bitmapdc,pen); + Windows.MoveToEx(bitmapdc,x,y,nil); + Windows.LineTo(bitmapdc,x2,y); + SelectObject(bitmapdc,oldpen); + + oldpen:=SelectObject(windc,pen); + Windows.MoveToEx(windc,x,y,nil); + Windows.LineTo(windc,x2,y); + SelectObject(windc,oldpen); + + DeleteObject(pen); + LeaveCriticalSection(graphdrawing); + End; + End; + end; + end; + +procedure SetRGBPaletteWin32GUI(colorNum,redValue,greenvalue, + bluevalue : integer); + + begin + if directcolor or (colornum<0) or (colornum>=maxcolor) then + begin + _graphresult:=grerror; + exit; + end; + pal[colorNum].red:=redValue; + pal[colorNum].green:=greenValue; + pal[colorNum].blue:=blueValue; + end; + +procedure GetRGBPaletteWin32GUI(colorNum : integer; + var redValue,greenvalue,bluevalue : integer); + + begin + if directcolor or (colornum<0) or (colornum>=maxcolor) then + begin + _graphresult:=grerror; + exit; + end; + redValue:=pal[colorNum].red; + greenValue:=pal[colorNum].green; + blueValue:=pal[colorNum].blue; + end; + +procedure savestate; + + begin + end; + + +procedure restorestate; + + begin + end; + +function WindowProc(Window: HWnd; AMessage, WParam, + LParam: Longint): Longint; stdcall; export; + + var + dc : hdc; + ps : paintstruct; + r : rect; + +begin + WindowProc := 0; + + case AMessage of + wm_keydown, + wm_keyup, + wm_char: + if assigned(charmessagehandler) then + WindowProc:=charmessagehandler(window,amessage,wparam,lparam); + wm_paint: + begin + EnterCriticalSection(graphdrawing); + graphrunning:=true; + dc:=BeginPaint(Window,@ps); + GetClientRect(Window,@r); + + if graphrunning then + BitBlt(dc,0,0,maxx+1,maxy+1,bitmapdc,0,0,SRCCOPY); + + EndPaint(Window,ps); + LeaveCriticalSection(graphdrawing); + Exit; + end; + wm_create: + begin + EnterCriticalSection(graphdrawing); + dc:=GetDC(window); + bitmapdc:=CreateCompatibleDC(dc); + savedscreen:=CreateCompatibleBitmap(dc,maxx+1,maxy+1); + ReleaseDC(window,dc); + oldbitmap:=SelectObject(bitmapdc,savedscreen); + windc:=GetDC(window); + LeaveCriticalSection(graphdrawing); + end; + wm_Destroy: + begin + EnterCriticalSection(graphdrawing); + graphrunning:=false; + ReleaseDC(mainwindow,windc); + SelectObject(bitmapdc,oldbitmap); + DeleteObject(savedscreen); + DeleteDC(bitmapdc); + LeaveCriticalSection(graphdrawing); + PostQuitMessage(0); + Exit; + end + else + WindowProc := DefWindowProc(Window, AMessage, WParam, LParam); + end; +end; + +function WinRegister: Boolean; +var + WindowClass: WndClass; +begin + WindowClass.Style := cs_hRedraw or cs_vRedraw; + WindowClass.lpfnWndProc := WndProc(@WindowProc); + WindowClass.cbClsExtra := 0; + WindowClass.cbWndExtra := 0; + WindowClass.hInstance := system.MainInstance; + WindowClass.hIcon := LoadIcon(0, idi_Application); + WindowClass.hCursor := LoadCursor(0, idc_Arrow); + WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH); + WindowClass.lpszMenuName := nil; + WindowClass.lpszClassName := 'MyWindow'; + + winregister:=RegisterClass(WindowClass) <> 0; +end; + + { Create the Window Class } +function WinCreate: HWnd; +var + hWindow: HWnd; +begin + + hWindow := CreateWindow('MyWindow', 'Graph window application', + ws_OverlappedWindow, 100, 100, + maxx+20, maxy+40, 0, 0, system.MainInstance, nil); + + if hWindow <> 0 then begin + ShowWindow(hWindow, SW_SHOW); + UpdateWindow(hWindow); + end; + + wincreate:=hWindow; +end; + +function MessageHandleThread(p : pointer) : DWord;StdCall; + + var + AMessage: Msg; + + begin + if not WinRegister then begin + MessageBox(0, 'Register failed', nil, mb_Ok); + Exit; + end; + MainWindow := WinCreate; + if longint(mainwindow) = 0 then begin + MessageBox(0, 'WinCreate failed', nil, mb_Ok); + Exit; + end; + while GetMessage(@AMessage, 0, 0, 0) do + begin + TranslateMessage(AMessage); + DispatchMessage(AMessage); + end; + MessageHandleThread:=0; + end; + +procedure InitWin32GUI640x480x16; + + begin + getmem(pal,sizeof(RGBrec)*maxcolor); + move(DefaultColors,pal^,sizeof(RGBrec)*maxcolor); + { start graph subsystem } + InitializeCriticalSection(graphdrawing); + graphrunning:=false; + MessageThreadHandle:=CreateThread(nil,0,@MessageHandleThread, + nil,0,MessageThreadID); + repeat until graphrunning; + end; + +procedure CloseGraph; + + begin + If not isgraphmode then + begin + _graphresult := grnoinitgraph; + exit + end; + WaitForSingleObject(MessageThreadHandle,Infinite); + CloseHandle(MessageThreadHandle); + DeleteCriticalSection(graphdrawing); + freemem(pal,sizeof(RGBrec)*maxcolor); + end; + +{ +procedure line(x1,y1,x2,y2 : longint); + + var + pen,oldpen : hpen; + windc : hdc; + + begin + if graphrunning then + begin + EnterCriticalSection(graphdrawing); + pen:=CreatePen(PS_SOLID,4,RGB($ff,0,0)); + + oldpen:=SelectObject(bitmapdc,pen); + MoveToEx(bitmapdc,x1,y1,nil); + LineTo(bitmapdc,x2,y2); + SelectObject(bitmapdc,oldpen); + + windc:=GetDC(mainwindow); + oldpen:=SelectObject(windc,pen); + MoveToEx(windc,x1,y1,nil); + LineTo(windc,x2,y2); + SelectObject(windc,oldpen); + ReleaseDC(mainwindow,windc); + + DeleteObject(pen); + LeaveCriticalSection(graphdrawing); + end; + end; + +} + +{ multipage support could be done by using more than one background bitmap } +procedure SetVisualWin32GUI(page: word); + + begin + end; + +procedure SetActiveWin32GUI(page: word); + begin + end; + +function queryadapterinfo : pmodeinfo; + + var + mode: TModeInfo; + + begin + SaveVideoState:=savestate; + RestoreVideoState:=restorestate; + QueryAdapterInfo := ModeList; + { If the mode listing already exists... } + { simply return it, without changing } + { anything... } + if assigned(ModeList) then + exit; + InitMode(mode); + { now add all standard VGA modes... } + mode.DriverNumber:= VGA; + mode.HardwarePages:= 0; + mode.ModeNumber:=0; + mode.ModeName:='640 x 480 Win32GUI'; + mode.MaxColor := 16; + mode.PaletteSize := mode.MaxColor; + mode.DirectColor := FALSE; + mode.MaxX := 639; + mode.MaxY := 479; + mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI; + mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI; + mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI; + mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI; + mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI; + mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI; + mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI; + mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI; + mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI640x480x16; + mode.XAspect := 10000; + mode.YAspect := 10000; + AddMode(mode); + end; + +{ + $Log$ + Revision 1.1 1999-11-03 20:23:02 florian + + first release of win32 gui support + +}