graph.pp 43 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. This file implements the win32 gui support for the graph unit
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit Graph;
  13. interface
  14. uses
  15. windows;
  16. {$i graphh.inc}
  17. var
  18. { this procedure allows to hook keyboard messages }
  19. charmessagehandler : function(Window: hwnd; AMessage, WParam,
  20. LParam: Longint): Longint;
  21. { this procedure allows to hook mouse messages }
  22. mousemessagehandler : function(Window: hwnd; AMessage, WParam,
  23. LParam: Longint): Longint;
  24. mainwindow : HWnd;
  25. const
  26. { predefined window style }
  27. { we shouldn't set CS_DBLCLKS here }
  28. { because most dos applications }
  29. { handle double clicks on it's own }
  30. graphwindowstyle : DWord = cs_hRedraw or cs_vRedraw;
  31. windowtitle : pchar = 'Graph window application';
  32. CONST
  33. m640x200x16 = VGALo;
  34. m640x400x16 = VGAMed;
  35. m640x480x16 = VGAHi;
  36. { VESA Specific video modes. }
  37. m320x200x32k = $10D;
  38. m320x200x64k = $10E;
  39. m640x400x256 = $100;
  40. m640x480x256 = $101;
  41. m640x480x32k = $110;
  42. m640x480x64k = $111;
  43. m800x600x16 = $102;
  44. m800x600x256 = $103;
  45. m800x600x32k = $113;
  46. m800x600x64k = $114;
  47. m1024x768x16 = $104;
  48. m1024x768x256 = $105;
  49. m1024x768x32k = $116;
  50. m1024x768x64k = $117;
  51. m1280x1024x16 = $106;
  52. m1280x1024x256 = $107;
  53. m1280x1024x32k = $119;
  54. m1280x1024x64k = $11A;
  55. { some extra modes which applies only to GUI }
  56. mLargestWindow16 = $f0;
  57. mLargestWindow256 = $f1;
  58. mLargestWindow32k = $f2;
  59. mLargestWindow64k = $f3;
  60. mLargestWindow16M = $f4;
  61. mMaximizedWindow16 = $f5;
  62. mMaximizedWindow256 = $f6;
  63. mMaximizedWindow32k = $f7;
  64. mMaximizedWindow64k = $f8;
  65. mMaximizedWindow16M = $f9;
  66. implementation
  67. uses
  68. strings;
  69. {
  70. Remarks:
  71. Colors in 16 color mode:
  72. ------------------------
  73. - the behavior of xor/or/and put isn't 100%:
  74. it is done using the RGB color getting from windows
  75. instead of the palette index!
  76. - palette operations aren't supported
  77. To solve these drawbacks, setpalette must be implemented
  78. by exchanging the colors in the DCs, further GetPaletteEntry
  79. must be used when doing xor/or/and operations
  80. }
  81. const
  82. InternalDriverName = 'WIN32GUI';
  83. {$i graph.inc}
  84. { used to create a file containing all calls to WM_PAINT
  85. WARNING this probably creates HUGE files PM }
  86. { $define DEBUG_WM_PAINT}
  87. var
  88. savedscreen : hbitmap;
  89. graphrunning : boolean;
  90. graphdrawing : tcriticalsection;
  91. {$ifdef DEBUG_WM_PAINT}
  92. graphdebug : text;
  93. const
  94. wm_paint_count : longint = 0;
  95. var
  96. {$endif DEBUG_WM_PAINT}
  97. bitmapdc : hdc;
  98. oldbitmap : hgdiobj;
  99. pal : ^rgbrec;
  100. // SavePtr : pointer; { we don't use that pointer }
  101. MessageThreadHandle : Handle;
  102. MessageThreadID : DWord;
  103. windc : hdc;
  104. function GetPaletteEntry(r,g,b : word) : word;
  105. var
  106. dist,i,index,currentdist : longint;
  107. begin
  108. dist:=$7fffffff;
  109. index:=0;
  110. for i:=0 to maxcolors-1 do
  111. begin
  112. currentdist:=abs(r-pal[i].red)+abs(g-pal[i].green)+
  113. abs(b-pal[i].blue);
  114. if currentdist<dist then
  115. begin
  116. index:=i;
  117. dist:=currentdist;
  118. if dist=0 then
  119. break;
  120. end;
  121. end;
  122. GetPaletteEntry:=index;
  123. end;
  124. procedure PutPixel16Win32GUI(x,y : integer;pixel : word);
  125. var
  126. c : colorref;
  127. begin
  128. x:=x+startxviewport;
  129. y:=y+startyviewport;
  130. { convert to absolute coordinates and then verify clipping...}
  131. if clippixels then
  132. begin
  133. if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
  134. (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
  135. exit;
  136. end;
  137. if graphrunning then
  138. begin
  139. c:=RGB(pal[pixel].red,pal[pixel].green,pal[pixel].blue);
  140. EnterCriticalSection(graphdrawing);
  141. SetPixel(bitmapdc,x,y,c);
  142. SetPixel(windc,x,y,c);
  143. LeaveCriticalSection(graphdrawing);
  144. end;
  145. end;
  146. function GetPixel16Win32GUI(x,y : integer) : word;
  147. var
  148. c : COLORREF;
  149. begin
  150. x:=x+startxviewport;
  151. y:=y+startyviewport;
  152. { convert to absolute coordinates and then verify clipping...}
  153. if clippixels then
  154. begin
  155. if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
  156. (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
  157. exit;
  158. end;
  159. if graphrunning then
  160. begin
  161. EnterCriticalSection(graphdrawing);
  162. c:=Windows.GetPixel(bitmapdc,x,y);
  163. LeaveCriticalSection(graphdrawing);
  164. GetPixel16Win32GUI:=GetPaletteEntry(GetRValue(c),GetGValue(c),GetBValue(c));
  165. end
  166. else
  167. begin
  168. _graphresult:=grerror;
  169. exit;
  170. end;
  171. end;
  172. procedure DirectPutPixel16Win32GUI(x,y : integer);
  173. var
  174. col : longint;
  175. c,c2 : COLORREF;
  176. begin
  177. if graphrunning then
  178. begin
  179. EnterCriticalSection(graphdrawing);
  180. col:=CurrentColor;
  181. case currentwritemode of
  182. XorPut:
  183. Begin
  184. c2:=Windows.GetPixel(bitmapdc,x,y);
  185. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
  186. SetPixel(bitmapdc,x,y,c);
  187. SetPixel(windc,x,y,c);
  188. End;
  189. AndPut:
  190. Begin
  191. c2:=Windows.GetPixel(bitmapdc,x,y);
  192. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
  193. SetPixel(bitmapdc,x,y,c);
  194. SetPixel(windc,x,y,c);
  195. End;
  196. OrPut:
  197. Begin
  198. c2:=Windows.GetPixel(bitmapdc,x,y);
  199. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
  200. SetPixel(bitmapdc,x,y,c);
  201. SetPixel(windc,x,y,c);
  202. End
  203. else
  204. Begin
  205. If CurrentWriteMode<>NotPut Then
  206. col:=CurrentColor
  207. Else col := Not(CurrentColor);
  208. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  209. SetPixel(bitmapdc,x,y,c);
  210. SetPixel(windc,x,y,c);
  211. End
  212. end;
  213. LeaveCriticalSection(graphdrawing);
  214. end;
  215. end;
  216. var
  217. bitmapfontcache : array[0..255] of HBITMAP;
  218. procedure DrawBitmapCharHorizWin32GUI(x,y : longint;charsize : word;const s : string);
  219. var
  220. cnt1,cnt2,cnt3,cnt4,j,k,c,xpos,i : longint;
  221. fontbitmap : TBitmapChar;
  222. bitmap,oldbitmap : HBITMAP;
  223. chardc : HDC;
  224. color : longint;
  225. brushwin,oldbrushwin,brushbitmap,oldbrushbitmap : HBRUSH;
  226. bitmaprgn,winrgn : HRGN;
  227. begin
  228. EnterCriticalSection(graphdrawing);
  229. c:=length(s);
  230. chardc:=CreateCompatibleDC(windc);
  231. if currentcolor<>white then
  232. begin
  233. color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
  234. pal[currentcolor].blue);
  235. brushwin:=CreateSolidBrush(color);
  236. oldbrushwin:=SelectObject(windc,brushwin);
  237. brushbitmap:=CreateSolidBrush(color);
  238. oldbrushbitmap:=SelectObject(windc,brushbitmap);
  239. end;
  240. inc(x,startxviewport);
  241. inc(y,startyviewport);
  242. { let windows do the clipping }
  243. bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
  244. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  245. winrgn:=CreateRectRgn(startxviewport,startyviewport,
  246. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  247. SelectClipRgn(bitmapdc,bitmaprgn);
  248. SelectClipRgn(windc,winrgn);
  249. for i:=0 to c-1 do
  250. begin
  251. xpos:=x+(i*8)*Charsize;
  252. if bitmapfontcache[byte(s[i+1])]=0 then
  253. begin
  254. bitmap:=CreateCompatibleBitmap(windc,8,8);
  255. oldbitmap:=SelectObject(chardc,bitmap);
  256. Fontbitmap:=TBitmapChar(DefaultFontData[s[i+1]]);
  257. for j:=0 to 7 do
  258. for k:=0 to 7 do
  259. if Fontbitmap[j,k]<>0 then
  260. SetPixel(chardc,k,j,$ffffff)
  261. else
  262. SetPixel(chardc,k,j,0);
  263. bitmapfontcache[byte(s[i+1])]:=bitmap;
  264. SelectObject(chardc,oldbitmap);
  265. end;
  266. oldbitmap:=SelectObject(chardc,bitmapfontcache[byte(s[i+1])]);
  267. if CharSize=1 then
  268. begin
  269. if currentcolor=white then
  270. begin
  271. BitBlt(windc,xpos,y,8,8,chardc,0,0,SRCPAINT);
  272. BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,SRCPAINT);
  273. end
  274. else
  275. begin
  276. { could we do this with one pattern operation ?? }
  277. { we would need something like DSnaSPao }
  278. // ROP $00220326=DSna
  279. BitBlt(windc,xpos,y,8,8,chardc,0,0,$00220326);
  280. BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00220326);
  281. // ROP $00EA02E9 = DPSao
  282. BitBlt(windc,xpos,y,8,8,chardc,0,0,$00EA02E9);
  283. BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00EA02E9);
  284. end;
  285. end
  286. else
  287. begin
  288. if currentcolor=white then
  289. begin
  290. StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
  291. StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
  292. end
  293. else
  294. begin
  295. { could we do this with one pattern operation ?? }
  296. { we would need something like DSnaSPao }
  297. // ROP $00220326=DSna
  298. StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
  299. StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
  300. // ROP $00EA02E9 = DPSao
  301. StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
  302. StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
  303. end;
  304. end;
  305. end;
  306. if currentcolor<>white then
  307. begin
  308. SelectObject(windc,oldbrushwin);
  309. DeleteObject(brushwin);
  310. SelectObject(bitmapdc,oldbrushbitmap);
  311. DeleteObject(brushbitmap);
  312. end;
  313. { release clip regions }
  314. SelectClipRgn(bitmapdc,0);
  315. SelectClipRgn(windc,0);
  316. DeleteDC(chardc);
  317. LeaveCriticalSection(graphdrawing);
  318. end;
  319. procedure HLine16Win32GUI(x,x2,y: integer);
  320. var
  321. c,c2 : COLORREF;
  322. col,i : longint;
  323. oldpen,pen : HPEN;
  324. Begin
  325. if graphrunning then
  326. begin
  327. { must we swap the values? }
  328. if x>x2 then
  329. Begin
  330. x:=x xor x2;
  331. x2:=x xor x2;
  332. x:=x xor x2;
  333. end;
  334. { First convert to global coordinates }
  335. X:=X+StartXViewPort;
  336. X2:=X2+StartXViewPort;
  337. Y:=Y+StartYViewPort;
  338. if ClipPixels then
  339. Begin
  340. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  341. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  342. exit;
  343. end;
  344. Case CurrentWriteMode of
  345. AndPut:
  346. Begin
  347. EnterCriticalSection(graphdrawing);
  348. col:=CurrentColor;
  349. for i:=x to x2 do
  350. begin
  351. c2:=Windows.GetPixel(bitmapdc,i,y);
  352. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
  353. SetPixel(bitmapdc,i,y,c);
  354. SetPixel(windc,i,y,c);
  355. end;
  356. LeaveCriticalSection(graphdrawing);
  357. End;
  358. XorPut:
  359. Begin
  360. EnterCriticalSection(graphdrawing);
  361. for i:=x to x2 do
  362. begin
  363. c2:=Windows.GetPixel(bitmapdc,i,y);
  364. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
  365. SetPixel(bitmapdc,i,y,c);
  366. SetPixel(windc,i,y,c);
  367. end;
  368. LeaveCriticalSection(graphdrawing);
  369. End;
  370. OrPut:
  371. Begin
  372. EnterCriticalSection(graphdrawing);
  373. for i:=x to x2 do
  374. begin
  375. c2:=Windows.GetPixel(bitmapdc,i,y);
  376. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
  377. SetPixel(bitmapdc,i,y,c);
  378. SetPixel(windc,i,y,c);
  379. end;
  380. LeaveCriticalSection(graphdrawing);
  381. End
  382. Else
  383. Begin
  384. If CurrentWriteMode<>NotPut Then
  385. col:=CurrentColor
  386. Else col:=Not(CurrentColor);
  387. EnterCriticalSection(graphdrawing);
  388. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  389. pen:=CreatePen(PS_SOLID,1,c);
  390. oldpen:=SelectObject(bitmapdc,pen);
  391. Windows.MoveToEx(bitmapdc,x,y,nil);
  392. Windows.LineTo(bitmapdc,x2+1,y);
  393. SelectObject(bitmapdc,oldpen);
  394. oldpen:=SelectObject(windc,pen);
  395. Windows.MoveToEx(windc,x,y,nil);
  396. Windows.LineTo(windc,x2+1,y);
  397. SelectObject(windc,oldpen);
  398. DeleteObject(pen);
  399. LeaveCriticalSection(graphdrawing);
  400. End;
  401. End;
  402. end;
  403. end;
  404. procedure SetRGBPaletteWin32GUI(colorNum,redValue,greenvalue,
  405. bluevalue : integer);
  406. begin
  407. if directcolor or (colornum<0) or (colornum>=maxcolor) then
  408. begin
  409. _graphresult:=grerror;
  410. exit;
  411. end;
  412. pal[colorNum].red:=redValue;
  413. pal[colorNum].green:=greenValue;
  414. pal[colorNum].blue:=blueValue;
  415. end;
  416. procedure GetRGBPaletteWin32GUI(colorNum : integer;
  417. var redValue,greenvalue,bluevalue : integer);
  418. begin
  419. if directcolor or (colornum<0) or (colornum>=maxcolor) then
  420. begin
  421. _graphresult:=grerror;
  422. exit;
  423. end;
  424. redValue:=pal[colorNum].red;
  425. greenValue:=pal[colorNum].green;
  426. blueValue:=pal[colorNum].blue;
  427. end;
  428. procedure savestate;
  429. begin
  430. end;
  431. procedure restorestate;
  432. begin
  433. end;
  434. function WindowProc(Window: HWnd; AMessage, WParam,
  435. LParam: Longint): Longint; stdcall; export;
  436. var
  437. dc : hdc;
  438. ps : paintstruct;
  439. r : rect;
  440. oldbrush : hbrush;
  441. oldpen : hpen;
  442. i : longint;
  443. begin
  444. WindowProc := 0;
  445. case AMessage of
  446. wm_lbuttondown,
  447. wm_rbuttondown,
  448. wm_mbuttondown,
  449. wm_lbuttonup,
  450. wm_rbuttonup,
  451. wm_mbuttonup,
  452. wm_lbuttondblclk,
  453. wm_rbuttondblclk,
  454. wm_mbuttondblclk:
  455. {
  456. This leads to problem, i.e. the menu etc doesn't work any longer
  457. wm_nclbuttondown,
  458. wm_ncrbuttondown,
  459. wm_ncmbuttondown,
  460. wm_nclbuttonup,
  461. wm_ncrbuttonup,
  462. wm_ncmbuttonup,
  463. wm_nclbuttondblclk,
  464. wm_ncrbuttondblclk,
  465. wm_ncmbuttondblclk:
  466. }
  467. if assigned(mousemessagehandler) then
  468. WindowProc:=mousemessagehandler(window,amessage,wparam,lparam);
  469. wm_keydown,
  470. wm_keyup,
  471. wm_char:
  472. if assigned(charmessagehandler) then
  473. WindowProc:=charmessagehandler(window,amessage,wparam,lparam);
  474. wm_paint:
  475. begin
  476. {$ifdef DEBUG_WM_PAINT}
  477. inc(wm_paint_count);
  478. {$endif DEBUG_WM_PAINT}
  479. if not GetUpdateRect(Window,@r,false) then
  480. exit;
  481. EnterCriticalSection(graphdrawing);
  482. graphrunning:=true;
  483. dc:=BeginPaint(Window,@ps);
  484. {$ifdef DEBUG_WM_PAINT}
  485. Writeln(graphdebug,'WM_PAINT in ((',r.left,',',r.top,
  486. '),(',r.right,',',r.bottom,'))');
  487. {$endif def DEBUG_WM_PAINT}
  488. if graphrunning then
  489. {BitBlt(dc,0,0,maxx+1,maxy+1,bitmapdc,0,0,SRCCOPY);}
  490. BitBlt(dc,r.left,r.top,r.right-r.left+1,r.bottom-r.top+1,bitmapdc,r.left,r.top,SRCCOPY);
  491. EndPaint(Window,ps);
  492. LeaveCriticalSection(graphdrawing);
  493. Exit;
  494. end;
  495. wm_create:
  496. begin
  497. {$ifdef DEBUG_WM_PAINT}
  498. assign(graphdebug,'wingraph.log');
  499. rewrite(graphdebug);
  500. {$endif DEBUG_WM_PAINT}
  501. EnterCriticalSection(graphdrawing);
  502. dc:=GetDC(window);
  503. bitmapdc:=CreateCompatibleDC(dc);
  504. savedscreen:=CreateCompatibleBitmap(dc,maxx+1,maxy+1);
  505. ReleaseDC(window,dc);
  506. oldbitmap:=SelectObject(bitmapdc,savedscreen);
  507. windc:=GetDC(window);
  508. // clear everything
  509. oldpen:=SelectObject(bitmapdc,GetStockObject(BLACK_PEN));
  510. oldbrush:=SelectObject(bitmapdc,GetStockObject(BLACK_BRUSH));
  511. Windows.Rectangle(bitmapdc,0,0,maxx,maxy);
  512. SelectObject(bitmapdc,oldpen);
  513. SelectObject(bitmapdc,oldbrush);
  514. // ... the window too
  515. oldpen:=SelectObject(windc,GetStockObject(BLACK_PEN));
  516. oldbrush:=SelectObject(windc,GetStockObject(BLACK_BRUSH));
  517. Windows.Rectangle(windc,0,0,maxx,maxy);
  518. SelectObject(windc,oldpen);
  519. SelectObject(windc,oldbrush);
  520. // clear font cache
  521. fillchar(bitmapfontcache,sizeof(bitmapfontcache),0);
  522. LeaveCriticalSection(graphdrawing);
  523. end;
  524. wm_Destroy:
  525. begin
  526. EnterCriticalSection(graphdrawing);
  527. graphrunning:=false;
  528. ReleaseDC(mainwindow,windc);
  529. SelectObject(bitmapdc,oldbitmap);
  530. DeleteObject(savedscreen);
  531. DeleteDC(bitmapdc);
  532. // release font cache
  533. for i:=0 to 255 do
  534. if bitmapfontcache[i]<>0 then
  535. DeleteObject(bitmapfontcache[i]);
  536. LeaveCriticalSection(graphdrawing);
  537. {$ifdef DEBUG_WM_PAINT}
  538. close(graphdebug);
  539. {$endif DEBUG_WM_PAINT}
  540. PostQuitMessage(0);
  541. Exit;
  542. end
  543. else
  544. WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
  545. end;
  546. end;
  547. function WinRegister: Boolean;
  548. var
  549. WindowClass: WndClass;
  550. begin
  551. WindowClass.Style := graphwindowstyle;
  552. WindowClass.lpfnWndProc := WndProc(@WindowProc);
  553. WindowClass.cbClsExtra := 0;
  554. WindowClass.cbWndExtra := 0;
  555. WindowClass.hInstance := system.MainInstance;
  556. WindowClass.hIcon := LoadIcon(0, idi_Application);
  557. WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  558. WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
  559. WindowClass.lpszMenuName := nil;
  560. WindowClass.lpszClassName := 'FPCGraphWindow';
  561. winregister:=RegisterClass(WindowClass) <> 0;
  562. end;
  563. var
  564. // here we can force the creation of a maximized window }
  565. extrastyle : longint;
  566. { Create the Window Class }
  567. function WinCreate : HWnd;
  568. var
  569. hWindow: HWnd;
  570. begin
  571. hWindow := CreateWindow('FPCGraphWindow', windowtitle,
  572. ws_OverlappedWindow or extrastyle, CW_USEDEFAULT, 0,
  573. maxx+1+2*GetSystemMetrics(SM_CXFRAME),
  574. maxy+1+2*GetSystemMetrics(SM_CYFRAME)+
  575. GetSystemMetrics(SM_CYCAPTION),
  576. 0, 0, system.MainInstance, nil);
  577. if hWindow <> 0 then begin
  578. ShowWindow(hWindow, SW_SHOW);
  579. UpdateWindow(hWindow);
  580. end;
  581. wincreate:=hWindow;
  582. end;
  583. const
  584. winregistered : boolean = false;
  585. function MessageHandleThread(p : pointer) : DWord;StdCall;
  586. var
  587. AMessage: Msg;
  588. begin
  589. if not(winregistered) then
  590. begin
  591. if not WinRegister then
  592. begin
  593. MessageBox(0, 'Window registration failed', nil, mb_Ok);
  594. ExitThread(1);
  595. end;
  596. winregistered:=true;
  597. end;
  598. MainWindow := WinCreate;
  599. if longint(mainwindow) = 0 then begin
  600. MessageBox(0, 'Window creation failed', nil, mb_Ok);
  601. ExitThread(1);
  602. end;
  603. while longint(GetMessage(@AMessage, 0, 0, 0))=longint(true) do
  604. begin
  605. TranslateMessage(AMessage);
  606. DispatchMessage(AMessage);
  607. end;
  608. MessageHandleThread:=0;
  609. end;
  610. procedure InitWin32GUI16colors;
  611. var
  612. threadexitcode : longint;
  613. begin
  614. getmem(pal,sizeof(RGBrec)*maxcolor);
  615. move(DefaultColors,pal^,sizeof(RGBrec)*maxcolor);
  616. if (IntCurrentMode=mMaximizedWindow16) or
  617. (IntCurrentMode=mMaximizedWindow256) or
  618. (IntCurrentMode=mMaximizedWindow32k) or
  619. (IntCurrentMode=mMaximizedWindow64k) or
  620. (IntCurrentMode=mMaximizedWindow16M) then
  621. extrastyle:=ws_maximize
  622. else
  623. extrastyle:=0;
  624. { start graph subsystem }
  625. InitializeCriticalSection(graphdrawing);
  626. graphrunning:=false;
  627. MessageThreadHandle:=CreateThread(nil,0,@MessageHandleThread,
  628. nil,0,MessageThreadID);
  629. repeat
  630. GetExitCodeThread(MessageThreadHandle,@threadexitcode);
  631. until graphrunning or (threadexitcode<>STILL_ACTIVE);
  632. if threadexitcode<>STILL_ACTIVE then
  633. _graphresult := grerror;
  634. end;
  635. procedure CloseGraph;
  636. begin
  637. If not isgraphmode then
  638. begin
  639. _graphresult := grnoinitgraph;
  640. exit
  641. end;
  642. PostMessage(MainWindow,wm_destroy,0,0);
  643. PostThreadMessage(MessageThreadHandle,wm_quit,0,0);
  644. WaitForSingleObject(MessageThreadHandle,Infinite);
  645. CloseHandle(MessageThreadHandle);
  646. DeleteCriticalSection(graphdrawing);
  647. freemem(pal,sizeof(RGBrec)*maxcolor);
  648. end;
  649. {
  650. procedure line(x1,y1,x2,y2 : longint);
  651. var
  652. pen,oldpen : hpen;
  653. windc : hdc;
  654. begin
  655. if graphrunning then
  656. begin
  657. EnterCriticalSection(graphdrawing);
  658. pen:=CreatePen(PS_SOLID,4,RGB($ff,0,0));
  659. oldpen:=SelectObject(bitmapdc,pen);
  660. MoveToEx(bitmapdc,x1,y1,nil);
  661. LineTo(bitmapdc,x2,y2);
  662. SelectObject(bitmapdc,oldpen);
  663. windc:=GetDC(mainwindow);
  664. oldpen:=SelectObject(windc,pen);
  665. MoveToEx(windc,x1,y1,nil);
  666. LineTo(windc,x2,y2);
  667. SelectObject(windc,oldpen);
  668. ReleaseDC(mainwindow,windc);
  669. DeleteObject(pen);
  670. LeaveCriticalSection(graphdrawing);
  671. end;
  672. end;
  673. }
  674. { multipage support could be done by using more than one background bitmap }
  675. procedure SetVisualWin32GUI(page: word);
  676. begin
  677. end;
  678. procedure SetActiveWin32GUI(page: word);
  679. begin
  680. end;
  681. function queryadapterinfo : pmodeinfo;
  682. var
  683. mode: TModeInfo;
  684. ScreenWidth,ScreenHeight : longint;
  685. ScreenWidthMaximized,ScreenHeightMaximized : longint;
  686. begin
  687. SaveVideoState:=savestate;
  688. RestoreVideoState:=restorestate;
  689. { we must take care of the border and caption }
  690. ScreenWidth:=GetSystemMetrics(SM_CXSCREEN)-
  691. 2*GetSystemMetrics(SM_CXFRAME);
  692. ScreenHeight:=GetSystemMetrics(SM_CYSCREEN)-
  693. 2*GetSystemMetrics(SM_CYFRAME)-
  694. GetSystemMetrics(SM_CYCAPTION);
  695. { for maximozed windows it's again different }
  696. { here we've only a caption }
  697. ScreenWidthMaximized:=GetSystemMetrics(SM_CXFULLSCREEN);
  698. { neither GetSystemMetrics(SM_CYFULLSCREEN nor }
  699. { SystemParametersInfo(SPI_GETWORKAREA) }
  700. { takes a hidden try into account :( FK }
  701. ScreenHeightMaximized:=GetSystemMetrics(SM_CYFULLSCREEN);
  702. QueryAdapterInfo := ModeList;
  703. { If the mode listing already exists... }
  704. { simply return it, without changing }
  705. { anything... }
  706. if assigned(ModeList) then
  707. exit;
  708. { the first one becomes the standard mode }
  709. if (ScreenWidth>=640) and (ScreenHeight>=480) then
  710. begin
  711. InitMode(mode);
  712. mode.DriverNumber:= VGA;
  713. mode.HardwarePages:= 0;
  714. mode.ModeNumber:=VGAHi;
  715. mode.ModeName:='640 x 480 x 16 Win32GUI';
  716. mode.MaxColor := 16;
  717. mode.PaletteSize := mode.MaxColor;
  718. mode.DirectColor := FALSE;
  719. mode.MaxX := 639;
  720. mode.MaxY := 479;
  721. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  722. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  723. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  724. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  725. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  726. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  727. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  728. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  729. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  730. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  731. mode.XAspect := 10000;
  732. mode.YAspect := 10000;
  733. AddMode(mode);
  734. end;
  735. if (ScreenWidth>=640) and (ScreenHeight>=200) then
  736. begin
  737. InitMode(mode);
  738. { now add all standard VGA modes... }
  739. mode.DriverNumber:= VGA;
  740. mode.HardwarePages:= 0;
  741. mode.ModeNumber:=VGALo;
  742. mode.ModeName:='640 x 200 x 16 Win32GUI';
  743. mode.MaxColor := 16;
  744. mode.PaletteSize := mode.MaxColor;
  745. mode.DirectColor := FALSE;
  746. mode.MaxX := 639;
  747. mode.MaxY := 199;
  748. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  749. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  750. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  751. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  752. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  753. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  754. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  755. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  756. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  757. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  758. mode.XAspect := 10000;
  759. mode.YAspect := 10000;
  760. AddMode(mode);
  761. end;
  762. if (ScreenWidth>=640) and (ScreenHeight>=350) then
  763. begin
  764. InitMode(mode);
  765. mode.DriverNumber:= VGA;
  766. mode.HardwarePages:= 0;
  767. mode.ModeNumber:=VGAMed;
  768. mode.ModeName:='640 x 350 x 16 Win32GUI';
  769. mode.MaxColor := 16;
  770. mode.PaletteSize := mode.MaxColor;
  771. mode.DirectColor := FALSE;
  772. mode.MaxX := 639;
  773. mode.MaxY := 349;
  774. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  775. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  776. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  777. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  778. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  779. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  780. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  781. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  782. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  783. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  784. mode.XAspect := 10000;
  785. mode.YAspect := 10000;
  786. AddMode(mode);
  787. end;
  788. if (ScreenWidth>=640) and (ScreenHeight>=400) then
  789. begin
  790. InitMode(mode);
  791. mode.DriverNumber:= VESA;
  792. mode.HardwarePages:= 0;
  793. mode.ModeNumber:=m640x400x256;
  794. mode.ModeName:='640 x 400 x 256 Win32GUI';
  795. mode.MaxColor := 256;
  796. mode.PaletteSize := mode.MaxColor;
  797. mode.DirectColor := FALSE;
  798. mode.MaxX := 639;
  799. mode.MaxY := 399;
  800. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  801. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  802. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  803. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  804. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  805. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  806. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  807. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  808. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  809. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  810. mode.XAspect := 10000;
  811. mode.YAspect := 10000;
  812. AddMode(mode);
  813. end;
  814. if (ScreenWidth>=640) and (ScreenHeight>=480) then
  815. begin
  816. InitMode(mode);
  817. mode.DriverNumber:= VESA;
  818. mode.HardwarePages:= 0;
  819. mode.ModeNumber:=m640x480x256;
  820. mode.ModeName:='640 x 480 x 256 Win32GUI';
  821. mode.MaxColor := 256;
  822. mode.PaletteSize := mode.MaxColor;
  823. mode.DirectColor := FALSE;
  824. mode.MaxX := 639;
  825. mode.MaxY := 479;
  826. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  827. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  828. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  829. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  830. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  831. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  832. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  833. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  834. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  835. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  836. mode.XAspect := 10000;
  837. mode.YAspect := 10000;
  838. AddMode(mode);
  839. end;
  840. { add 800x600 only if screen is large enough }
  841. If (ScreenWidth>=800) and (ScreenHeight>=600) then
  842. begin
  843. InitMode(mode);
  844. mode.DriverNumber:= VESA;
  845. mode.HardwarePages:= 0;
  846. mode.ModeNumber:=m800x600x16;
  847. mode.ModeName:='800 x 600 x 16 Win32GUI';
  848. mode.MaxColor := 16;
  849. mode.PaletteSize := mode.MaxColor;
  850. mode.DirectColor := FALSE;
  851. mode.MaxX := 799;
  852. mode.MaxY := 599;
  853. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  854. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  855. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  856. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  857. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  858. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  859. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  860. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  861. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  862. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  863. mode.XAspect := 10000;
  864. mode.YAspect := 10000;
  865. AddMode(mode);
  866. InitMode(mode);
  867. mode.DriverNumber:= VESA;
  868. mode.HardwarePages:= 0;
  869. mode.ModeNumber:=m800x600x256;
  870. mode.ModeName:='800 x 600 x 256 Win32GUI';
  871. mode.MaxColor := 256;
  872. mode.PaletteSize := mode.MaxColor;
  873. mode.DirectColor := FALSE;
  874. mode.MaxX := 799;
  875. mode.MaxY := 599;
  876. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  877. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  878. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  879. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  880. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  881. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  882. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  883. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  884. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  885. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  886. mode.XAspect := 10000;
  887. mode.YAspect := 10000;
  888. AddMode(mode);
  889. end;
  890. { add 1024x768 only if screen is large enough }
  891. If (ScreenWidth>=1024) and (ScreenHeight>=768) then
  892. begin
  893. InitMode(mode);
  894. mode.DriverNumber:= VESA;
  895. mode.HardwarePages:= 0;
  896. mode.ModeNumber:=m1024x768x16;
  897. mode.ModeName:='1024 x 768 x 16 Win32GUI';
  898. mode.MaxColor := 16;
  899. mode.PaletteSize := mode.MaxColor;
  900. mode.DirectColor := FALSE;
  901. mode.MaxX := 1023;
  902. mode.MaxY := 767;
  903. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  904. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  905. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  906. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  907. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  908. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  909. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  910. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  911. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  912. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  913. mode.XAspect := 10000;
  914. mode.YAspect := 10000;
  915. AddMode(mode);
  916. InitMode(mode);
  917. mode.DriverNumber:= VESA;
  918. mode.HardwarePages:= 0;
  919. mode.ModeNumber:=m1024x768x256;
  920. mode.ModeName:='1024 x 768 x 256 Win32GUI';
  921. mode.MaxColor := 256;
  922. mode.PaletteSize := mode.MaxColor;
  923. mode.DirectColor := FALSE;
  924. mode.MaxX := 1023;
  925. mode.MaxY := 768;
  926. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  927. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  928. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  929. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  930. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  931. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  932. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  933. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  934. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  935. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  936. mode.XAspect := 10000;
  937. mode.YAspect := 10000;
  938. AddMode(mode);
  939. end;
  940. { add 1280x1024 only if screen is large enough }
  941. If (ScreenWidth>=1280) and (ScreenHeight>=1024) then
  942. begin
  943. InitMode(mode);
  944. mode.DriverNumber:= VESA;
  945. mode.HardwarePages:= 0;
  946. mode.ModeNumber:=m1280x1024x16;
  947. mode.ModeName:='1280 x 1024 x 16 Win32GUI';
  948. mode.MaxColor := 16;
  949. mode.PaletteSize := mode.MaxColor;
  950. mode.DirectColor := FALSE;
  951. mode.MaxX := 1279;
  952. mode.MaxY := 1023;
  953. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  954. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  955. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  956. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  957. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  958. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  959. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  960. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  961. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  962. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  963. mode.XAspect := 10000;
  964. mode.YAspect := 10000;
  965. AddMode(mode);
  966. InitMode(mode);
  967. mode.DriverNumber:= VESA;
  968. mode.HardwarePages:= 0;
  969. mode.ModeNumber:=m1280x1024x256;
  970. mode.ModeName:='1280 x 1024 x 256 Win32GUI';
  971. mode.MaxColor := 256;
  972. mode.PaletteSize := mode.MaxColor;
  973. mode.DirectColor := FALSE;
  974. mode.MaxX := 1279;
  975. mode.MaxY := 1023;
  976. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  977. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  978. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  979. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  980. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  981. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  982. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  983. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  984. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  985. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  986. mode.XAspect := 10000;
  987. mode.YAspect := 10000;
  988. AddMode(mode);
  989. end;
  990. { at least we add a mode with the largest possible window }
  991. InitMode(mode);
  992. mode.DriverNumber:= VESA;
  993. mode.HardwarePages:= 0;
  994. mode.ModeNumber:=mLargestWindow16;
  995. mode.ModeName:='Largest Window x 16';
  996. mode.MaxColor := 16;
  997. mode.PaletteSize := mode.MaxColor;
  998. mode.DirectColor := FALSE;
  999. mode.MaxX := ScreenWidth-1;
  1000. mode.MaxY := ScreenHeight-1;
  1001. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  1002. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  1003. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  1004. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  1005. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  1006. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  1007. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  1008. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  1009. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  1010. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  1011. mode.XAspect := 10000;
  1012. mode.YAspect := 10000;
  1013. AddMode(mode);
  1014. InitMode(mode);
  1015. mode.DriverNumber:= VESA;
  1016. mode.HardwarePages:= 0;
  1017. mode.ModeNumber:=mLargestWindow256;
  1018. mode.ModeName:='Largest Window x 256';
  1019. mode.MaxColor := 256;
  1020. mode.PaletteSize := mode.MaxColor;
  1021. mode.DirectColor := FALSE;
  1022. mode.MaxX := ScreenWidth-1;
  1023. mode.MaxY := ScreenHeight-1;
  1024. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  1025. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  1026. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  1027. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  1028. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  1029. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  1030. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  1031. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  1032. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  1033. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  1034. mode.XAspect := 10000;
  1035. mode.YAspect := 10000;
  1036. AddMode(mode);
  1037. { .. and a maximized window }
  1038. InitMode(mode);
  1039. mode.DriverNumber:= VESA;
  1040. mode.HardwarePages:= 0;
  1041. mode.ModeNumber:=mMaximizedWindow16;
  1042. mode.ModeName:='Maximized Window x 16';
  1043. mode.MaxColor := 16;
  1044. mode.PaletteSize := mode.MaxColor;
  1045. mode.DirectColor := FALSE;
  1046. mode.MaxX := ScreenWidthMaximized-1;
  1047. mode.MaxY := ScreenHeightMaximized-1;
  1048. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  1049. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  1050. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  1051. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  1052. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  1053. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  1054. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  1055. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  1056. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  1057. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  1058. mode.XAspect := 10000;
  1059. mode.YAspect := 10000;
  1060. AddMode(mode);
  1061. InitMode(mode);
  1062. mode.DriverNumber:= VESA;
  1063. mode.HardwarePages:= 0;
  1064. mode.ModeNumber:=mMaximizedWindow256;
  1065. mode.ModeName:='Maximized Window x 256';
  1066. mode.MaxColor := 256;
  1067. mode.PaletteSize := mode.MaxColor;
  1068. mode.DirectColor := FALSE;
  1069. mode.MaxX := ScreenWidthMaximized-1;
  1070. mode.MaxY := ScreenHeightMaximized-1;
  1071. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  1072. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  1073. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  1074. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  1075. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  1076. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  1077. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  1078. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  1079. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  1080. mode.DrawBitmapCharHoriz:={$ifdef fpc}@{$endif}DrawBitmapCharHorizWin32GUI;
  1081. mode.XAspect := 10000;
  1082. mode.YAspect := 10000;
  1083. AddMode(mode);
  1084. end;
  1085. begin
  1086. InitializeGraph;
  1087. end.
  1088. {
  1089. $Log$
  1090. Revision 1.4 2000-03-24 18:18:15 florian
  1091. * accelerated output of bitmap fonts
  1092. Revision 1.3 2000/03/24 12:57:41 florian
  1093. * the window is now cleared by wm_create
  1094. * default mode is again 640x480x16
  1095. Revision 1.2 2000/03/24 10:49:17 florian
  1096. * the mode detection takes now care of window caption and border
  1097. + 1024x768 and 1280x1024 modes added
  1098. + special gui modes added: largest window and maximized window to
  1099. use the desktop as much as possible
  1100. * Hline fixed: the windows function LineTo doesn't draw the last pixel!
  1101. Revision 1.1 2000/03/19 11:20:14 peter
  1102. * graph unit include is now independent and the dependent part
  1103. is now in graph.pp
  1104. * ggigraph unit for linux added
  1105. Revision 1.8 2000/03/17 22:53:20 florian
  1106. * window class is registered only once => multible init/closegraphs are possible
  1107. * calling cleardevice when creating the window
  1108. Revision 1.7 2000/03/05 13:06:32 florian
  1109. * the title can be user defined
  1110. Revision 1.6 2000/01/07 16:41:52 daniel
  1111. * copyright 2000
  1112. Revision 1.5 1999/12/08 09:09:34 pierre
  1113. + add VESA compatible mode in 16 and 256 colors
  1114. Revision 1.4 1999/12/02 00:24:36 pierre
  1115. * local var col was undefined
  1116. + 640x200 and 640x350 modes added (VGALo and VGAMed)
  1117. * WM_PAINT better handled (only requested region written)
  1118. Revision 1.3 1999/11/30 22:36:53 florian
  1119. * the wm_nc... messages aren't handled anymore it leads to too mch problems ...
  1120. Revision 1.2 1999/11/29 22:03:39 florian
  1121. * first implementation of winmouse unit
  1122. Revision 1.1 1999/11/08 11:15:22 peter
  1123. * move graph.inc to the target dir
  1124. Revision 1.1 1999/11/03 20:23:02 florian
  1125. + first release of win32 gui support
  1126. }