graph.pp 70 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050
  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. // this allows direct drawing to the window
  26. bitmapdc : hdc;
  27. windc : hdc;
  28. const
  29. { predefined window style }
  30. { we shouldn't set CS_DBLCLKS here }
  31. { because most dos applications }
  32. { handle double clicks on it's own }
  33. graphwindowstyle : DWord = cs_hRedraw or cs_vRedraw;
  34. windowtitle : pchar = 'Graph window application';
  35. drawtoscreen : boolean = true;
  36. drawtobitmap : boolean = true;
  37. CONST
  38. m640x200x16 = VGALo;
  39. m640x400x16 = VGAMed;
  40. m640x480x16 = VGAHi;
  41. { VESA Specific video modes. }
  42. m320x200x32k = $10D;
  43. m320x200x64k = $10E;
  44. m640x400x256 = $100;
  45. m640x480x256 = $101;
  46. m640x480x32k = $110;
  47. m640x480x64k = $111;
  48. m800x600x16 = $102;
  49. m800x600x256 = $103;
  50. m800x600x32k = $113;
  51. m800x600x64k = $114;
  52. m1024x768x16 = $104;
  53. m1024x768x256 = $105;
  54. m1024x768x32k = $116;
  55. m1024x768x64k = $117;
  56. m1280x1024x16 = $106;
  57. m1280x1024x256 = $107;
  58. m1280x1024x32k = $119;
  59. m1280x1024x64k = $11A;
  60. { some extra modes which applies only to GUI }
  61. mLargestWindow16 = $f0;
  62. mLargestWindow256 = $f1;
  63. mLargestWindow32k = $f2;
  64. mLargestWindow64k = $f3;
  65. mLargestWindow16M = $f4;
  66. mMaximizedWindow16 = $f5;
  67. mMaximizedWindow256 = $f6;
  68. mMaximizedWindow32k = $f7;
  69. mMaximizedWindow64k = $f8;
  70. mMaximizedWindow16M = $f9;
  71. implementation
  72. uses
  73. strings;
  74. {
  75. Remarks:
  76. Colors in 16 color mode:
  77. ------------------------
  78. - the behavior of xor/or/and put isn't 100%:
  79. it is done using the RGB color getting from windows
  80. instead of the palette index!
  81. - palette operations aren't supported
  82. To solve these drawbacks, setpalette must be implemented
  83. by exchanging the colors in the DCs, further GetPaletteEntry
  84. must be used when doing xor/or/and operations
  85. }
  86. const
  87. InternalDriverName = 'WIN32GUI';
  88. {$i graph.inc}
  89. { used to create a file containing all calls to WM_PAINT
  90. WARNING this probably creates HUGE files PM }
  91. { $define DEBUG_WM_PAINT}
  92. var
  93. savedscreen : hbitmap;
  94. graphrunning : boolean;
  95. graphdrawing : tcriticalsection;
  96. pens : array[0..15] of HPEN;
  97. {$ifdef DEBUG_WM_PAINT}
  98. graphdebug : text;
  99. const
  100. wm_paint_count : longint = 0;
  101. var
  102. {$endif DEBUG_WM_PAINT}
  103. oldbitmap : hgdiobj;
  104. pal : ^rgbrec;
  105. // SavePtr : pointer; { we don't use that pointer }
  106. MessageThreadHandle : Handle;
  107. MessageThreadID : DWord;
  108. function GetPaletteEntry(r,g,b : word) : word;
  109. var
  110. dist,i,index,currentdist : longint;
  111. begin
  112. dist:=$7fffffff;
  113. index:=0;
  114. for i:=0 to maxcolors do
  115. begin
  116. currentdist:=abs(r-pal[i].red)+abs(g-pal[i].green)+
  117. abs(b-pal[i].blue);
  118. if currentdist<dist then
  119. begin
  120. index:=i;
  121. dist:=currentdist;
  122. if dist=0 then
  123. break;
  124. end;
  125. end;
  126. GetPaletteEntry:=index;
  127. end;
  128. procedure PutPixel16Win32GUI(x,y : integer;pixel : word);
  129. var
  130. c : colorref;
  131. begin
  132. x:=x+startxviewport;
  133. y:=y+startyviewport;
  134. { convert to absolute coordinates and then verify clipping...}
  135. if clippixels then
  136. begin
  137. if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
  138. (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
  139. exit;
  140. end;
  141. if graphrunning then
  142. begin
  143. c:=RGB(pal[pixel].red,pal[pixel].green,pal[pixel].blue);
  144. EnterCriticalSection(graphdrawing);
  145. if drawtobitmap then
  146. SetPixelV(bitmapdc,x,y,c);
  147. if drawtoscreen then
  148. SetPixelV(windc,x,y,c);
  149. LeaveCriticalSection(graphdrawing);
  150. end;
  151. end;
  152. function GetPixel16Win32GUI(x,y : integer) : word;
  153. var
  154. c : COLORREF;
  155. begin
  156. x:=x+startxviewport;
  157. y:=y+startyviewport;
  158. { convert to absolute coordinates and then verify clipping...}
  159. if clippixels then
  160. begin
  161. if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
  162. (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
  163. exit;
  164. end;
  165. if graphrunning then
  166. begin
  167. EnterCriticalSection(graphdrawing);
  168. c:=Windows.GetPixel(bitmapdc,x,y);
  169. LeaveCriticalSection(graphdrawing);
  170. GetPixel16Win32GUI:=GetPaletteEntry(GetRValue(c),GetGValue(c),GetBValue(c));
  171. end
  172. else
  173. begin
  174. _graphresult:=grerror;
  175. exit;
  176. end;
  177. end;
  178. procedure DirectPutPixel16Win32GUI(x,y : integer);
  179. var
  180. col : longint;
  181. c,c2 : COLORREF;
  182. begin
  183. if graphrunning then
  184. begin
  185. EnterCriticalSection(graphdrawing);
  186. col:=CurrentColor;
  187. case currentwritemode of
  188. XorPut:
  189. Begin
  190. c2:=Windows.GetPixel(bitmapdc,x,y);
  191. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
  192. if drawtobitmap then
  193. SetPixelV(bitmapdc,x,y,c);
  194. if drawtoscreen then
  195. SetPixelV(windc,x,y,c);
  196. End;
  197. AndPut:
  198. Begin
  199. c2:=Windows.GetPixel(bitmapdc,x,y);
  200. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
  201. if drawtobitmap then
  202. SetPixelV(bitmapdc,x,y,c);
  203. if drawtoscreen then
  204. SetPixelV(windc,x,y,c);
  205. End;
  206. OrPut:
  207. Begin
  208. c2:=Windows.GetPixel(bitmapdc,x,y);
  209. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
  210. if drawtobitmap then
  211. SetPixelV(bitmapdc,x,y,c);
  212. if drawtoscreen then
  213. SetPixelV(windc,x,y,c);
  214. End
  215. else
  216. Begin
  217. If CurrentWriteMode<>NotPut Then
  218. col:=CurrentColor
  219. Else col := Not(CurrentColor);
  220. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  221. if drawtobitmap then
  222. SetPixelV(bitmapdc,x,y,c);
  223. if drawtoscreen then
  224. SetPixelV(windc,x,y,c);
  225. End
  226. end;
  227. LeaveCriticalSection(graphdrawing);
  228. end;
  229. end;
  230. var
  231. bitmapfontverticalcache : array[0..255] of HBITMAP;
  232. bitmapfonthorizoncache : array[0..255] of HBITMAP;
  233. procedure OutTextXYWin32GUI(x,y : smallint;const TextString : string);
  234. type
  235. Tpoint = record
  236. X,Y: smallint;
  237. end;
  238. var
  239. i,j,k,c : longint;
  240. xpos,ypos : longint;
  241. counter : longint;
  242. cnt1,cnt2 : smallint;
  243. cnt3,cnt4 : smallint;
  244. charsize : word;
  245. WriteMode : word;
  246. curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
  247. oldvalues : linesettingstype;
  248. fontbitmap : TBitmapChar;
  249. chr : char;
  250. curx2i,cury2i,
  251. xpos2i,ypos2i : longint;
  252. charbitmap,oldcharbitmap : HBITMAP;
  253. chardc : HDC;
  254. color : longint;
  255. brushwin,oldbrushwin,brushbitmap,oldbrushbitmap : HBRUSH;
  256. bitmaprgn,winrgn : HRGN;
  257. begin
  258. { save current write mode }
  259. WriteMode := CurrentWriteMode;
  260. CurrentWriteMode := NormalPut;
  261. GetTextPosition(xpos,ypos,textstring);
  262. X:=X-XPos; Y:=Y+YPos;
  263. XPos:=X; YPos:=Y;
  264. CharSize := CurrentTextInfo.Charsize;
  265. if Currenttextinfo.font=DefaultFont then
  266. begin
  267. if CurrentTextInfo.direction=HorizDir then
  268. { Horizontal direction }
  269. begin
  270. if (x>viewwidth) or (y>viewheight) or
  271. (x<0) or (y<0) then
  272. begin
  273. CurrentWriteMode:=WriteMode;
  274. exit;
  275. end;
  276. EnterCriticalSection(graphdrawing);
  277. c:=length(textstring);
  278. chardc:=CreateCompatibleDC(windc);
  279. if currentcolor<>white then
  280. begin
  281. color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
  282. pal[currentcolor].blue);
  283. if drawtoscreen then
  284. begin
  285. brushwin:=CreateSolidBrush(color);
  286. oldbrushwin:=SelectObject(windc,brushwin);
  287. end;
  288. if drawtobitmap then
  289. begin
  290. brushbitmap:=CreateSolidBrush(color);
  291. oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
  292. end;
  293. end;
  294. inc(x,startxviewport);
  295. inc(y,startyviewport);
  296. { let windows do the clipping }
  297. if drawtobitmap then
  298. begin
  299. bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
  300. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  301. SelectClipRgn(bitmapdc,bitmaprgn);
  302. end;
  303. if drawtoscreen then
  304. begin
  305. winrgn:=CreateRectRgn(startxviewport,startyviewport,
  306. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  307. SelectClipRgn(windc,winrgn);
  308. end;
  309. for i:=0 to c-1 do
  310. begin
  311. xpos:=x+(i*8)*Charsize;
  312. if bitmapfonthorizoncache[byte(textstring[i+1])]=0 then
  313. begin
  314. charbitmap:=CreateCompatibleBitmap(windc,8,8);
  315. if charbitmap=0 then
  316. writeln('Bitmap konnte nicht erzeugt werden!');
  317. oldcharbitmap:=SelectObject(chardc,charbitmap);
  318. Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
  319. for j:=0 to 7 do
  320. for k:=0 to 7 do
  321. if Fontbitmap[j,k]<>0 then
  322. SetPixelV(chardc,k,j,$ffffff)
  323. else
  324. SetPixelV(chardc,k,j,0);
  325. bitmapfonthorizoncache[byte(textstring[i+1])]:=charbitmap;
  326. SelectObject(chardc,oldcharbitmap);
  327. end;
  328. oldcharbitmap:=SelectObject(chardc,bitmapfonthorizoncache[byte(textstring[i+1])]);
  329. if CharSize=1 then
  330. begin
  331. if currentcolor=white then
  332. begin
  333. if drawtoscreen then
  334. BitBlt(windc,xpos,y,8,8,chardc,0,0,SRCPAINT);
  335. if drawtobitmap then
  336. BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,SRCPAINT);
  337. end
  338. else
  339. begin
  340. { could we do this with one pattern operation ?? }
  341. { we would need something like DSnaSPao }
  342. if drawtoscreen then
  343. begin
  344. // ROP $00220326=DSna
  345. BitBlt(windc,xpos,y,8,8,chardc,0,0,$00220326);
  346. // ROP $00EA02E9 = DPSao
  347. BitBlt(windc,xpos,y,8,8,chardc,0,0,$00EA02E9);
  348. end;
  349. if drawtobitmap then
  350. begin
  351. BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00220326);
  352. BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00EA02E9);
  353. end;
  354. end;
  355. end
  356. else
  357. begin
  358. if currentcolor=white then
  359. begin
  360. if drawtoscreen then
  361. StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
  362. if drawtobitmap then
  363. StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
  364. end
  365. else
  366. begin
  367. { could we do this with one pattern operation ?? }
  368. { we would need something like DSnaSPao }
  369. if drawtoscreen then
  370. begin
  371. // ROP $00220326=DSna
  372. StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
  373. // ROP $00EA02E9 = DPSao
  374. StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
  375. end;
  376. if drawtobitmap then
  377. begin
  378. StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
  379. StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
  380. end;
  381. end;
  382. end;
  383. SelectObject(chardc,oldcharbitmap);
  384. end;
  385. if currentcolor<>white then
  386. begin
  387. if drawtoscreen then
  388. begin
  389. SelectObject(windc,oldbrushwin);
  390. DeleteObject(brushwin);
  391. end;
  392. if drawtobitmap then
  393. begin
  394. SelectObject(bitmapdc,oldbrushbitmap);
  395. DeleteObject(brushbitmap);
  396. end;
  397. end;
  398. { release clip regions }
  399. if drawtobitmap then
  400. begin
  401. SelectClipRgn(bitmapdc,0);
  402. DeleteObject(bitmaprgn);
  403. end;
  404. if drawtoscreen then
  405. begin
  406. SelectClipRgn(windc,0);
  407. DeleteObject(winrgn);
  408. end;
  409. DeleteDC(chardc);
  410. LeaveCriticalSection(graphdrawing);
  411. end
  412. else
  413. { Vertical direction }
  414. begin
  415. if (x>viewwidth) or (y>viewheight) or
  416. (x<0) or (y<0) then
  417. begin
  418. CurrentWriteMode:=WriteMode;
  419. exit;
  420. end;
  421. EnterCriticalSection(graphdrawing);
  422. c:=length(textstring);
  423. chardc:=CreateCompatibleDC(windc);
  424. if currentcolor<>white then
  425. begin
  426. color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
  427. pal[currentcolor].blue);
  428. if drawtoscreen then
  429. begin
  430. brushwin:=CreateSolidBrush(color);
  431. oldbrushwin:=SelectObject(windc,brushwin);
  432. end;
  433. if drawtobitmap then
  434. begin
  435. brushbitmap:=CreateSolidBrush(color);
  436. oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
  437. end;
  438. end;
  439. inc(x,startxviewport);
  440. inc(y,startyviewport);
  441. { let windows do the clipping }
  442. if drawtoscreen then
  443. begin
  444. winrgn:=CreateRectRgn(startxviewport,startyviewport,
  445. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  446. SelectClipRgn(windc,winrgn);
  447. end;
  448. if drawtobitmap then
  449. begin
  450. bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
  451. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  452. SelectClipRgn(bitmapdc,bitmaprgn);
  453. end;
  454. for i:=0 to c-1 do
  455. begin
  456. ypos:=y+1-((i+1)*8)*CharSize;
  457. if bitmapfontverticalcache[byte(textstring[i+1])]=0 then
  458. begin
  459. charbitmap:=CreateCompatibleBitmap(windc,8,8);
  460. if charbitmap=0 then
  461. writeln('Bitmap konnte nicht erzeugt werden!');
  462. oldcharbitmap:=SelectObject(chardc,charbitmap);
  463. Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
  464. for j:=0 to 7 do
  465. for k:=0 to 7 do
  466. if Fontbitmap[j,k]<>0 then
  467. SetPixelV(chardc,j,7-k,$ffffff)
  468. else
  469. SetPixelV(chardc,j,7-k,0);
  470. bitmapfontverticalcache[byte(textstring[i+1])]:=charbitmap;
  471. SelectObject(chardc,oldcharbitmap);
  472. end;
  473. oldcharbitmap:=SelectObject(chardc,bitmapfontverticalcache[byte(textstring[i+1])]);
  474. if CharSize=1 then
  475. begin
  476. if currentcolor=white then
  477. begin
  478. if drawtoscreen then
  479. BitBlt(windc,x,ypos,8,8,chardc,0,0,SRCPAINT);
  480. if drawtobitmap then
  481. BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,SRCPAINT);
  482. end
  483. else
  484. begin
  485. { could we do this with one pattern operation ?? }
  486. { we would need something like DSnaSPao }
  487. if drawtoscreen then
  488. begin
  489. // ROP $00220326=DSna
  490. BitBlt(windc,x,ypos,8,8,chardc,0,0,$00220326);
  491. // ROP $00EA02E9 = DPSao
  492. BitBlt(windc,x,ypos,8,8,chardc,0,0,$00EA02E9);
  493. end;
  494. if drawtobitmap then
  495. begin
  496. BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00220326);
  497. BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00EA02E9);
  498. end;
  499. end;
  500. end
  501. else
  502. begin
  503. if currentcolor=white then
  504. begin
  505. if drawtoscreen then
  506. StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
  507. if drawtobitmap then
  508. StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
  509. end
  510. else
  511. begin
  512. { could we do this with one pattern operation ?? }
  513. { we would need something like DSnaSPao }
  514. if drawtoscreen then
  515. begin
  516. // ROP $00220326=DSna
  517. StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
  518. // ROP $00EA02E9 = DPSao
  519. StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
  520. end;
  521. if drawtobitmap then
  522. begin
  523. StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
  524. StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
  525. end;
  526. end;
  527. end;
  528. SelectObject(chardc,oldcharbitmap);
  529. end;
  530. if currentcolor<>white then
  531. begin
  532. if drawtoscreen then
  533. begin
  534. SelectObject(windc,oldbrushwin);
  535. DeleteObject(brushwin);
  536. end;
  537. if drawtobitmap then
  538. begin
  539. SelectObject(bitmapdc,oldbrushbitmap);
  540. DeleteObject(brushbitmap);
  541. end;
  542. end;
  543. { release clip regions }
  544. if drawtoscreen then
  545. begin
  546. SelectClipRgn(windc,0);
  547. DeleteObject(winrgn);
  548. end;
  549. if drawtobitmap then
  550. begin
  551. SelectClipRgn(bitmapdc,0);
  552. DeleteObject(bitmaprgn);
  553. end;
  554. DeleteDC(chardc);
  555. LeaveCriticalSection(graphdrawing);
  556. end;
  557. end else
  558. { This is a stroked font which is already loaded into memory }
  559. begin
  560. getlinesettings(oldvalues);
  561. { reset line style to defaults }
  562. setlinestyle(solidln,oldvalues.pattern,normwidth);
  563. if Currenttextinfo.direction=vertdir then
  564. xpos:=xpos + Textheight(textstring);
  565. CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
  566. CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
  567. { x:=xpos; y:=ypos;}
  568. for i:=1 to length(textstring) do
  569. begin
  570. c:=byte(textstring[i]);
  571. { Stroke_Count[c] := }
  572. unpack( fonts[CurrentTextInfo.font].instr,
  573. fonts[CurrentTextInfo.font].Offsets[c], Strokes );
  574. counter:=0;
  575. while true do
  576. begin
  577. if CurrentTextInfo.direction=VertDir then
  578. begin
  579. xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
  580. ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
  581. end
  582. else
  583. begin
  584. xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
  585. ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
  586. end;
  587. case opcodes(Strokes[counter].opcode) of
  588. _END_OF_CHAR: break;
  589. _DO_SCAN: begin
  590. { Currently unsupported };
  591. end;
  592. _MOVE : Begin
  593. CurX2 := XPos2;
  594. CurY2 := YPos2;
  595. end;
  596. _DRAW: Begin
  597. curx2i:=trunc(CurX2);
  598. cury2i:=trunc(CurY2);
  599. xpos2i:=trunc(xpos2);
  600. ypos2i:=trunc(ypos2);
  601. { this optimization doesn't matter that much
  602. if (curx2i=xpos2i) then
  603. begin
  604. if (cury2i=ypos2i) then
  605. putpixel(curx2i,cury2i,currentcolor)
  606. else if (cury2i+1=ypos2i) or
  607. (cury2i=ypos2i+1) then
  608. begin
  609. putpixel(curx2i,cury2i,currentcolor);
  610. putpixel(curx2i,ypos2i,currentcolor);
  611. end
  612. else
  613. Line(curx2i,cury2i,xpos2i,ypos2i);
  614. end
  615. else if (cury2i=ypos2i) then
  616. begin
  617. if (curx2i+1=xpos2i) or
  618. (curx2i=xpos2i+1) then
  619. begin
  620. putpixel(curx2i,cury2i,currentcolor);
  621. putpixel(xpos2i,cury2i,currentcolor);
  622. end
  623. else
  624. Line(curx2i,cury2i,xpos2i,ypos2i);
  625. end
  626. else
  627. }
  628. Line(curx2i,cury2i,xpos2i,ypos2i);
  629. CurX2:=xpos2;
  630. CurY2:=ypos2;
  631. end;
  632. else
  633. Begin
  634. end;
  635. end;
  636. Inc(counter);
  637. end; { end while }
  638. if Currenttextinfo.direction=VertDir then
  639. y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
  640. else
  641. x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
  642. end;
  643. setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
  644. end;
  645. { restore write mode }
  646. CurrentWriteMode := WriteMode;
  647. end;
  648. procedure HLine16Win32GUI(x,x2,y: integer);
  649. var
  650. c,c2 : COLORREF;
  651. col,i : longint;
  652. oldpen,pen : HPEN;
  653. Begin
  654. if graphrunning then
  655. begin
  656. { must we swap the values? }
  657. if x>x2 then
  658. Begin
  659. x:=x xor x2;
  660. x2:=x xor x2;
  661. x:=x xor x2;
  662. end;
  663. if ClipPixels then
  664. begin
  665. if (x>ViewWidth) or (y<0) or (y>ViewHeight) or (x2<0) then
  666. exit;
  667. if x<0 then
  668. x:=0;
  669. if x2>ViewWidth then
  670. x2:=ViewWidth;
  671. end;
  672. X:=X+StartXViewPort;
  673. X2:=X2+StartXViewPort;
  674. Y:=Y+StartYViewPort;
  675. Case CurrentWriteMode of
  676. AndPut:
  677. Begin
  678. EnterCriticalSection(graphdrawing);
  679. col:=CurrentColor;
  680. for i:=x to x2 do
  681. begin
  682. c2:=Windows.GetPixel(bitmapdc,i,y);
  683. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
  684. if drawtobitmap then
  685. SetPixel(bitmapdc,i,y,c);
  686. if drawtoscreen then
  687. SetPixel(windc,i,y,c);
  688. end;
  689. LeaveCriticalSection(graphdrawing);
  690. End;
  691. XorPut:
  692. Begin
  693. EnterCriticalSection(graphdrawing);
  694. col:=CurrentColor;
  695. for i:=x to x2 do
  696. begin
  697. c2:=Windows.GetPixel(bitmapdc,i,y);
  698. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
  699. if drawtobitmap then
  700. SetPixel(bitmapdc,i,y,c);
  701. if drawtoscreen then
  702. SetPixel(windc,i,y,c);
  703. end;
  704. LeaveCriticalSection(graphdrawing);
  705. End;
  706. OrPut:
  707. Begin
  708. EnterCriticalSection(graphdrawing);
  709. col:=CurrentColor;
  710. for i:=x to x2 do
  711. begin
  712. c2:=Windows.GetPixel(bitmapdc,i,y);
  713. c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
  714. if drawtobitmap then
  715. SetPixel(bitmapdc,i,y,c);
  716. if drawtoscreen then
  717. SetPixel(windc,i,y,c);
  718. end;
  719. LeaveCriticalSection(graphdrawing);
  720. End
  721. Else
  722. Begin
  723. If CurrentWriteMode<>NotPut Then
  724. col:=CurrentColor
  725. Else col:=Not(CurrentColor);
  726. EnterCriticalSection(graphdrawing);
  727. if x2-x<=2 then
  728. begin
  729. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  730. for x := x to x2 do
  731. begin
  732. if drawtobitmap then
  733. SetPixelV(bitmapdc,x,y,c);
  734. if drawtoscreen then
  735. SetPixelV(windc,x,y,c);
  736. end;
  737. end
  738. else
  739. begin
  740. if (col>=0) and (col<=high(pens)) then
  741. begin
  742. if pens[col]=0 then
  743. begin
  744. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  745. pens[col]:=CreatePen(PS_SOLID,1,c);
  746. end;
  747. pen:=pens[col];
  748. end
  749. else
  750. begin
  751. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  752. pen:=CreatePen(PS_SOLID,1,c);
  753. end;
  754. if drawtobitmap then
  755. begin
  756. oldpen:=SelectObject(bitmapdc,pen);
  757. Windows.MoveToEx(bitmapdc,x,y,nil);
  758. Windows.LineTo(bitmapdc,x2+1,y);
  759. SelectObject(bitmapdc,oldpen);
  760. end;
  761. if drawtoscreen then
  762. begin
  763. oldpen:=SelectObject(windc,pen);
  764. Windows.MoveToEx(windc,x,y,nil);
  765. Windows.LineTo(windc,x2+1,y);
  766. SelectObject(windc,oldpen);
  767. end;
  768. if (col<0) or (col>high(pens)) then
  769. DeleteObject(pen);
  770. end;
  771. LeaveCriticalSection(graphdrawing);
  772. End;
  773. End;
  774. end;
  775. end;
  776. procedure VLine16Win32GUI(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
  777. var
  778. ytmp: smallint;
  779. col,c : longint;
  780. oldpen,pen : HPEN;
  781. Begin
  782. { must we swap the values? }
  783. if y >= y2 then
  784. Begin
  785. ytmp := y2;
  786. y2 := y;
  787. y:= ytmp;
  788. end;
  789. if ClipPixels then
  790. begin
  791. if (x>ViewWidth) or (x<0) or (y>ViewHeight) or (y2<0) then
  792. exit;
  793. if y<0 then
  794. y:=0;
  795. if y2>ViewHeight then
  796. y2:=ViewHeight;
  797. end;
  798. { First convert to global coordinates }
  799. X := X + StartXViewPort;
  800. Y2 := Y2 + StartYViewPort;
  801. Y := Y + StartYViewPort;
  802. if currentwritemode=normalput then
  803. begin
  804. col:=CurrentColor;
  805. EnterCriticalSection(graphdrawing);
  806. if y2-y<=2 then
  807. begin
  808. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  809. for y := y to y2 do
  810. begin
  811. if drawtobitmap then
  812. SetPixelV(bitmapdc,x,y,c);
  813. if drawtoscreen then
  814. SetPixelV(windc,x,y,c);
  815. end;
  816. end
  817. else
  818. begin
  819. if (col>=0) and (col<=high(pens)) then
  820. begin
  821. if pens[col]=0 then
  822. begin
  823. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  824. pens[col]:=CreatePen(PS_SOLID,1,c);
  825. end;
  826. pen:=pens[col];
  827. end
  828. else
  829. begin
  830. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  831. pen:=CreatePen(PS_SOLID,1,c);
  832. end;
  833. if drawtobitmap then
  834. begin
  835. oldpen:=SelectObject(bitmapdc,pen);
  836. Windows.MoveToEx(bitmapdc,x,y,nil);
  837. Windows.LineTo(bitmapdc,x,y2+1);
  838. SelectObject(bitmapdc,oldpen);
  839. end;
  840. if drawtoscreen then
  841. begin
  842. oldpen:=SelectObject(windc,pen);
  843. Windows.MoveToEx(windc,x,y,nil);
  844. Windows.LineTo(windc,x,y2+1);
  845. SelectObject(windc,oldpen);
  846. end;
  847. if (col<0) or (col>high(pens)) then
  848. DeleteObject(pen);
  849. end;
  850. LeaveCriticalSection(graphdrawing);
  851. end
  852. else
  853. for y := y to y2 do Directputpixel(x,y)
  854. End;
  855. procedure Circle16Win32GUI(X, Y: smallint; Radius:Word);
  856. var
  857. bitmaprgn,winrgn : HRGN;
  858. col,c : longint;
  859. oldpen,pen : HPEN;
  860. OriginalArcInfo: ArcCoordsType;
  861. OldWriteMode: word;
  862. begin
  863. if (Radius = 0) then
  864. Exit;
  865. if (Radius = 1) then
  866. begin
  867. { only normal put mode is supported by a call to PutPixel }
  868. PutPixel(X, Y, CurrentColor);
  869. Exit;
  870. end;
  871. if (Radius = 2) then
  872. begin
  873. { only normal put mode is supported by a call to PutPixel }
  874. PutPixel(X-1, Y, CurrentColor);
  875. PutPixel(X+1, Y, CurrentColor);
  876. PutPixel(X, Y-1, CurrentColor);
  877. PutPixel(X, Y+1, CurrentColor);
  878. Exit;
  879. end;
  880. if LineInfo.Thickness = Normwidth then
  881. begin
  882. EnterCriticalSection(graphdrawing);
  883. { let windows do the clipping }
  884. if drawtobitmap then
  885. begin
  886. bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
  887. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  888. SelectClipRgn(bitmapdc,bitmaprgn);
  889. end;
  890. if drawtoscreen then
  891. begin
  892. winrgn:=CreateRectRgn(startxviewport,startyviewport,
  893. startxviewport+viewwidth+1,startyviewport+viewheight+1);
  894. SelectClipRgn(windc,winrgn);
  895. end;
  896. inc(x,StartXViewPort);
  897. inc(y,StartYViewPort);
  898. col:=CurrentColor;
  899. if (col>=0) and (col<=high(pens)) then
  900. begin
  901. if pens[col]=0 then
  902. begin
  903. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  904. pens[col]:=CreatePen(PS_SOLID,1,c);
  905. end;
  906. pen:=pens[col];
  907. end
  908. else
  909. begin
  910. c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
  911. pen:=CreatePen(PS_SOLID,1,c);
  912. end;
  913. if drawtobitmap then
  914. begin
  915. oldpen:=SelectObject(bitmapdc,pen);
  916. windows.arc(bitmapdc,x-radius,y-radius,x+radius,y+radius,
  917. x,y-radius,x,y-radius);
  918. SelectObject(bitmapdc,oldpen);
  919. end;
  920. if drawtoscreen then
  921. begin
  922. oldpen:=SelectObject(windc,pen);
  923. windows.arc(windc,x-radius,y-radius,x+radius,y+radius,
  924. x,y-radius,x,y-radius);
  925. SelectObject(windc,oldpen);
  926. end;
  927. if (col<0) or (col>high(pens)) then
  928. DeleteObject(pen);
  929. { release clip regions }
  930. if drawtoscreen then
  931. begin
  932. SelectClipRgn(windc,0);
  933. DeleteObject(winrgn);
  934. end;
  935. if drawtobitmap then
  936. begin
  937. SelectClipRgn(bitmapdc,0);
  938. DeleteObject(bitmaprgn);
  939. end;
  940. LeaveCriticalSection(graphdrawing);
  941. end
  942. else
  943. begin
  944. { save state of arc information }
  945. { because it is not needed for }
  946. { a circle call. }
  947. move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
  948. InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
  949. { restore arc information }
  950. move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
  951. end;
  952. end;
  953. {
  954. Procedure PutImageWin32GUI(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
  955. type
  956. pt = array[0..$fffffff] of word;
  957. ptw = array[0..2] of longint;
  958. var
  959. k: longint;
  960. oldCurrentColor: word;
  961. oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
  962. Begin
  963. {$ifdef logging}
  964. LogLn('putImage at ('+strf(x)+','+strf(y)+') with width '+strf(ptw(Bitmap)[0])+
  965. ' and height '+strf(ptw(Bitmap)[1]));
  966. deltaY := 0;
  967. {$endif logging}
  968. inc(x,startXViewPort);
  969. inc(y,startYViewPort);
  970. x1 := ptw(Bitmap)[0]+x; { get width and adjust end coordinate accordingly }
  971. y1 := ptw(Bitmap)[1]+y; { get height and adjust end coordinate accordingly }
  972. deltaX := 0;
  973. deltaX1 := 0;
  974. k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
  975. { check which part of the image is in the viewport }
  976. if clipPixels then
  977. begin
  978. if y < startYViewPort then
  979. begin
  980. deltaY := startYViewPort - y;
  981. inc(k,(x1-x+1)*deltaY);
  982. y := startYViewPort;
  983. end;
  984. if y1 > startYViewPort+viewHeight then
  985. y1 := startYViewPort+viewHeight;
  986. if x < startXViewPort then
  987. begin
  988. deltaX := startXViewPort-x;
  989. x := startXViewPort;
  990. end;
  991. if x1 > startXViewPort + viewWidth then
  992. begin
  993. deltaX1 := x1 - (startXViewPort + viewWidth);
  994. x1 := startXViewPort + viewWidth;
  995. end;
  996. end;
  997. {$ifdef logging}
  998. LogLn('deltax: '+strf(deltax)+', deltax1: '+strf(deltax1)+',deltay: '+strf(deltay));
  999. {$endif logging}
  1000. case bitBlt of
  1001. end;
  1002. oldCurrentColor := currentColor;
  1003. oldCurrentWriteMode := currentWriteMode;
  1004. currentWriteMode := bitBlt;
  1005. for j:=Y to Y1 do
  1006. Begin
  1007. inc(k,deltaX);
  1008. for i:=X to X1 do
  1009. begin
  1010. currentColor := pt(bitmap)[k];
  1011. directPutPixel(i,j);
  1012. inc(k);
  1013. end;
  1014. inc(k,deltaX1);
  1015. end;
  1016. currentWriteMode := oldCurrentWriteMode;
  1017. currentColor := oldCurrentColor;
  1018. end;
  1019. }
  1020. procedure SetRGBPaletteWin32GUI(colorNum,redValue,greenvalue,
  1021. bluevalue : integer);
  1022. begin
  1023. if directcolor or (colornum<0) or (colornum>=maxcolor) then
  1024. begin
  1025. _graphresult:=grerror;
  1026. exit;
  1027. end;
  1028. pal[colorNum].red:=redValue;
  1029. pal[colorNum].green:=greenValue;
  1030. pal[colorNum].blue:=blueValue;
  1031. end;
  1032. procedure GetRGBPaletteWin32GUI(colorNum : integer;
  1033. var redValue,greenvalue,bluevalue : integer);
  1034. begin
  1035. if directcolor or (colornum<0) or (colornum>=maxcolor) then
  1036. begin
  1037. _graphresult:=grerror;
  1038. exit;
  1039. end;
  1040. redValue:=pal[colorNum].red;
  1041. greenValue:=pal[colorNum].green;
  1042. blueValue:=pal[colorNum].blue;
  1043. end;
  1044. procedure savestate;
  1045. begin
  1046. end;
  1047. procedure restorestate;
  1048. begin
  1049. end;
  1050. function WindowProc(Window: HWnd; AMessage, WParam,
  1051. LParam: Longint): Longint; stdcall; export;
  1052. var
  1053. dc : hdc;
  1054. ps : paintstruct;
  1055. r : rect;
  1056. oldbrush : hbrush;
  1057. oldpen : hpen;
  1058. i : longint;
  1059. begin
  1060. WindowProc := 0;
  1061. case AMessage of
  1062. wm_lbuttondown,
  1063. wm_rbuttondown,
  1064. wm_mbuttondown,
  1065. wm_lbuttonup,
  1066. wm_rbuttonup,
  1067. wm_mbuttonup,
  1068. wm_lbuttondblclk,
  1069. wm_rbuttondblclk,
  1070. wm_mbuttondblclk:
  1071. {
  1072. This leads to problem, i.e. the menu etc doesn't work any longer
  1073. wm_nclbuttondown,
  1074. wm_ncrbuttondown,
  1075. wm_ncmbuttondown,
  1076. wm_nclbuttonup,
  1077. wm_ncrbuttonup,
  1078. wm_ncmbuttonup,
  1079. wm_nclbuttondblclk,
  1080. wm_ncrbuttondblclk,
  1081. wm_ncmbuttondblclk:
  1082. }
  1083. if assigned(mousemessagehandler) then
  1084. WindowProc:=mousemessagehandler(window,amessage,wparam,lparam);
  1085. wm_keydown,
  1086. wm_keyup,
  1087. wm_char:
  1088. if assigned(charmessagehandler) then
  1089. WindowProc:=charmessagehandler(window,amessage,wparam,lparam);
  1090. wm_paint:
  1091. begin
  1092. {$ifdef DEBUG_WM_PAINT}
  1093. inc(wm_paint_count);
  1094. {$endif DEBUG_WM_PAINT}
  1095. if not GetUpdateRect(Window,@r,false) then
  1096. exit;
  1097. EnterCriticalSection(graphdrawing);
  1098. graphrunning:=true;
  1099. dc:=BeginPaint(Window,@ps);
  1100. {$ifdef DEBUG_WM_PAINT}
  1101. Writeln(graphdebug,'WM_PAINT in ((',r.left,',',r.top,
  1102. '),(',r.right,',',r.bottom,'))');
  1103. {$endif def DEBUG_WM_PAINT}
  1104. if graphrunning then
  1105. {BitBlt(dc,0,0,maxx+1,maxy+1,bitmapdc,0,0,SRCCOPY);}
  1106. BitBlt(dc,r.left,r.top,r.right-r.left+1,r.bottom-r.top+1,bitmapdc,r.left,r.top,SRCCOPY);
  1107. EndPaint(Window,ps);
  1108. LeaveCriticalSection(graphdrawing);
  1109. Exit;
  1110. end;
  1111. wm_create:
  1112. begin
  1113. {$ifdef DEBUG_WM_PAINT}
  1114. assign(graphdebug,'wingraph.log');
  1115. rewrite(graphdebug);
  1116. {$endif DEBUG_WM_PAINT}
  1117. EnterCriticalSection(graphdrawing);
  1118. dc:=GetDC(window);
  1119. bitmapdc:=CreateCompatibleDC(dc);
  1120. savedscreen:=CreateCompatibleBitmap(dc,maxx+1,maxy+1);
  1121. ReleaseDC(window,dc);
  1122. oldbitmap:=SelectObject(bitmapdc,savedscreen);
  1123. windc:=GetDC(window);
  1124. // clear everything
  1125. oldpen:=SelectObject(bitmapdc,GetStockObject(BLACK_PEN));
  1126. oldbrush:=SelectObject(bitmapdc,GetStockObject(BLACK_BRUSH));
  1127. Windows.Rectangle(bitmapdc,0,0,maxx,maxy);
  1128. SelectObject(bitmapdc,oldpen);
  1129. SelectObject(bitmapdc,oldbrush);
  1130. // ... the window too
  1131. oldpen:=SelectObject(windc,GetStockObject(BLACK_PEN));
  1132. oldbrush:=SelectObject(windc,GetStockObject(BLACK_BRUSH));
  1133. Windows.Rectangle(windc,0,0,maxx,maxy);
  1134. SelectObject(windc,oldpen);
  1135. SelectObject(windc,oldbrush);
  1136. // clear font cache
  1137. fillchar(bitmapfonthorizoncache,sizeof(bitmapfonthorizoncache),0);
  1138. fillchar(bitmapfontverticalcache,sizeof(bitmapfontverticalcache),0);
  1139. // clear predefined pens
  1140. fillchar(pens,sizeof(pens),0);
  1141. LeaveCriticalSection(graphdrawing);
  1142. end;
  1143. wm_Destroy:
  1144. begin
  1145. EnterCriticalSection(graphdrawing);
  1146. graphrunning:=false;
  1147. ReleaseDC(mainwindow,windc);
  1148. SelectObject(bitmapdc,oldbitmap);
  1149. DeleteObject(savedscreen);
  1150. DeleteDC(bitmapdc);
  1151. // release font cache
  1152. for i:=0 to 255 do
  1153. if bitmapfonthorizoncache[i]<>0 then
  1154. DeleteObject(bitmapfonthorizoncache[i]);
  1155. for i:=0 to 255 do
  1156. if bitmapfontverticalcache[i]<>0 then
  1157. DeleteObject(bitmapfontverticalcache[i]);
  1158. for i:=0 to high(pens) do
  1159. if pens[i]<>0 then
  1160. DeleteObject(pens[i]);
  1161. LeaveCriticalSection(graphdrawing);
  1162. {$ifdef DEBUG_WM_PAINT}
  1163. close(graphdebug);
  1164. {$endif DEBUG_WM_PAINT}
  1165. PostQuitMessage(0);
  1166. Exit;
  1167. end
  1168. else
  1169. WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
  1170. end;
  1171. end;
  1172. function WinRegister: Boolean;
  1173. var
  1174. WindowClass: WndClass;
  1175. begin
  1176. WindowClass.Style := graphwindowstyle;
  1177. WindowClass.lpfnWndProc := WndProc(@WindowProc);
  1178. WindowClass.cbClsExtra := 0;
  1179. WindowClass.cbWndExtra := 0;
  1180. WindowClass.hInstance := system.MainInstance;
  1181. WindowClass.hIcon := LoadIcon(0, idi_Application);
  1182. WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  1183. WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
  1184. WindowClass.lpszMenuName := nil;
  1185. WindowClass.lpszClassName := 'FPCGraphWindow';
  1186. winregister:=RegisterClass(WindowClass) <> 0;
  1187. end;
  1188. var
  1189. // here we can force the creation of a maximized window }
  1190. extrastyle : longint;
  1191. { Create the Window Class }
  1192. function WinCreate : HWnd;
  1193. var
  1194. hWindow: HWnd;
  1195. begin
  1196. hWindow := CreateWindow('FPCGraphWindow', windowtitle,
  1197. ws_OverlappedWindow or extrastyle, CW_USEDEFAULT, 0,
  1198. maxx+1+2*GetSystemMetrics(SM_CXFRAME),
  1199. maxy+1+2*GetSystemMetrics(SM_CYFRAME)+
  1200. GetSystemMetrics(SM_CYCAPTION),
  1201. 0, 0, system.MainInstance, nil);
  1202. if hWindow <> 0 then begin
  1203. ShowWindow(hWindow, SW_SHOW);
  1204. UpdateWindow(hWindow);
  1205. end;
  1206. wincreate:=hWindow;
  1207. end;
  1208. const
  1209. winregistered : boolean = false;
  1210. function MessageHandleThread(p : pointer) : DWord;StdCall;
  1211. var
  1212. AMessage: Msg;
  1213. begin
  1214. if not(winregistered) then
  1215. begin
  1216. if not WinRegister then
  1217. begin
  1218. MessageBox(0, 'Window registration failed', nil, mb_Ok);
  1219. ExitThread(1);
  1220. end;
  1221. winregistered:=true;
  1222. end;
  1223. MainWindow := WinCreate;
  1224. if longint(mainwindow) = 0 then begin
  1225. MessageBox(0, 'Window creation failed', nil, mb_Ok);
  1226. ExitThread(1);
  1227. end;
  1228. while longint(GetMessage(@AMessage, 0, 0, 0))=longint(true) do
  1229. begin
  1230. TranslateMessage(AMessage);
  1231. DispatchMessage(AMessage);
  1232. end;
  1233. MessageHandleThread:=0;
  1234. end;
  1235. procedure InitWin32GUI16colors;
  1236. var
  1237. threadexitcode : longint;
  1238. begin
  1239. getmem(pal,sizeof(RGBrec)*maxcolor);
  1240. move(DefaultColors,pal^,sizeof(RGBrec)*maxcolor);
  1241. if (IntCurrentMode=mMaximizedWindow16) or
  1242. (IntCurrentMode=mMaximizedWindow256) or
  1243. (IntCurrentMode=mMaximizedWindow32k) or
  1244. (IntCurrentMode=mMaximizedWindow64k) or
  1245. (IntCurrentMode=mMaximizedWindow16M) then
  1246. extrastyle:=ws_maximize
  1247. else
  1248. extrastyle:=0;
  1249. { start graph subsystem }
  1250. InitializeCriticalSection(graphdrawing);
  1251. graphrunning:=false;
  1252. MessageThreadHandle:=CreateThread(nil,0,@MessageHandleThread,
  1253. nil,0,MessageThreadID);
  1254. repeat
  1255. GetExitCodeThread(MessageThreadHandle,@threadexitcode);
  1256. until graphrunning or (threadexitcode<>STILL_ACTIVE);
  1257. if threadexitcode<>STILL_ACTIVE then
  1258. _graphresult := grerror;
  1259. end;
  1260. procedure CloseGraph;
  1261. begin
  1262. If not isgraphmode then
  1263. begin
  1264. _graphresult := grnoinitgraph;
  1265. exit
  1266. end;
  1267. PostMessage(MainWindow,wm_destroy,0,0);
  1268. PostThreadMessage(MessageThreadHandle,wm_quit,0,0);
  1269. WaitForSingleObject(MessageThreadHandle,Infinite);
  1270. CloseHandle(MessageThreadHandle);
  1271. DeleteCriticalSection(graphdrawing);
  1272. freemem(pal,sizeof(RGBrec)*maxcolor);
  1273. end;
  1274. procedure LineWin32GUI(X1, Y1, X2, Y2: smallint); {$ifndef fpc}far;{$endif fpc}
  1275. var X, Y : smallint;
  1276. deltax, deltay : smallint;
  1277. d, dinc1, dinc2: smallint;
  1278. xinc1 : smallint;
  1279. xinc2 : smallint;
  1280. yinc1 : smallint;
  1281. yinc2 : smallint;
  1282. i : smallint;
  1283. Flag : Boolean; { determines pixel direction in thick lines }
  1284. NumPixels : smallint;
  1285. PixelCount : smallint;
  1286. OldCurrentColor: Word;
  1287. swtmp : smallint;
  1288. TmpNumPixels : smallint;
  1289. col : longint;
  1290. pen,oldpen : hpen;
  1291. begin
  1292. if graphrunning then
  1293. begin
  1294. {******************************************}
  1295. { SOLID LINES }
  1296. {******************************************}
  1297. if lineinfo.LineStyle = SolidLn then
  1298. Begin
  1299. { Convert to global coordinates. }
  1300. x1 := x1 + StartXViewPort;
  1301. x2 := x2 + StartXViewPort;
  1302. y1 := y1 + StartYViewPort;
  1303. y2 := y2 + StartYViewPort;
  1304. { if fully clipped then exit... }
  1305. if ClipPixels then
  1306. begin
  1307. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  1308. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  1309. exit;
  1310. If LineInfo.Thickness=NormWidth then
  1311. Begin
  1312. EnterCriticalSection(graphdrawing);
  1313. {
  1314. if currentwritemode<>normalput then
  1315. begin
  1316. case currentwritemode of
  1317. XORPut:
  1318. begin
  1319. SetROP2(windc,R2_XORPEN);
  1320. SetROP2(bitmapdc,R2_XORPEN);
  1321. end;
  1322. AndPut:
  1323. begin
  1324. SetROP2(windc,R2_MASKPEN);
  1325. SetROP2(bitmapdc,R2_MASKPEN);
  1326. end;
  1327. OrPut:
  1328. begin
  1329. SetROP2(windc,R2_MERGEPEN);
  1330. SetROP2(bitmapdc,R2_MERGEPEN);
  1331. end;
  1332. end;
  1333. end;
  1334. }
  1335. col:=RGB(pal[CurrentColor].red,pal[CurrentColor].green,pal[CurrentColor].blue);
  1336. pen:=CreatePen(PS_SOLID,1,col);
  1337. if pen=0 then
  1338. writeln('Pen konnte nicht erzeugt werden!');
  1339. oldpen:=SelectObject(windc,pen);
  1340. MoveToEx(windc,x1,y1,nil);
  1341. Windows.LineTo(windc,x2,y2);
  1342. SetPixel(windc,x2,y2,col);
  1343. SelectObject(windc,oldpen);
  1344. oldpen:=SelectObject(bitmapdc,pen);
  1345. MoveToEx(bitmapdc,x1,y1,nil);
  1346. Windows.LineTo(bitmapdc,x2,y2);
  1347. SetPixel(bitmapdc,x2,y2,col);
  1348. SelectObject(bitmapdc,oldpen);
  1349. DeleteObject(pen);
  1350. {
  1351. if currentwritemode<>normalput then
  1352. begin
  1353. SetROP2(windc,R2_COPYPEN);
  1354. SetROP2(bitmapdc,R2_COPYPEN);
  1355. end;
  1356. }
  1357. LeaveCriticalSection(graphdrawing);
  1358. end
  1359. else
  1360. { Thick width lines }
  1361. begin
  1362. { Draw the pixels }
  1363. for i := 1 to numpixels do
  1364. begin
  1365. { all depending on the slope, we can determine }
  1366. { in what direction the extra width pixels will be put }
  1367. If Flag then
  1368. Begin
  1369. DirectPutPixelClip(x-1,y);
  1370. DirectPutPixelClip(x,y);
  1371. DirectPutPixelClip(x+1,y);
  1372. end
  1373. else
  1374. Begin
  1375. DirectPutPixelClip(x, y-1);
  1376. DirectPutPixelClip(x, y);
  1377. DirectPutPixelClip(x, y+1);
  1378. end;
  1379. if d < 0 then
  1380. begin
  1381. d := d + dinc1;
  1382. x := x + xinc1;
  1383. y := y + yinc1;
  1384. end
  1385. else
  1386. begin
  1387. d := d + dinc2;
  1388. x := x + xinc2;
  1389. y := y + yinc2;
  1390. end;
  1391. end;
  1392. end;
  1393. end;
  1394. end
  1395. else
  1396. {******************************************}
  1397. { begin patterned lines }
  1398. {******************************************}
  1399. Begin
  1400. { Convert to global coordinates. }
  1401. x1 := x1 + StartXViewPort;
  1402. x2 := x2 + StartXViewPort;
  1403. y1 := y1 + StartYViewPort;
  1404. y2 := y2 + StartYViewPort;
  1405. { if fully clipped then exit... }
  1406. if ClipPixels then
  1407. begin
  1408. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  1409. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  1410. exit;
  1411. end;
  1412. OldCurrentColor := CurrentColor;
  1413. PixelCount:=0;
  1414. if y1 = y2 then
  1415. Begin
  1416. { Check if we must swap }
  1417. if x1 >= x2 then
  1418. Begin
  1419. swtmp := x1;
  1420. x1 := x2;
  1421. x2 := swtmp;
  1422. end;
  1423. if LineInfo.Thickness = NormWidth then
  1424. Begin
  1425. for PixelCount:=x1 to x2 do
  1426. { optimization: PixelCount mod 16 }
  1427. if LinePatterns[PixelCount and 15] = TRUE then
  1428. begin
  1429. DirectPutPixel(PixelCount,y2);
  1430. end;
  1431. end
  1432. else
  1433. Begin
  1434. for i:=-1 to 1 do
  1435. Begin
  1436. for PixelCount:=x1 to x2 do
  1437. { Optimization from Thomas - mod 16 = and 15 }
  1438. {this optimization has been performed by the compiler
  1439. for while as well (JM)}
  1440. if LinePatterns[PixelCount and 15] = TRUE then
  1441. begin
  1442. DirectPutPixelClip(PixelCount,y2+i);
  1443. end;
  1444. end;
  1445. end;
  1446. end
  1447. else
  1448. if x1 = x2 then
  1449. Begin
  1450. { Check if we must swap }
  1451. if y1 >= y2 then
  1452. Begin
  1453. swtmp := y1;
  1454. y1 := y2;
  1455. y2 := swtmp;
  1456. end;
  1457. if LineInfo.Thickness = NormWidth then
  1458. Begin
  1459. for PixelCount:=y1 to y2 do
  1460. { compare if we should plot a pixel here , compare }
  1461. { with predefined line patterns... }
  1462. if LinePatterns[PixelCount and 15] = TRUE then
  1463. begin
  1464. DirectPutPixel(x1,PixelCount);
  1465. end;
  1466. end
  1467. else
  1468. Begin
  1469. for i:=-1 to 1 do
  1470. Begin
  1471. for PixelCount:=y1 to y2 do
  1472. { compare if we should plot a pixel here , compare }
  1473. { with predefined line patterns... }
  1474. if LinePatterns[PixelCount and 15] = TRUE then
  1475. begin
  1476. DirectPutPixelClip(x1+i,PixelCount);
  1477. end;
  1478. end;
  1479. end;
  1480. end
  1481. else
  1482. Begin
  1483. oldCurrentColor := CurrentColor;
  1484. { Calculate deltax and deltay for initialisation }
  1485. deltax := abs(x2 - x1);
  1486. deltay := abs(y2 - y1);
  1487. { Initialize all vars based on which is the independent variable }
  1488. if deltax >= deltay then
  1489. begin
  1490. Flag := FALSE;
  1491. { x is independent variable }
  1492. numpixels := deltax + 1;
  1493. d := (2 * deltay) - deltax;
  1494. dinc1 := deltay Shl 1;
  1495. dinc2 := (deltay - deltax) shl 1;
  1496. xinc1 := 1;
  1497. xinc2 := 1;
  1498. yinc1 := 0;
  1499. yinc2 := 1;
  1500. end
  1501. else
  1502. begin
  1503. Flag := TRUE;
  1504. { y is independent variable }
  1505. numpixels := deltay + 1;
  1506. d := (2 * deltax) - deltay;
  1507. dinc1 := deltax Shl 1;
  1508. dinc2 := (deltax - deltay) shl 1;
  1509. xinc1 := 0;
  1510. xinc2 := 1;
  1511. yinc1 := 1;
  1512. yinc2 := 1;
  1513. end;
  1514. { Make sure x and y move in the right directions }
  1515. if x1 > x2 then
  1516. begin
  1517. xinc1 := - xinc1;
  1518. xinc2 := - xinc2;
  1519. end;
  1520. if y1 > y2 then
  1521. begin
  1522. yinc1 := - yinc1;
  1523. yinc2 := - yinc2;
  1524. end;
  1525. { Start drawing at <x1, y1> }
  1526. x := x1;
  1527. y := y1;
  1528. If LineInfo.Thickness=ThickWidth then
  1529. Begin
  1530. TmpNumPixels := NumPixels-1;
  1531. { Draw the pixels }
  1532. for i := 0 to TmpNumPixels do
  1533. begin
  1534. { all depending on the slope, we can determine }
  1535. { in what direction the extra width pixels will be put }
  1536. If Flag then
  1537. Begin
  1538. { compare if we should plot a pixel here , compare }
  1539. { with predefined line patterns... }
  1540. if LinePatterns[i and 15] = TRUE then
  1541. begin
  1542. DirectPutPixelClip(x-1,y);
  1543. DirectPutPixelClip(x,y);
  1544. DirectPutPixelClip(x+1,y);
  1545. end;
  1546. end
  1547. else
  1548. Begin
  1549. { compare if we should plot a pixel here , compare }
  1550. { with predefined line patterns... }
  1551. if LinePatterns[i and 15] = TRUE then
  1552. begin
  1553. DirectPutPixelClip(x,y-1);
  1554. DirectPutPixelClip(x,y);
  1555. DirectPutPixelClip(x,y+1);
  1556. end;
  1557. end;
  1558. if d < 0 then
  1559. begin
  1560. d := d + dinc1;
  1561. x := x + xinc1;
  1562. y := y + yinc1;
  1563. end
  1564. else
  1565. begin
  1566. d := d + dinc2;
  1567. x := x + xinc2;
  1568. y := y + yinc2;
  1569. end;
  1570. end;
  1571. end
  1572. else
  1573. Begin
  1574. { instead of putting in loop , substract by one now }
  1575. TmpNumPixels := NumPixels-1;
  1576. { NormWidth }
  1577. for i := 0 to TmpNumPixels do
  1578. begin
  1579. if LinePatterns[i and 15] = TRUE then
  1580. begin
  1581. DirectPutPixel(x,y);
  1582. end;
  1583. if d < 0 then
  1584. begin
  1585. d := d + dinc1;
  1586. x := x + xinc1;
  1587. y := y + yinc1;
  1588. end
  1589. else
  1590. begin
  1591. d := d + dinc2;
  1592. x := x + xinc2;
  1593. y := y + yinc2;
  1594. end;
  1595. end;
  1596. end
  1597. end;
  1598. {******************************************}
  1599. { end patterned lines }
  1600. {******************************************}
  1601. { restore color }
  1602. CurrentColor:=OldCurrentColor;
  1603. end;
  1604. end;
  1605. end; { Line }
  1606. { multipage support could be done by using more than one background bitmap }
  1607. procedure SetVisualWin32GUI(page: word);
  1608. begin
  1609. end;
  1610. procedure SetActiveWin32GUI(page: word);
  1611. begin
  1612. end;
  1613. function queryadapterinfo : pmodeinfo;
  1614. var
  1615. mode: TModeInfo;
  1616. ScreenWidth,ScreenHeight : longint;
  1617. ScreenWidthMaximized,ScreenHeightMaximized : longint;
  1618. procedure SetupWin32GUIDefault;
  1619. begin
  1620. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
  1621. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
  1622. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
  1623. mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
  1624. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
  1625. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
  1626. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
  1627. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
  1628. mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
  1629. mode.OuttextXY:={$ifdef fpc}@{$endif}OuttextXYWin32GUI;
  1630. mode.VLine := {$ifdef fpc}@{$endif}VLine16Win32GUI;
  1631. // mode.circle := {$ifdef fpc}@{$endif}Circle16Win32GUI;
  1632. // doesn't work yet
  1633. // mode.Line:={$ifdef fpc}@{$endif}LineWin32GUI;
  1634. end;
  1635. begin
  1636. SaveVideoState:=savestate;
  1637. RestoreVideoState:=restorestate;
  1638. { we must take care of the border and caption }
  1639. ScreenWidth:=GetSystemMetrics(SM_CXSCREEN)-
  1640. 2*GetSystemMetrics(SM_CXFRAME);
  1641. ScreenHeight:=GetSystemMetrics(SM_CYSCREEN)-
  1642. 2*GetSystemMetrics(SM_CYFRAME)-
  1643. GetSystemMetrics(SM_CYCAPTION);
  1644. { for maximozed windows it's again different }
  1645. { here we've only a caption }
  1646. ScreenWidthMaximized:=GetSystemMetrics(SM_CXFULLSCREEN);
  1647. { neither GetSystemMetrics(SM_CYFULLSCREEN nor }
  1648. { SystemParametersInfo(SPI_GETWORKAREA) }
  1649. { takes a hidden try into account :( FK }
  1650. ScreenHeightMaximized:=GetSystemMetrics(SM_CYFULLSCREEN);
  1651. QueryAdapterInfo := ModeList;
  1652. { If the mode listing already exists... }
  1653. { simply return it, without changing }
  1654. { anything... }
  1655. if assigned(ModeList) then
  1656. exit;
  1657. { the first one becomes the standard mode }
  1658. if (ScreenWidth>=640) and (ScreenHeight>=480) then
  1659. begin
  1660. InitMode(mode);
  1661. mode.DriverNumber:= VGA;
  1662. mode.HardwarePages:= 0;
  1663. mode.ModeNumber:=VGAHi;
  1664. mode.ModeName:='640 x 480 x 16 Win32GUI';
  1665. mode.MaxColor := 16;
  1666. mode.PaletteSize := mode.MaxColor;
  1667. mode.DirectColor := FALSE;
  1668. mode.MaxX := 639;
  1669. mode.MaxY := 479;
  1670. SetupWin32GUIDefault;
  1671. mode.XAspect := 10000;
  1672. mode.YAspect := 10000;
  1673. AddMode(mode);
  1674. end;
  1675. if (ScreenWidth>=640) and (ScreenHeight>=200) then
  1676. begin
  1677. InitMode(mode);
  1678. { now add all standard VGA modes... }
  1679. mode.DriverNumber:= VGA;
  1680. mode.HardwarePages:= 0;
  1681. mode.ModeNumber:=VGALo;
  1682. mode.ModeName:='640 x 200 x 16 Win32GUI';
  1683. mode.MaxColor := 16;
  1684. mode.PaletteSize := mode.MaxColor;
  1685. mode.DirectColor := FALSE;
  1686. mode.MaxX := 639;
  1687. mode.MaxY := 199;
  1688. SetupWin32GUIDefault;
  1689. mode.XAspect := 10000;
  1690. mode.YAspect := 10000;
  1691. AddMode(mode);
  1692. end;
  1693. if (ScreenWidth>=640) and (ScreenHeight>=350) then
  1694. begin
  1695. InitMode(mode);
  1696. mode.DriverNumber:= VGA;
  1697. mode.HardwarePages:= 0;
  1698. mode.ModeNumber:=VGAMed;
  1699. mode.ModeName:='640 x 350 x 16 Win32GUI';
  1700. mode.MaxColor := 16;
  1701. mode.PaletteSize := mode.MaxColor;
  1702. mode.DirectColor := FALSE;
  1703. mode.MaxX := 639;
  1704. mode.MaxY := 349;
  1705. SetupWin32GUIDefault;
  1706. mode.XAspect := 10000;
  1707. mode.YAspect := 10000;
  1708. AddMode(mode);
  1709. end;
  1710. if (ScreenWidth>=640) and (ScreenHeight>=400) then
  1711. begin
  1712. InitMode(mode);
  1713. mode.DriverNumber:= VESA;
  1714. mode.HardwarePages:= 0;
  1715. mode.ModeNumber:=m640x400x256;
  1716. mode.ModeName:='640 x 400 x 256 Win32GUI';
  1717. mode.MaxColor := 256;
  1718. mode.PaletteSize := mode.MaxColor;
  1719. mode.DirectColor := FALSE;
  1720. mode.MaxX := 639;
  1721. mode.MaxY := 399;
  1722. SetupWin32GUIDefault;
  1723. mode.XAspect := 10000;
  1724. mode.YAspect := 10000;
  1725. AddMode(mode);
  1726. end;
  1727. if (ScreenWidth>=640) and (ScreenHeight>=480) then
  1728. begin
  1729. InitMode(mode);
  1730. mode.DriverNumber:= VESA;
  1731. mode.HardwarePages:= 0;
  1732. mode.ModeNumber:=m640x480x256;
  1733. mode.ModeName:='640 x 480 x 256 Win32GUI';
  1734. mode.MaxColor := 256;
  1735. mode.PaletteSize := mode.MaxColor;
  1736. mode.DirectColor := FALSE;
  1737. mode.MaxX := 639;
  1738. mode.MaxY := 479;
  1739. SetupWin32GUIDefault;
  1740. mode.XAspect := 10000;
  1741. mode.YAspect := 10000;
  1742. AddMode(mode);
  1743. end;
  1744. { add 800x600 only if screen is large enough }
  1745. If (ScreenWidth>=800) and (ScreenHeight>=600) then
  1746. begin
  1747. InitMode(mode);
  1748. mode.DriverNumber:= VESA;
  1749. mode.HardwarePages:= 0;
  1750. mode.ModeNumber:=m800x600x16;
  1751. mode.ModeName:='800 x 600 x 16 Win32GUI';
  1752. mode.MaxColor := 16;
  1753. mode.PaletteSize := mode.MaxColor;
  1754. mode.DirectColor := FALSE;
  1755. mode.MaxX := 799;
  1756. mode.MaxY := 599;
  1757. SetupWin32GUIDefault;
  1758. mode.XAspect := 10000;
  1759. mode.YAspect := 10000;
  1760. AddMode(mode);
  1761. InitMode(mode);
  1762. mode.DriverNumber:= VESA;
  1763. mode.HardwarePages:= 0;
  1764. mode.ModeNumber:=m800x600x256;
  1765. mode.ModeName:='800 x 600 x 256 Win32GUI';
  1766. mode.MaxColor := 256;
  1767. mode.PaletteSize := mode.MaxColor;
  1768. mode.DirectColor := FALSE;
  1769. mode.MaxX := 799;
  1770. mode.MaxY := 599;
  1771. SetupWin32GUIDefault;
  1772. mode.XAspect := 10000;
  1773. mode.YAspect := 10000;
  1774. AddMode(mode);
  1775. end;
  1776. { add 1024x768 only if screen is large enough }
  1777. If (ScreenWidth>=1024) and (ScreenHeight>=768) then
  1778. begin
  1779. InitMode(mode);
  1780. mode.DriverNumber:= VESA;
  1781. mode.HardwarePages:= 0;
  1782. mode.ModeNumber:=m1024x768x16;
  1783. mode.ModeName:='1024 x 768 x 16 Win32GUI';
  1784. mode.MaxColor := 16;
  1785. mode.PaletteSize := mode.MaxColor;
  1786. mode.DirectColor := FALSE;
  1787. mode.MaxX := 1023;
  1788. mode.MaxY := 767;
  1789. SetupWin32GUIDefault;
  1790. mode.XAspect := 10000;
  1791. mode.YAspect := 10000;
  1792. AddMode(mode);
  1793. InitMode(mode);
  1794. mode.DriverNumber:= VESA;
  1795. mode.HardwarePages:= 0;
  1796. mode.ModeNumber:=m1024x768x256;
  1797. mode.ModeName:='1024 x 768 x 256 Win32GUI';
  1798. mode.MaxColor := 256;
  1799. mode.PaletteSize := mode.MaxColor;
  1800. mode.DirectColor := FALSE;
  1801. mode.MaxX := 1023;
  1802. mode.MaxY := 768;
  1803. SetupWin32GUIDefault;
  1804. mode.XAspect := 10000;
  1805. mode.YAspect := 10000;
  1806. AddMode(mode);
  1807. end;
  1808. { add 1280x1024 only if screen is large enough }
  1809. If (ScreenWidth>=1280) and (ScreenHeight>=1024) then
  1810. begin
  1811. InitMode(mode);
  1812. mode.DriverNumber:= VESA;
  1813. mode.HardwarePages:= 0;
  1814. mode.ModeNumber:=m1280x1024x16;
  1815. mode.ModeName:='1280 x 1024 x 16 Win32GUI';
  1816. mode.MaxColor := 16;
  1817. mode.PaletteSize := mode.MaxColor;
  1818. mode.DirectColor := FALSE;
  1819. mode.MaxX := 1279;
  1820. mode.MaxY := 1023;
  1821. SetupWin32GUIDefault;
  1822. mode.XAspect := 10000;
  1823. mode.YAspect := 10000;
  1824. AddMode(mode);
  1825. InitMode(mode);
  1826. mode.DriverNumber:= VESA;
  1827. mode.HardwarePages:= 0;
  1828. mode.ModeNumber:=m1280x1024x256;
  1829. mode.ModeName:='1280 x 1024 x 256 Win32GUI';
  1830. mode.MaxColor := 256;
  1831. mode.PaletteSize := mode.MaxColor;
  1832. mode.DirectColor := FALSE;
  1833. mode.MaxX := 1279;
  1834. mode.MaxY := 1023;
  1835. SetupWin32GUIDefault;
  1836. mode.XAspect := 10000;
  1837. mode.YAspect := 10000;
  1838. AddMode(mode);
  1839. end;
  1840. { at least we add a mode with the largest possible window }
  1841. InitMode(mode);
  1842. mode.DriverNumber:= VESA;
  1843. mode.HardwarePages:= 0;
  1844. mode.ModeNumber:=mLargestWindow16;
  1845. mode.ModeName:='Largest Window x 16';
  1846. mode.MaxColor := 16;
  1847. mode.PaletteSize := mode.MaxColor;
  1848. mode.DirectColor := FALSE;
  1849. mode.MaxX := ScreenWidth-1;
  1850. mode.MaxY := ScreenHeight-1;
  1851. SetupWin32GUIDefault;
  1852. mode.XAspect := 10000;
  1853. mode.YAspect := 10000;
  1854. AddMode(mode);
  1855. InitMode(mode);
  1856. mode.DriverNumber:= VESA;
  1857. mode.HardwarePages:= 0;
  1858. mode.ModeNumber:=mLargestWindow256;
  1859. mode.ModeName:='Largest Window x 256';
  1860. mode.MaxColor := 256;
  1861. mode.PaletteSize := mode.MaxColor;
  1862. mode.DirectColor := FALSE;
  1863. mode.MaxX := ScreenWidth-1;
  1864. mode.MaxY := ScreenHeight-1;
  1865. SetupWin32GUIDefault;
  1866. mode.XAspect := 10000;
  1867. mode.YAspect := 10000;
  1868. AddMode(mode);
  1869. { .. and a maximized window }
  1870. InitMode(mode);
  1871. mode.DriverNumber:= VESA;
  1872. mode.HardwarePages:= 0;
  1873. mode.ModeNumber:=mMaximizedWindow16;
  1874. mode.ModeName:='Maximized Window x 16';
  1875. mode.MaxColor := 16;
  1876. mode.PaletteSize := mode.MaxColor;
  1877. mode.DirectColor := FALSE;
  1878. mode.MaxX := ScreenWidthMaximized-1;
  1879. mode.MaxY := ScreenHeightMaximized-1;
  1880. SetupWin32GUIDefault;
  1881. mode.XAspect := 10000;
  1882. mode.YAspect := 10000;
  1883. AddMode(mode);
  1884. InitMode(mode);
  1885. mode.DriverNumber:= VESA;
  1886. mode.HardwarePages:= 0;
  1887. mode.ModeNumber:=mMaximizedWindow256;
  1888. mode.ModeName:='Maximized Window x 256';
  1889. mode.MaxColor := 256;
  1890. mode.PaletteSize := mode.MaxColor;
  1891. mode.DirectColor := FALSE;
  1892. mode.MaxX := ScreenWidthMaximized-1;
  1893. mode.MaxY := ScreenHeightMaximized-1;
  1894. SetupWin32GUIDefault;
  1895. mode.XAspect := 10000;
  1896. mode.YAspect := 10000;
  1897. AddMode(mode);
  1898. end;
  1899. begin
  1900. InitializeGraph;
  1901. end.
  1902. {
  1903. $Log$
  1904. Revision 1.2 2000-07-13 11:33:57 michael
  1905. + removed logs
  1906. }