paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 16:59:44 +02:00
Code Issues Packages Projects Releases Wiki Activity
cea4495a20
fpc/rtl/win32/graph.inc
daniel ec29a31834 * copyright 2000
2000-01-07 16:41:28 +00:00

745 lines
23 KiB
PHP
Raw Blame History

{
$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
}
Reference in New Issue View Git Blame Copy Permalink