123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 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';
- { used to create a file containing all calls to WM_PAINT
- WARNING this probably creates HUGE files PM }
- { $define DEBUG_WM_PAINT}
- var
- savedscreen : hbitmap;
- graphrunning : boolean;
- graphdrawing : tcriticalsection;
- {$ifdef DEBUG_WM_PAINT}
- graphdebug : text;
- const
- wm_paint_count : longint = 0;
- var
- {$endif DEBUG_WM_PAINT}
- bitmapdc : hdc;
- oldbitmap : hgdiobj;
- 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<dist then
- begin
- index:=i;
- dist:=currentdist;
- if dist=0 then
- break;
- end;
- end;
- GetPaletteEntry:=index;
- end;
- procedure PutPixel16Win32GUI(x,y : integer;pixel : 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) or (x>(startxviewport+viewwidth)) or
- (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
- exit;
- end;
- if graphrunning then
- begin
- c:=RGB(pal[pixel].red,pal[pixel].green,pal[pixel].blue);
- EnterCriticalSection(graphdrawing);
- 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) or (x>(startxviewport+viewwidth)) or
- (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
- exit;
- end;
- if graphrunning then
- begin
- EnterCriticalSection(graphdrawing);
- c:=Windows.GetPixel(bitmapdc,x,y);
- LeaveCriticalSection(graphdrawing);
- GetPixel16Win32GUI:=GetPaletteEntry(GetRValue(c),GetGValue(c),GetBValue(c));
- 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);
- col:=CurrentColor;
- 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);
- col:=CurrentColor;
- 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_lbuttondown,
- wm_rbuttondown,
- wm_mbuttondown,
- wm_lbuttonup,
- wm_rbuttonup,
- wm_mbuttonup,
- wm_lbuttondblclk,
- wm_rbuttondblclk,
- wm_mbuttondblclk:
- {
- This leads to problem, i.e. the menu etc doesn't work any longer
- wm_nclbuttondown,
- wm_ncrbuttondown,
- wm_ncmbuttondown,
- wm_nclbuttonup,
- wm_ncrbuttonup,
- wm_ncmbuttonup,
- wm_nclbuttondblclk,
- wm_ncrbuttondblclk,
- wm_ncmbuttondblclk:
- }
- if assigned(mousemessagehandler) then
- WindowProc:=mousemessagehandler(window,amessage,wparam,lparam);
- wm_keydown,
- wm_keyup,
- wm_char:
- if assigned(charmessagehandler) then
- WindowProc:=charmessagehandler(window,amessage,wparam,lparam);
- wm_paint:
- begin
- {$ifdef DEBUG_WM_PAINT}
- inc(wm_paint_count);
- {$endif DEBUG_WM_PAINT}
- if not GetUpdateRect(Window,@r,false) then
- exit;
- EnterCriticalSection(graphdrawing);
- graphrunning:=true;
- dc:=BeginPaint(Window,@ps);
- {$ifdef DEBUG_WM_PAINT}
- Writeln(graphdebug,'WM_PAINT in ((',r.left,',',r.top,
- '),(',r.right,',',r.bottom,'))');
- {$endif def DEBUG_WM_PAINT}
- if graphrunning then
- {BitBlt(dc,0,0,maxx+1,maxy+1,bitmapdc,0,0,SRCCOPY);}
- BitBlt(dc,r.left,r.top,r.right,r.bottom,bitmapdc,r.left,r.top,SRCCOPY);
- EndPaint(Window,ps);
- LeaveCriticalSection(graphdrawing);
- Exit;
- end;
- wm_create:
- begin
- {$ifdef DEBUG_WM_PAINT}
- assign(graphdebug,'wingraph.log');
- rewrite(graphdebug);
- {$endif DEBUG_WM_PAINT}
- 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);
- {$ifdef DEBUG_WM_PAINT}
- close(graphdebug);
- {$endif DEBUG_WM_PAINT}
- PostQuitMessage(0);
- Exit;
- end
- else
- WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
- end;
- end;
- function WinRegister: Boolean;
- var
- WindowClass: WndClass;
- begin
- WindowClass.Style := graphwindowstyle;
- 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, 50, 50,
- maxx+20, maxy+20, 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);
- ExitThread(1);
- end;
- MainWindow := WinCreate;
- if longint(mainwindow) = 0 then begin
- MessageBox(0, 'WinCreate failed', nil, mb_Ok);
- ExitThread(1);
- end;
- while longint(GetMessage(@AMessage, 0, 0, 0))=longint(true) do
- begin
- TranslateMessage(AMessage);
- DispatchMessage(AMessage);
- end;
- MessageHandleThread:=0;
- end;
- procedure InitWin32GUI16colors;
- var
- threadexitcode : longint;
- 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
- GetExitCodeThread(MessageThreadHandle,@threadexitcode);
- until graphrunning or (threadexitcode<>STILL_ACTIVE);
- if threadexitcode<>STILL_ACTIVE then
- _graphresult := grerror;
- end;
- procedure CloseGraph;
- begin
- If not isgraphmode then
- begin
- _graphresult := grnoinitgraph;
- exit
- end;
- PostMessage(MainWindow,wm_destroy,0,0);
- PostThreadMessage(MessageThreadHandle,wm_quit,0,0);
- 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;
- ScreenWidth,ScreenHeight : longint;
- begin
- SaveVideoState:=savestate;
- RestoreVideoState:=restorestate;
- ScreenWidth:=GetSystemMetrics(SM_CXSCREEN);
- ScreenHeight:=GetSystemMetrics(SM_CYSCREEN);
- 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:=VGALo;
- mode.ModeName:='640 x 200 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 199;
- 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}InitWin32GUI16colors;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGAMed;
- mode.ModeName:='640 x 350 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 349;
- 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}InitWin32GUI16colors;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGAHi;
- 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}InitWin32GUI16colors;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m640x400x256;
- mode.ModeName:='640 x 400 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 399;
- 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}InitWin32GUI16colors;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m640x480x256;
- mode.ModeName:='640 x 480 x 256 Win32GUI';
- mode.MaxColor := 256;
- 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}InitWin32GUI16colors;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- { add 800x600 only if screen is large enough }
- If (ScreenWidth>=800) and (ScreenHeight>=600) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m800x600x16;
- mode.ModeName:='800 x 600 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- 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}InitWin32GUI16colors;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m800x600x256;
- mode.ModeName:='800 x 600 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- 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}InitWin32GUI16colors;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- end;
- {
- $Log$
- Revision 1.6 2000-01-07 16:41:52 daniel
- * copyright 2000
- Revision 1.5 1999/12/08 09:09:34 pierre
- + add VESA compatible mode in 16 and 256 colors
- Revision 1.4 1999/12/02 00:24:36 pierre
- * local var col was undefined
- + 640x200 and 640x350 modes added (VGALo and VGAMed)
- * WM_PAINT better handled (only requested region written)
- Revision 1.3 1999/11/30 22:36:53 florian
- * the wm_nc... messages aren't handled anymore it leads to too mch problems ...
- Revision 1.2 1999/11/29 22:03:39 florian
- * first implementation of winmouse unit
- Revision 1.1 1999/11/08 11:15:22 peter
- * move graph.inc to the target dir
- Revision 1.1 1999/11/03 20:23:02 florian
- + first release of win32 gui support
- }
|