graph.pp 78 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1993,99 by the Free Pascal development team
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. Unit Graph;
  11. {-------------------------------------------------------}
  12. { Differences with TP Graph unit: }
  13. { - default putimage and getimage only support a max. }
  14. { of 64K colors on screen, because all pixels are }
  15. { saved as words. }
  16. { - Set RGB Palette is not used, SetPalette must be }
  17. { used instead. }
  18. { - In the TP graph unit, Clipping is always performed }
  19. { on strings written with OutText, and this clipping }
  20. { is done on a character per character basis (for }
  21. { example, if ONE part of a character is outside the }
  22. { viewport , then that character is not written at }
  23. { all to the screen. In FPC Pascal, clipping is done }
  24. { on a PIXEL basis, not a character basis, so part of }
  25. { characters which are not entirely in the viewport }
  26. { may appear on the screen. }
  27. { - SetTextStyle only conforms to the TP version when }
  28. { the correct (and expected) values are used for }
  29. { CharSize for stroked fonts (4 = stroked fonts) }
  30. { - InstallUserDriver is not supported, so always }
  31. { returns an error. }
  32. { - RegisterBGIDriver is not supported, so always }
  33. { returns an error. }
  34. { - DrawPoly XORPut mode is not exactly the same as in }
  35. { the TP graph unit. }
  36. { - FillEllipse does not support XORPut mode with a }
  37. { bounded FloodFill. Mode is always CopyPut mode. }
  38. { - Imagesize returns a longint instead of a word }
  39. { - ImageSize cannot return an error value }
  40. {-------------------------------------------------------}
  41. { AUTHORS: }
  42. { Gernot Tenchio - original version }
  43. { Florian Klaempfl - major updates }
  44. { Pierre Mueller - major bugfixes }
  45. { Carl Eric Codere - complete rewrite }
  46. { Thomas Schatzl - optimizations,routines and }
  47. { Credits (external): suggestions. }
  48. { - Original FloodFill code by }
  49. { Menno Victor van der star }
  50. { (the code has been heavily modified) }
  51. {-------------------------------------------------------}
  52. {-------------------------------------------------------}
  53. { For significant speed improvements , is is recommended }
  54. { that these routines be hooked (otherwise the default, }
  55. { slower routines will be used) : }
  56. { HLine() }
  57. { VLine() }
  58. { PatternLine() }
  59. { ClearViewPort() }
  60. { PutImage() }
  61. { GetImage() - ImageSize() should also be changed }
  62. { InternalEllipse() }
  63. { Line() }
  64. { GetScanLine() }
  65. {--------------------------------------------------------}
  66. { FPC unit requirements: }
  67. { All modes should at least have 1 graphics page to }
  68. { make it possible to create animation on all supported }
  69. { systems , this can be done either by double-buffering }
  70. { yourself in the heap if no hardware is available to do}
  71. { it. }
  72. {--------------------------------------------------------}
  73. { COMPATIBILITY WARNING: Some of the compatibility tests }
  74. { were done using the CGA and other the VGA drivers. }
  75. { Within the BGI drivers themselves the BEHAVIOUR is not }
  76. { the same, so be warned!!! }
  77. {--------------------------------------------------------}
  78. { History log: }
  79. { 15th February 1999: }
  80. { + Added support for system font in vertical mode }
  81. { + system font is now available for all platforms }
  82. { * font support routines now compile }
  83. { * textHeight would not return correct size for system }
  84. { font }
  85. { * Alignment of fonts partly fixed }
  86. { 17th Feb. 1999: }
  87. { + First support for stroked fonts }
  88. { 18th Feb. 1999: }
  89. { * bugfix of line drawing which fixes stroked font }
  90. { displays. }
  91. { 23rd Feb. 1999: }
  92. { + Applied Pierre's patches to font }
  93. { + Added scaling of bitmapped fonts }
  94. { + Vertical stroked fonts }
  95. { 24th Feb. 1999: }
  96. { * Scaling of stroked fonts must be done using FPs }
  97. { to be 100% compatible with turbo pascal }
  98. { + Sped up by 40% stroked font scaling calculations }
  99. { + RegisterBGIFont }
  100. { 9th march 1999: }
  101. { + Starting implementing Fillpoly() }
  102. { 15th march 1999: }
  103. { + SetFillStyle() }
  104. { + patternLine() }
  105. { + Bar() }
  106. { * GraphDefaults would not make the Default color }
  107. { of the fill pattern to the Max. Palette entry. }
  108. { + SetFillPattern() }
  109. { 20th march 1999: }
  110. { * GraphDefaults would not reset to the text system }
  111. { * DefaultFont would write one character too much to }
  112. { the screen }
  113. { + Sloped thick lines in Line() }
  114. { + Sloped patterned lines in Line() }
  115. { * GraphDefaults would not reset the User Fill pattern}
  116. { to $ff }
  117. { + DirectPutPixel takes care of XOR mode writes }
  118. { improves speed by about 30% over old method of }
  119. { GetPixel XOR CurrentColor }
  120. { * Dashed LineStyle exactly like BP version now }
  121. { + Center LineStyle (checked against CGA driver) }
  122. { * GraphDefaults() now resets linepattern array }
  123. { 1st april 1999: }
  124. { + First implementation of FillPoly (incomplete) }
  125. { 2nd april 1999: }
  126. { * FillPoly did not Reset PatternLine index }
  127. { * FillPoly did not use correct color }
  128. { * PatternLine was writing modes in reverse direction }
  129. { * PatternLine would not work with non-rectangular }
  130. { shapes. }
  131. { * PatternLine must fill up the ENTIRE pattern, }
  132. { with either the foreground or background color. }
  133. { * GraphDefaults() would not call SetBkColor() }
  134. { * Fixed some memory leaks in FillPoly() }
  135. { 11th April 1999: }
  136. { * PatternLine() was drawing one pixel less then }
  137. { requested }
  138. { 12th April 1999: }
  139. { + FloodFill - first working implementation }
  140. { Horrbly slow even on very fast cpu's }
  141. { + Some suggestions of Thomas implemented }
  142. { 13th April 1999: }
  143. { * FloodFill() vertical index was off by one pixel }
  144. { * FloodFill() would never draw the last line in the }
  145. { list }
  146. { - Removed ClearViewPort320 which was wrong anyways, }
  147. { will need to be implemented later. }
  148. { * PatternLine() would not always restore write mode }
  149. { + Circle() uses NormalPut always with NormWidth lines}
  150. { + FillEllipse() initial version }
  151. { * InternalEllipse() - 0 to 360 now supported as }
  152. { angles. }
  153. { 14th April 1999: }
  154. { * mod x = and (x-1)(from Thomas Schatzl) gives a }
  155. { significant speed improvement. }
  156. { 15th april 1999: }
  157. { + Arc() ok except for Aspect Ratio, which does not }
  158. { give us the correct ratio on a 320x200 screen. }
  159. { + Added FillPoly() from Thomas Schatzl }
  160. { + More hookable routines }
  161. { 16th april 1999: }
  162. { + Line() checked ok. }
  163. { 17th april 1999: }
  164. { * GraphDefaults() would not reset CP }
  165. { + GetX(), GetY(), MoveTo() checked for viewports }
  166. { * OutTextXY() should not update the CP }
  167. { * ClearViewPort() would not update the CP }
  168. { * ClearDevice() would not update the CP }
  169. { * Sector() would update the CP by calling LineTo }
  170. { * Bar3D() would update the CP }
  171. { * PieSlice() would update the CP }
  172. { 18th april 1999: }
  173. { + Clipping algorithm }
  174. { 19th april 1999: }
  175. { + Adapterinfo structure }
  176. { 20th april 1999: }
  177. { + GetModeName }
  178. { + GetGraphMode }
  179. { + GetModeRange }
  180. {--------------------------------------------------------}
  181. { LEFT TO DO: }
  182. { - optimize scaling of stroked fonts }
  183. { - optimize InternalEllipse() }
  184. { using linear appx. of sine/cosine tables }
  185. { - justification for stroked fonts does not work }
  186. { - On Closegraph deallocate all font pointers }
  187. {--------------------------------------------------------}
  188. { text.inc will crash on aligned requirement machines. }
  189. { (packed record for fontrec) }
  190. {$G+}
  191. Interface
  192. const
  193. { error codes }
  194. grOk = 0;
  195. grNoInitGraph = -1;
  196. grNotDetected = -2;
  197. grFileNotFound = -3;
  198. grInvalidDriver = -4;
  199. grNoLoadMem = -5;
  200. grNoScanMem = -6;
  201. grNoFloodMem = -7;
  202. grFontNotFound = -8;
  203. grNoFontMem = -9;
  204. grInvalidMode = -10;
  205. grError = -11;
  206. grIOerror = -12;
  207. grInvalidFont = -13;
  208. grInvalidFontNum = -14;
  209. grInvalidVersion = -18;
  210. { Color constants for setpalette }
  211. black = 0;
  212. blue = 1;
  213. green = 2;
  214. cyan = 3;
  215. red = 4;
  216. magenta = 5;
  217. brown = 6;
  218. lightgray = 7;
  219. darkgray = 8;
  220. lightblue = 9;
  221. lightgreen = 10;
  222. lightcyan = 11;
  223. lightred = 12;
  224. lightmagenta = 13;
  225. yellow = 14;
  226. white = 15;
  227. EGABlack = 0;
  228. EGABlue = 1;
  229. EGAGreen = 2;
  230. EGACyan = 3;
  231. EGARed = 4;
  232. EGAMagenta = 5;
  233. EGALightgray= 7;
  234. EGABrown = 20;
  235. EGADarkgray = 56;
  236. EGALightblue = 57;
  237. EGALightgreen = 58;
  238. EGALightcyan = 59;
  239. EGALightred = 60;
  240. EGALightmagenta=61;
  241. EGAYellow = 62;
  242. EGAWhite = 63;
  243. { Line styles for GetLineStyle/SetLineStyle }
  244. SolidLn = 0;
  245. DottedLn = 1;
  246. CenterLn = 2;
  247. DashedLn = 3;
  248. UserBitLn = 4;
  249. NormWidth = 1;
  250. ThickWidth = 3;
  251. { Set/GetTextStyle Konstanten: }
  252. DefaultFont = 0;
  253. TriplexFont = 1;
  254. SmallFont = 2;
  255. SansSerifFont = 3;
  256. GothicFont = 4;
  257. ScriptFont = 5;
  258. SimpleFont = 6;
  259. TSCRFont = 7;
  260. LCOMFont = 8;
  261. EuroFont = 9;
  262. BoldFont = 10;
  263. HorizDir = 0;
  264. VertDir = 1;
  265. UserCharSize = 0;
  266. ClipOn = true;
  267. ClipOff = false;
  268. { Bar3D constants }
  269. TopOn = true;
  270. TopOff = false;
  271. { fill pattern for Get/SetFillStyle: }
  272. EmptyFill = 0;
  273. SolidFill = 1;
  274. LineFill = 2;
  275. LtSlashFill = 3;
  276. SlashFill = 4;
  277. BkSlashFill = 5;
  278. LtBkSlashFill = 6;
  279. HatchFill = 7;
  280. XHatchFill = 8;
  281. InterleaveFill = 9;
  282. WideDotFill = 10;
  283. CloseDotFill = 11;
  284. UserFill = 12;
  285. { bitblt operators }
  286. NormalPut = 0;
  287. CopyPut = 0;
  288. XORPut = 1;
  289. OrPut = 2;
  290. AndPut = 3;
  291. NotPut = 4;
  292. { SetTextJustify constants }
  293. LeftText = 0;
  294. CenterText = 1;
  295. RightText = 2;
  296. BottomText = 0;
  297. TopText = 2;
  298. { graphic drivers }
  299. CurrentDriver = -128;
  300. Detect = 0;
  301. LowRes = 1;
  302. HercMono = 7;
  303. VGA = 9;
  304. VESA = 10;
  305. { graph modes }
  306. Default = 0;
  307. { VGA Driver modes }
  308. VGALo = 0;
  309. VGAMed = 1;
  310. VGAHi = 2;
  311. { Hercules mono card }
  312. HercMonoHi = 0;
  313. MaxColors = 255; { Maximum possible colors using a palette }
  314. { otherwise, direct color encoding }
  315. type
  316. RGBRec = packed record
  317. Red: integer;
  318. Green: integer;
  319. Blue : integer;
  320. end;
  321. PaletteType = record
  322. Size : longint;
  323. Colors : array[0..MaxColors] of RGBRec;
  324. end;
  325. LineSettingsType = record
  326. linestyle : word;
  327. pattern : word;
  328. thickness : word;
  329. end;
  330. TextSettingsType = record
  331. font : word;
  332. direction : word;
  333. charsize : word;
  334. horiz : word;
  335. vert : word;
  336. end;
  337. FillSettingsType = record
  338. pattern : word;
  339. color : word;
  340. end;
  341. FillPatternType = array[1..8] of byte;
  342. PointType = record
  343. x,y : integer;
  344. end;
  345. ViewPortType = record
  346. x1,y1,x2,y2 : integer;
  347. Clip : boolean;
  348. end;
  349. ArcCoordsType = record
  350. x,y : integer;
  351. xstart,ystart : integer;
  352. xend,yend : integer;
  353. end;
  354. const
  355. fillpatternTable : array[0..12] of FillPatternType = (
  356. ($00,$00,$00,$00,$00,$00,$00,$00), { background color }
  357. ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff), { foreground color }
  358. ($ff,$ff,$00,$00,$ff,$ff,$00,$00), { horizontal lines }
  359. ($01,$02,$04,$08,$10,$20,$40,$80), { slashes }
  360. ($07,$0e,$1c,$38,$70,$e0,$c1,$83), { thick slashes }
  361. ($07,$83,$c1,$e0,$70,$38,$1c,$0e), { thick backslashes }
  362. ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4), { backslashes }
  363. ($ff,$88,$88,$88,$ff,$88,$88,$88), { small boxes }
  364. ($18,$24,$42,$81,$81,$42,$24,$18), { rhombus }
  365. ($cc,$33,$cc,$33,$cc,$33,$cc,$33), { wall pattern }
  366. ($80,$00,$08,$00,$80,$00,$08,$00), { wide points }
  367. ($88,$00,$22,$00,$88,$00,$22,$00), { dense points }
  368. (0,0,0,0,0,0,0,0) { user defined line style }
  369. );
  370. { ******************** PROCEDURAL VARIABLES ********************* }
  371. { * These are hooks which have device specific stuff in them, * }
  372. { * therefore to add new modes or to redirect these routines * }
  373. { * then declare variables of these types as shown below. * }
  374. {-----------------------------------------------------------------}
  375. TYPE
  376. { This is the standard putpixel routine used by all function }
  377. { drawing routines, it will use the viewport settings, as }
  378. { well as clip, and use the current foreground color to plot }
  379. { the desired pixel. }
  380. defpixelproc = procedure(X,Y: Integer);
  381. { standard plot and get pixel }
  382. getpixelproc = function(X,Y: Integer): word;
  383. putpixelproc = procedure(X,Y: Integer; Color: Word);
  384. { clears the viewport, also used to clear the device }
  385. clrviewproc = procedure;
  386. { putimage procedure, can be hooked to accomplish transparency }
  387. putimageproc = procedure (X,Y: Integer; var Bitmap; BitBlt: Word);
  388. getimageproc = procedure(X1,Y1,X2,Y2: Integer; Var Bitmap);
  389. imagesizeproc= function (X1,Y1,X2,Y2: Integer): longint;
  390. graphfreememprc = procedure (var P: Pointer; size: word);
  391. graphgetmemprc = procedure (var P: pointer; size: word);
  392. { internal routines -- can be hooked for much faster drawing }
  393. { draw filled horizontal lines using current color }
  394. { on entry coordinates are already clipped. }
  395. hlineproc = procedure (x, x2,y : integer);
  396. { on entry coordinates are already clipped. }
  397. { draw filled vertical line using current color }
  398. vlineproc = procedure (x,y,y2: integer);
  399. { this routine is used to draw filled patterns for all routines }
  400. { that require it. (FillPoly, FloodFill, Sector, etc... }
  401. { clipping is verified, uses current Fill settings for drawing }
  402. patternlineproc = procedure (x1,x2,y: integer);
  403. { this routine is used to draw all circles/ellipses/sectors }
  404. { more info... on this later... }
  405. ellipseproc = procedure (X,Y: Integer;XRadius: word;
  406. YRadius:word; stAngle,EndAngle: word);
  407. { Line routine - draws lines thick/norm widths with current }
  408. { color and line style - LINE must be clipped here. }
  409. lineproc = procedure (X1, Y1, X2, Y2 : Integer);
  410. { this routine is used for FloodFill - it returns an entire }
  411. { screen scan line with a word for each pixel in the scanline }
  412. getscanlineproc = procedure (Y : integer; var data);
  413. { changes the active display screen where we draw to... }
  414. setactivepageproc = procedure (page: word);
  415. { changes the active display screen which we see ... }
  416. setvisualpageproc = procedure (page: word);
  417. { this routine actually switches to the desired video mode. }
  418. initmodeproc = procedure;
  419. { this routine is called to save the sate just before a mode set }
  420. savestateproc = procedure;
  421. { this routine is called in closegraph to cleanup... }
  422. restorestateproc = procedure;
  423. { This routine is a hook for SetRGBPalette }
  424. setrgbpaletteproc =
  425. procedure(ColorNum, RedValue, GreenValue, BlueValue: Integer);
  426. { This routine is a hook for GetRGBPalette }
  427. getrgbpaletteproc =
  428. procedure(ColorNum: integer; var
  429. RedValue, GreenValue, BlueValue: Integer);
  430. TYPE
  431. {-----------------------------------}
  432. { Linked list for mode information }
  433. { This list is set up by one of the }
  434. { following routines: }
  435. { It lists all available resolutions}
  436. { on this display adapter. }
  437. {-----------------------------------}
  438. { QueryAdapter() }
  439. { DetectGraph() }
  440. { InitGraph() }
  441. {-----------------------------------}
  442. PModeInfo = ^TModeInfo;
  443. TModeInfo = record
  444. DriverNumber: Integer;
  445. ModeNumber: Integer;
  446. MaxColor: Longint; { Maximum colors on screen }
  447. PaletteSize : Longint; { Maximum palette entry we can change }
  448. XAspect : Integer; { XAspect ratio correction factor }
  449. YAspect : Integer; { YAspect ratio correction factor }
  450. MaxX: Integer; { Max-X row }
  451. MaxY: Integer; { Max. column. }
  452. DirectColor: boolean; { Is this a direct color mode?? }
  453. Hardwarepages: byte; { total number of image pages - 1 }
  454. ModeName: String[18];
  455. { necessary hooks ... }
  456. DirectPutPixel : DefPixelProc;
  457. GetPixel : GetPixelProc;
  458. PutPixel : PutPixelProc;
  459. SetRGBPalette : SetRGBPaletteProc;
  460. GetRGBPalette : GetRGBPaletteProc;
  461. { defaults possible ... }
  462. SetVisualPage : SetVisualPageProc;
  463. SetActivePage : SetActivePageProc;
  464. ClearViewPort : ClrViewProc;
  465. PutImage : PutImageProc;
  466. GetImage : GetImageProc;
  467. ImageSize : ImageSizeProc;
  468. GetScanLine : GetScanLineProc;
  469. Line : LineProc;
  470. InternalEllipse: EllipseProc;
  471. PatternLine : PatternLineProc;
  472. HLine : HLineProc;
  473. VLine : VLineProc;
  474. InitMode : InitModeProc;
  475. next: PModeInfo;
  476. end;
  477. VAR
  478. DirectPutPixel : DefPixelProc;
  479. ClearViewPort : ClrViewProc;
  480. PutPixel : PutPixelProc;
  481. PutImage : PutImageProc;
  482. GetImage : GetImageProc;
  483. ImageSize : ImageSizeProc;
  484. GetPixel : GetPixelProc;
  485. SetVisualPage : SetVisualPageProc;
  486. SetActivePage : SetActivePageProc;
  487. SetRGBPalette : SetRGBPaletteProc;
  488. GetRGBPalette : GetRGBPaletteProc;
  489. GraphFreeMemPtr: graphfreememprc;
  490. GraphGetMemPtr : graphgetmemprc;
  491. GetScanLine : GetScanLineProc;
  492. Line : LineProc;
  493. InternalEllipse: EllipseProc;
  494. PatternLine : PatternLineProc;
  495. HLine : HLineProc;
  496. VLine : VLineProc;
  497. SaveVideoState : SaveStateProc;
  498. RestoreVideoState: RestoreStateProc;
  499. Procedure Closegraph;
  500. procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
  501. function GraphErrorMsg(ErrorCode: Integer): string;
  502. Function GetMaxX: Integer;
  503. Function GetMaxY: Integer;
  504. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  505. Function GraphResult: Integer;
  506. function GetModeName(ModeNumber: integer): string;
  507. procedure SetGraphMode(Mode: Integer);
  508. function GetGraphMode: Integer;
  509. function GetMaxMode: word;
  510. procedure RestoreCrtMode;
  511. procedure GetModeRange(GraphDriver: Integer; var LoMode, HiMode: Integer);
  512. Function GetX: Integer;
  513. Function GetY: Integer;
  514. procedure GraphDefaults;
  515. procedure ClearDevice;
  516. procedure GetViewSettings(var viewport : ViewPortType);
  517. procedure SetWriteMode(WriteMode : integer);
  518. procedure GetFillSettings(var Fillinfo:Fillsettingstype);
  519. procedure GetFillPattern(var FillPattern:FillPatternType);
  520. procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
  521. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
  522. function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer;
  523. function RegisterBGIDriver(driver: pointer): integer;
  524. procedure SetFillStyle(Pattern : word; Color: word);
  525. procedure SetFillPattern(Pattern: FillPatternType; Color: word);
  526. procedure MoveRel(Dx, Dy: Integer);
  527. procedure MoveTo(X,Y: Integer);
  528. procedure SetDirectVideo(DirectAccess: boolean);
  529. function GetDirectVideo: boolean;
  530. { -------------------- Color/Palette ------------------------------- }
  531. procedure SetBkColor(ColorNum: Word);
  532. function GetColor: Word;
  533. function GetBkColor: Word;
  534. procedure SetColor(Color: Word);
  535. function GetMaxColor: word;
  536. procedure SetAllPalette(var Palette:PaletteType);
  537. procedure SetPalette(ColorNum: word; Color: shortint);
  538. procedure GetPalette(var Palette: PaletteType);
  539. function GetPaletteSize: integer;
  540. procedure GetDefaultPalette(var Palette: PaletteType);
  541. { -------------------- Shapes/Lines -------------------------------- }
  542. procedure Rectangle(x1,y1,x2,y2:integer);
  543. procedure Bar(x1,y1,x2,y2:integer);
  544. procedure Bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  545. procedure FillPoly(NumPoints: word; Var PolyPoints);
  546. procedure DrawPoly(NumPoints : word;var polypoints);
  547. procedure LineRel(Dx, Dy: Integer);
  548. procedure LineTo(X,Y : Integer);
  549. procedure FloodFill(x : integer; y : integer; Border: word);
  550. { -------------------- Circle related routines --------------------- }
  551. procedure GetAspectRatio(var Xasp,Yasp : word);
  552. procedure SetAspectRatio(Xasp, Yasp : word);
  553. procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  554. procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
  555. procedure PieSlice(X,Y,stangle,endAngle:integer;Radius: Word);
  556. procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  557. procedure Circle(X, Y: Integer; Radius:Word);
  558. procedure Sector(x, y: Integer; StAngle,EndAngle, XRadius, YRadius: Word);
  559. procedure Ellipse(X,Y : Integer; stAngle, EndAngle: word; XRadius,
  560. YRadius: word);
  561. { --------------------- Text related routines --------------------- }
  562. function InstallUserFont(const FontFileName : string) : integer;
  563. function RegisterBGIfont(font : pointer) : integer;
  564. procedure GetTextSettings(var TextInfo : TextSettingsType);
  565. function TextHeight(const TextString : string) : word;
  566. function TextWidth(const TextString : string) : word;
  567. procedure SetTextJustify(horiz,vert : word);
  568. procedure SetTextStyle(font,direction : word;charsize : word);
  569. procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
  570. procedure OutTextXY(x,y : integer;const TextString : string);
  571. procedure OutText(const TextString : string);
  572. Implementation
  573. {$IFDEF DPMI}
  574. uses WinAPI;
  575. {$ENDIF}
  576. const
  577. StdBufferSize = 4096; { Buffer size for FloodFill }
  578. type
  579. tinttable = array[0..8192] of integer;
  580. pinttable = ^tinttable;
  581. WordArray = Array [0..StdbufferSize] Of word;
  582. PWordArray = ^WordArray;
  583. const
  584. { Mask for each bit in byte used to determine pattern }
  585. BitArray: Array[0..7] of byte =
  586. ($01,$02,$04,$08,$10,$20,$40,$80);
  587. RevbitArray: Array[0..7] of byte =
  588. ($80,$40,$20,$10,$08,$04,$02,$01);
  589. { pre expanded line patterns }
  590. { 0 = LSB of byte pattern }
  591. { 15 = MSB of byte pattern }
  592. LinePatterns: Array[0..15] of BOOLEAN =
  593. (TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,
  594. TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE);
  595. const
  596. BGIPath : string = '.';
  597. { Default font 8x8 system from IBM PC }
  598. {$i fontdata.inc}
  599. var
  600. CurrentColor: Word;
  601. CurrentBkColor: Word;
  602. CurrentX : Integer; { viewport relative }
  603. CurrentY : Integer; { viewport relative }
  604. ClipPixels: Boolean; { Should cliiping be enabled }
  605. CurrentWriteMode: Integer;
  606. _GraphResult : Integer;
  607. LineInfo : LineSettingsType;
  608. FillSettings: FillSettingsType;
  609. { information for Text Output routines }
  610. CurrentTextInfo : TextSettingsType;
  611. CurrentXRatio: Real;
  612. CurrentYRatio: Real;
  613. installedfonts: longint; { Number of installed fonts }
  614. StartXViewPort: Integer; { absolute }
  615. StartYViewPort: Integer; { absolute }
  616. ViewWidth : Integer;
  617. ViewHeight: Integer;
  618. IsGraphMode : Boolean; { Indicates if we are in graph mode or not }
  619. ArcCall: ArcCoordsType; { Information on the last call to Arc or Ellipse }
  620. var
  621. { ******************** HARDWARE INFORMATION ********************* }
  622. { Should be set in InitGraph once only. }
  623. IntCurrentMode : Integer;
  624. IntCurrentDriver : Integer; { Currently loaded driver }
  625. XAspect : Integer;
  626. YAspect : Integer;
  627. MaxX : Integer; { Maximum resolution - ABSOLUTE }
  628. MaxY : Integer; { Maximum resolution - ABSOLUTE }
  629. MaxColor : Longint;
  630. PaletteSize : longint; { Maximum palette entry we can set, usually equal}
  631. { maxcolor. }
  632. HardwarePages : byte; { maximum number of hardware visual pages }
  633. DriverName: String;
  634. DirectColor : Boolean ; { Is it a direct color mode? }
  635. ModeList : PModeInfo;
  636. DirectVideo : Boolean; { Direct access to video memory? }
  637. {--------------------------------------------------------------------------}
  638. { }
  639. { LINE AND LINE RELATED ROUTINES }
  640. { }
  641. {--------------------------------------------------------------------------}
  642. {$i clip.inc}
  643. procedure HLineDefault(x,x2,y: integer);
  644. var
  645. Col: word;
  646. xtmp: integer;
  647. Begin
  648. { must we swap the values? }
  649. if x >= x2 then
  650. Begin
  651. xtmp := x2;
  652. x2 := x;
  653. x:= xtmp;
  654. end;
  655. { First convert to global coordinates }
  656. X := X + StartXViewPort;
  657. X2 := X2 + StartXViewPort;
  658. Y := Y + StartYViewPort;
  659. if ClipPixels then
  660. Begin
  661. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  662. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  663. exit;
  664. end;
  665. for x:= x to x2 do
  666. DirectPutPixel(X,Y);
  667. end;
  668. procedure VLineDefault(x,y,y2: integer);
  669. var
  670. Col: word;
  671. ytmp: integer;
  672. Begin
  673. { must we swap the values? }
  674. if y >= y2 then
  675. Begin
  676. ytmp := y2;
  677. y2 := y;
  678. y:= ytmp;
  679. end;
  680. { First convert to global coordinates }
  681. X := X + StartXViewPort;
  682. Y2 := Y2 + StartYViewPort;
  683. Y := Y + StartYViewPort;
  684. if ClipPixels then
  685. Begin
  686. if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
  687. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  688. exit;
  689. end;
  690. for y := y to y2 do Directputpixel(x,y)
  691. End;
  692. procedure LineDefault(X1, Y1, X2, Y2: Integer);
  693. var X, Y : Integer;
  694. deltax, deltay : Integer;
  695. d, dinc1, dinc2: Integer;
  696. xinc1 : Integer;
  697. xinc2 : Integer;
  698. yinc1 : Integer;
  699. yinc2 : Integer;
  700. i, j : Integer;
  701. Flag : Boolean; { determines pixel direction in thick lines }
  702. NumPixels : Integer;
  703. PixelCount : Integer;
  704. OldCurrentColor: Word;
  705. swtmp : integer;
  706. TmpNumPixels : integer;
  707. begin
  708. {******************************************}
  709. { SOLID LINES }
  710. {******************************************}
  711. if lineinfo.LineStyle = SolidLn then
  712. Begin
  713. { we separate normal and thick width for speed }
  714. { and because it would not be 100% compatible }
  715. { with the TP graph unit otherwise }
  716. if y1 = y2 then
  717. Begin
  718. {******************************************}
  719. { SOLID LINES HORIZONTAL }
  720. {******************************************}
  721. if lineinfo.Thickness=NormWidth then
  722. hline(x1,x2,y2)
  723. else
  724. begin
  725. { thick width }
  726. hline(x1,x2,y2-1);
  727. hline(x1,x2,y2);
  728. hline(x2,x2,y2+1);
  729. end;
  730. end
  731. else
  732. if x1 = x2 then
  733. Begin
  734. {******************************************}
  735. { SOLID LINES VERTICAL }
  736. {******************************************}
  737. if lineinfo.Thickness=NormWidth then
  738. vline(x1,y1,y2)
  739. else
  740. begin
  741. { thick width }
  742. vline(x1-1,y1,y2);
  743. vline(x1,y1,y2);
  744. vline(x1+1,y1,y2);
  745. end;
  746. end
  747. else
  748. begin
  749. { Convert to global coordinates. }
  750. x1 := x1 + StartXViewPort;
  751. x2 := x2 + StartXViewPort;
  752. y1 := y1 + StartYViewPort;
  753. y2 := y2 + StartYViewPort;
  754. { if fully clipped then exit... }
  755. if ClipPixels then
  756. begin
  757. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  758. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  759. exit;
  760. end;
  761. {******************************************}
  762. { SLOPED SOLID LINES }
  763. {******************************************}
  764. oldCurrentColor := CurrentColor;
  765. { Calculate deltax and deltay for initialisation }
  766. deltax := abs(x2 - x1);
  767. deltay := abs(y2 - y1);
  768. { Initialize all vars based on which is the independent variable }
  769. if deltax >= deltay then
  770. begin
  771. Flag := FALSE;
  772. { x is independent variable }
  773. numpixels := deltax + 1;
  774. d := (2 * deltay) - deltax;
  775. dinc1 := deltay Shl 1;
  776. dinc2 := (deltay - deltax) shl 1;
  777. xinc1 := 1;
  778. xinc2 := 1;
  779. yinc1 := 0;
  780. yinc2 := 1;
  781. end
  782. else
  783. begin
  784. Flag := TRUE;
  785. { y is independent variable }
  786. numpixels := deltay + 1;
  787. d := (2 * deltax) - deltay;
  788. dinc1 := deltax Shl 1;
  789. dinc2 := (deltax - deltay) shl 1;
  790. xinc1 := 0;
  791. xinc2 := 1;
  792. yinc1 := 1;
  793. yinc2 := 1;
  794. end;
  795. { Make sure x and y move in the right directions }
  796. if x1 > x2 then
  797. begin
  798. xinc1 := - xinc1;
  799. xinc2 := - xinc2;
  800. end;
  801. if y1 > y2 then
  802. begin
  803. yinc1 := - yinc1;
  804. yinc2 := - yinc2;
  805. end;
  806. { Start drawing at <x1, y1> }
  807. x := x1;
  808. y := y1;
  809. If LineInfo.Thickness=NormWidth then
  810. Begin
  811. { Draw the pixels }
  812. for i := 1 to numpixels do
  813. begin
  814. DirectPutPixel(x, y);
  815. if d < 0 then
  816. begin
  817. d := d + dinc1;
  818. x := x + xinc1;
  819. y := y + yinc1;
  820. end
  821. else
  822. begin
  823. d := d + dinc2;
  824. x := x + xinc2;
  825. y := y + yinc2;
  826. end;
  827. CurrentColor := OldCurrentColor;
  828. end;
  829. end
  830. else
  831. { Thick width lines }
  832. begin
  833. { Draw the pixels }
  834. for i := 1 to numpixels do
  835. begin
  836. { all depending on the slope, we can determine }
  837. { in what direction the extra width pixels will be put }
  838. If Flag then
  839. Begin
  840. DirectPutPixel(x-1,y);
  841. DirectPutPixel(x,y);
  842. DirectPutPixel(x+1,y);
  843. end
  844. else
  845. Begin
  846. DirectPutPixel(x, y-1);
  847. DirectPutPixel(x, y);
  848. DirectPutPixel(x, y+1);
  849. end;
  850. if d < 0 then
  851. begin
  852. d := d + dinc1;
  853. x := x + xinc1;
  854. y := y + yinc1;
  855. end
  856. else
  857. begin
  858. d := d + dinc2;
  859. x := x + xinc2;
  860. y := y + yinc2;
  861. end;
  862. CurrentColor := OldCurrentColor;
  863. end;
  864. end;
  865. end;
  866. end
  867. else
  868. {******************************************}
  869. { begin patterned lines }
  870. {******************************************}
  871. Begin
  872. { Convert to global coordinates. }
  873. x1 := x1 + StartXViewPort;
  874. x2 := x2 + StartXViewPort;
  875. y1 := y1 + StartYViewPort;
  876. y2 := y2 + StartYViewPort;
  877. { if fully clipped then exit... }
  878. if ClipPixels then
  879. begin
  880. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  881. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  882. exit;
  883. end;
  884. OldCurrentColor := CurrentColor;
  885. PixelCount:=0;
  886. if y1 = y2 then
  887. Begin
  888. { Check if we must swap }
  889. if x1 >= x2 then
  890. Begin
  891. swtmp := x1;
  892. x1 := x2;
  893. x2 := swtmp;
  894. end;
  895. if LineInfo.Thickness = NormWidth then
  896. Begin
  897. for PixelCount:=x1 to x2 do
  898. { optimization: PixelCount mod 16 }
  899. if LinePatterns[PixelCount and 15] = TRUE then
  900. begin
  901. DirectPutPixel(PixelCount,y2);
  902. end;
  903. end
  904. else
  905. Begin
  906. for i:=-1 to 1 do
  907. Begin
  908. for PixelCount:=x1 to x2 do
  909. { Optimization from Thomas - mod 16 = and 15 }
  910. if LinePatterns[PixelCount and 15] = TRUE then
  911. begin
  912. DirectPutPixel(PixelCount,y2+i);
  913. end;
  914. end;
  915. end;
  916. end
  917. else
  918. if x1 = x2 then
  919. Begin
  920. { Check if we must swap }
  921. if y1 >= y2 then
  922. Begin
  923. swtmp := y1;
  924. y1 := y2;
  925. y2 := swtmp;
  926. end;
  927. if LineInfo.Thickness = NormWidth then
  928. Begin
  929. for PixelCount:=y1 to y2 do
  930. { compare if we should plot a pixel here , compare }
  931. { with predefined line patterns... }
  932. if LinePatterns[PixelCount and 15] = TRUE then
  933. begin
  934. DirectPutPixel(x1,PixelCount);
  935. end;
  936. end
  937. else
  938. Begin
  939. for i:=-1 to 1 do
  940. Begin
  941. for PixelCount:=y1 to y2 do
  942. { compare if we should plot a pixel here , compare }
  943. { with predefined line patterns... }
  944. if LinePatterns[PixelCount and 15] = TRUE then
  945. begin
  946. DirectPutPixel(x1+i,PixelCount);
  947. end;
  948. end;
  949. end;
  950. end
  951. else
  952. Begin
  953. oldCurrentColor := CurrentColor;
  954. { Calculate deltax and deltay for initialisation }
  955. deltax := abs(x2 - x1);
  956. deltay := abs(y2 - y1);
  957. { Initialize all vars based on which is the independent variable }
  958. if deltax >= deltay then
  959. begin
  960. Flag := FALSE;
  961. { x is independent variable }
  962. numpixels := deltax + 1;
  963. d := (2 * deltay) - deltax;
  964. dinc1 := deltay Shl 1;
  965. dinc2 := (deltay - deltax) shl 1;
  966. xinc1 := 1;
  967. xinc2 := 1;
  968. yinc1 := 0;
  969. yinc2 := 1;
  970. end
  971. else
  972. begin
  973. Flag := TRUE;
  974. { y is independent variable }
  975. numpixels := deltay + 1;
  976. d := (2 * deltax) - deltay;
  977. dinc1 := deltax Shl 1;
  978. dinc2 := (deltax - deltay) shl 1;
  979. xinc1 := 0;
  980. xinc2 := 1;
  981. yinc1 := 1;
  982. yinc2 := 1;
  983. end;
  984. { Make sure x and y move in the right directions }
  985. if x1 > x2 then
  986. begin
  987. xinc1 := - xinc1;
  988. xinc2 := - xinc2;
  989. end;
  990. if y1 > y2 then
  991. begin
  992. yinc1 := - yinc1;
  993. yinc2 := - yinc2;
  994. end;
  995. { Start drawing at <x1, y1> }
  996. x := x1;
  997. y := y1;
  998. If LineInfo.Thickness=ThickWidth then
  999. Begin
  1000. TmpNumPixels := NumPixels-1;
  1001. { Draw the pixels }
  1002. for i := 0 to TmpNumPixels do
  1003. begin
  1004. { all depending on the slope, we can determine }
  1005. { in what direction the extra width pixels will be put }
  1006. If Flag then
  1007. Begin
  1008. { compare if we should plot a pixel here , compare }
  1009. { with predefined line patterns... }
  1010. if LinePatterns[i and 15] = TRUE then
  1011. begin
  1012. DirectPutPixel(x-1,y);
  1013. DirectPutPixel(x,y);
  1014. DirectPutPixel(x+1,y);
  1015. end;
  1016. end
  1017. else
  1018. Begin
  1019. { compare if we should plot a pixel here , compare }
  1020. { with predefined line patterns... }
  1021. if LinePatterns[i and 15] = TRUE then
  1022. begin
  1023. DirectPutPixel(x,y-1);
  1024. DirectPutPixel(x,y);
  1025. DirectPutPixel(x,y+1);
  1026. end;
  1027. end;
  1028. if d < 0 then
  1029. begin
  1030. d := d + dinc1;
  1031. x := x + xinc1;
  1032. y := y + yinc1;
  1033. end
  1034. else
  1035. begin
  1036. d := d + dinc2;
  1037. x := x + xinc2;
  1038. y := y + yinc2;
  1039. end;
  1040. end;
  1041. end
  1042. else
  1043. Begin
  1044. { instead of putting in loop , substract by one now }
  1045. TmpNumPixels := NumPixels-1;
  1046. { NormWidth }
  1047. for i := 0 to TmpNumPixels do
  1048. begin
  1049. if LinePatterns[i and 15] = TRUE then
  1050. begin
  1051. DirectPutPixel(x,y);
  1052. end;
  1053. if d < 0 then
  1054. begin
  1055. d := d + dinc1;
  1056. x := x + xinc1;
  1057. y := y + yinc1;
  1058. end
  1059. else
  1060. begin
  1061. d := d + dinc2;
  1062. x := x + xinc2;
  1063. y := y + yinc2;
  1064. end;
  1065. end;
  1066. end
  1067. end;
  1068. {******************************************}
  1069. { end patterned lines }
  1070. {******************************************}
  1071. { restore color }
  1072. CurrentColor:=OldCurrentColor;
  1073. end;
  1074. end; { Line }
  1075. {********************************************************}
  1076. { Procedure InternalEllipse() }
  1077. {--------------------------------------------------------}
  1078. { This routine first calculates all points required to }
  1079. { draw a circle to the screen, and stores the points }
  1080. { to display in a buffer before plotting them. The }
  1081. { aspect ratio of the screen is taken into account when }
  1082. { calculating the values. }
  1083. {--------------------------------------------------------}
  1084. { INPUTS: X,Y : Center coordinates of Ellipse. }
  1085. { XRadius - X-Axis radius of ellipse. }
  1086. { YRadius - Y-Axis radius of ellipse. }
  1087. { stAngle, EndAngle: Start angle and end angles of the }
  1088. { ellipse (used for partial ellipses and circles) }
  1089. {--------------------------------------------------------}
  1090. { NOTE: - uses the current write mode. }
  1091. { - Angles must both be between 0 and 360 }
  1092. {********************************************************}
  1093. Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
  1094. YRadius:word; stAngle,EndAngle: word);
  1095. var
  1096. i:integer;
  1097. xpt: pinttable;
  1098. ypt: pinttable;
  1099. j,Delta:real;
  1100. NumOfPixels: longint;
  1101. NumOfPix: Array[0..2] of longint;
  1102. count: longint;
  1103. ConvFac,TempTerm: real;
  1104. aval,bval: integer;
  1105. OldcurrentColor: word;
  1106. TmpAngle: word;
  1107. DeltaAngle: word;
  1108. Begin
  1109. { check if valid angles }
  1110. stangle := stAngle mod 361;
  1111. EndAngle := EndAngle mod 361;
  1112. { if impossible angles then swap them! }
  1113. if Endangle < StAngle then
  1114. Begin
  1115. TmpAngle:=EndAngle;
  1116. EndAngle:=StAngle;
  1117. Stangle:=TmpAngle;
  1118. end;
  1119. { calculate difference of angle now so we don't always have to calculate it }
  1120. DeltaAngle:= EndAngle-StAngle;
  1121. i:=0;
  1122. if LineInfo.Thickness=NormWidth then
  1123. Begin
  1124. { approximate the number of pixels required by using the circumference }
  1125. { equation of an ellipse. }
  1126. NumOfPixels:=8*Round(2*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
  1127. GetMem(xpt,NumOfpixels*sizeof(word));
  1128. GetMem(ypt,NumOfPixels*sizeof(word));
  1129. { Calculate the angle precision required }
  1130. Delta := DeltaAngle / (NumOfPixels);
  1131. { Adjust for screen aspect ratio }
  1132. XRadius:=(longint(XRadius)*10000) div XAspect;
  1133. YRadius:=(longint(YRadius)*10000) div YAspect;
  1134. { Initial counter value }
  1135. j:=Delta+StAngle;
  1136. { removed from inner loop to make faster }
  1137. ConvFac:=Pi/180.0;
  1138. Repeat
  1139. { this used by both sin and cos }
  1140. TempTerm := j*ConvFac;
  1141. { Calculate points }
  1142. xpt^[i]:=round(XRadius*Cos(TempTerm));
  1143. { calculate the value of y }
  1144. ypt^[i]:=round(YRadius*Sin(TempTerm+Pi));
  1145. j:=j+Delta;
  1146. inc(i);
  1147. Until j > DeltaAngle;
  1148. end
  1149. else
  1150. {******************************************}
  1151. { CIRCLE OR ELLIPSE WITH THICKNESS=3 }
  1152. {******************************************}
  1153. Begin
  1154. NumOfPix[1]:=8*Round(2*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
  1155. NumOfPix[0]:=8*Round(2*sqrt((sqr(XRadius-1)+sqr(YRadius-1)) div 2));
  1156. NumOfPix[2]:=8*Round(2*sqrt((sqr(XRadius+1)+sqr(YRadius+1)) div 2));
  1157. GetMem(xpt,(NumOfPix[1]+NumOfPix[2]+NumOfPix[0])*sizeof(word));
  1158. GetMem(ypt,(NumOfPix[1]+NumOfPix[2]+NumOfPix[0])*sizeof(word));
  1159. { removed from inner loop to make faster }
  1160. ConvFac:=Pi/180.0;
  1161. for Count:=0 to 2 do
  1162. Begin
  1163. aval:=XRadius+Count-1;
  1164. bval:=YRadius+Count-1;
  1165. Delta := DeltaAngle / (NumOfPix[Count]);
  1166. aval:= (longint(aval)*10000) div XAspect;
  1167. bval:= (longint(bval)*10000) div YAspect;
  1168. j:=Delta+Stangle;
  1169. Repeat
  1170. { this used by both sin and cos }
  1171. TempTerm := j*ConvFac;
  1172. xpt^[i]:=round((aval)*Cos(TempTerm));
  1173. { calculate the value of y }
  1174. ypt^[i]:=round(bval*Sin(TempTerm+Pi));
  1175. j:=j+Delta;
  1176. inc(i);
  1177. Until j > DeltaAngle;
  1178. end;
  1179. end;
  1180. {******************************************}
  1181. { NOW ALL PIXEL POINTS ARE IN BUFFER }
  1182. { plot them all to the screen }
  1183. {******************************************}
  1184. Count:=0;
  1185. OldcurrentColor:=currentColor;
  1186. Repeat
  1187. PutPixel(xpt^[Count]+X,ypt^[Count]+Y,CurrentColor);
  1188. inc(count);
  1189. until Count>=i;
  1190. { Get End and Start points into the ArcCall information record }
  1191. ArcCall.X := X;
  1192. ArcCall.Y := Y;
  1193. ArcCall.XStart := xpt^[0] + X;
  1194. ArcCall.YStart := ypt^[0] + Y;
  1195. ArcCall.XEnd := xpt^[Count-1] + X;
  1196. ArcCall.YEnd := ypt^[Count-1] + Y;
  1197. CurrentColor:=OldCurrentColor;
  1198. if LineInfo.Thickness=NormWidth then
  1199. Begin
  1200. Freemem(xpt,NumOfPixels*sizeof(word));
  1201. Freemem(ypt,NumOfPixels*sizeof(word));
  1202. end
  1203. else
  1204. Begin
  1205. FreeMem(xpt,(NumOfPix[1]+NumOfPix[2]+NumOfPix[0])*sizeof(word));
  1206. FreeMem(ypt,(NumOfPix[1]+NumOfPix[2]+NumOfPix[0])*sizeof(word));
  1207. end;
  1208. end;
  1209. {********************************************************}
  1210. { Procedure InternalEllipse() }
  1211. {--------------------------------------------------------}
  1212. { This routine first calculates all points required to }
  1213. { draw a circle to the screen, and stores the points }
  1214. { to display in a buffer before plotting them. The }
  1215. { aspect ratio of the screen is taken into account when }
  1216. { calculating the values. }
  1217. {--------------------------------------------------------}
  1218. { INPUTS: X,Y : Center coordinates of Ellipse. }
  1219. { XRadius - X-Axis radius of ellipse. }
  1220. { YRadius - Y-Axis radius of ellipse. }
  1221. { stAngle, EndAngle: Start angle and end angles of the }
  1222. { ellipse (used for partial ellipses and circles) }
  1223. {--------------------------------------------------------}
  1224. { NOTE: - uses the current write mode. }
  1225. { - Angles must both be between 0 and 360 }
  1226. {********************************************************}
  1227. (*
  1228. Procedure InternalEllipseDefault (x, y : integer;
  1229. xradius, yradius, stAngle, EndAngle : Word);
  1230. { Draw an ellipse arc. Crude but it works (anyone have a better one?) }
  1231. Var
  1232. aSqr, bSqr, twoaSqr, twobSqr, xa, ya, twoXbSqr, twoYaSqr, error : LongInt;
  1233. Alpha : Real;
  1234. const
  1235. RadToDeg = 180/Pi;
  1236. Procedure PlotPoints;
  1237. var
  1238. i,j: integer;
  1239. xm, ym: integer;
  1240. xp, yp: integer;
  1241. Begin
  1242. ym := y-ya;
  1243. yp := y+ya;
  1244. xm := x-xa;
  1245. xp := x+xa;
  1246. if LineInfo.Thickness = Normwidth then
  1247. Begin
  1248. If (Alpha>=StAngle) And (Alpha<=EndAngle) then
  1249. PutPixel (xm,ym, CurrentColor);
  1250. If (180-Alpha>=StAngle) And (180-Alpha<=EndAngle) then
  1251. PutPixel (xm,yp, CurrentColor);
  1252. If (180+Alpha>=StAngle) And (180+Alpha<=EndAngle) then
  1253. PutPixel (xp,yp, CurrentColor);
  1254. If (360-Alpha>=StAngle) And (360-Alpha<=EndAngle) then
  1255. PutPixel (xp,ym, CurrentColor);
  1256. end
  1257. else
  1258. Begin
  1259. If (Alpha>=StAngle) And (Alpha<=EndAngle) then
  1260. for i:=-1 to 1 do
  1261. for j:=-1 to 1 do
  1262. PutPixel (xm+i,ym+j, CurrentColor);
  1263. If (180-Alpha>=StAngle) And (180-Alpha<=EndAngle) then
  1264. for i:=-1 to 1 do
  1265. for j:=-1 to 1 do
  1266. PutPixel (xm+i,yp+j, CurrentColor);
  1267. If (180+Alpha>=StAngle) And (180+Alpha<=EndAngle) then
  1268. for i:=-1 to 1 do
  1269. for j:=-1 to 1 do
  1270. PutPixel (xp+i,yp+j, CurrentColor);
  1271. If (360-Alpha>=StAngle) And (360-Alpha<=EndAngle) then
  1272. for i:=-1 to 1 do
  1273. for j:=-1 to 1 do
  1274. PutPixel (xp+i,ym+j, CurrentColor);
  1275. end;
  1276. End;
  1277. Begin
  1278. StAngle:=StAngle MOD 361;
  1279. EndAngle:=EndAngle MOD 361;
  1280. StAngle := StAngle + 270;
  1281. EndAngle := EndAngle + 270;
  1282. If StAngle>EndAngle then
  1283. Begin
  1284. StAngle:=StAngle Xor EndAngle; EndAngle:=EndAngle Xor StAngle; StAngle:=EndAngle Xor StAngle;
  1285. End;
  1286. { Adjust for screen aspect ratio }
  1287. XRadius:=(longint(XRadius)*10000) div XAspect;
  1288. YRadius:=(longint(YRadius)*10000) div YAspect;
  1289. aSqr:=LongInt (xradius)*LongInt (xradius);
  1290. bSqr:=LongInt (yradius)*LongInt (yradius);
  1291. twoaSqr:=2*aSqr;
  1292. twobSqr:=2*bSqr;
  1293. xa:=0;
  1294. ya:=yradius;
  1295. twoXbSqr:=0;
  1296. twoYaSqr:=ya*twoaSqr;
  1297. error:=-ya*aSqr;
  1298. While twoXbSqr<=twoYaSqr Do Begin
  1299. If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya); { Crude but it works }
  1300. PlotPoints;
  1301. Inc (xa);
  1302. Inc (twoXbSqr,twobSqr);
  1303. Inc (error,twoXbSqr-bSqr);
  1304. If error>=0 then Begin
  1305. Dec (ya);
  1306. Dec (twoYaSqr,twoaSqr);
  1307. Dec (error,twoYaSqr);
  1308. End;
  1309. End;
  1310. xa:=xradius;
  1311. ya:=0;
  1312. twoXbSqr:=xa*twobSqr;
  1313. twoYaSqr:=0;
  1314. error:=-xa*bSqr;
  1315. While twoXbSqr>twoYaSqr Do Begin
  1316. If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya);
  1317. PlotPoints;
  1318. Inc (ya);
  1319. Inc (twoYaSqr,twoaSqr);
  1320. Inc (error,twoYaSqr-aSqr);
  1321. If error>=0 then Begin
  1322. Dec (xa);
  1323. Dec (twoXbSqr,twobSqr);
  1324. Dec (error,twoXbSqr);
  1325. End;
  1326. End;
  1327. End;
  1328. *)
  1329. procedure PatternLineDefault(x1,x2,y: integer);
  1330. {********************************************************}
  1331. { Draws a horizontal patterned line according to the }
  1332. { current Fill Settings. }
  1333. {********************************************************}
  1334. { Important notes: }
  1335. { - CurrentColor must be set correctly before entering }
  1336. { this routine. }
  1337. {********************************************************}
  1338. var
  1339. NrIterations: Integer;
  1340. i : Integer;
  1341. j : Integer;
  1342. TmpFillPattern : byte;
  1343. OldWriteMode : word;
  1344. OldCurrentColor : word;
  1345. begin
  1346. { convert to global coordinates ... }
  1347. x1 := x1 + StartXViewPort;
  1348. x2 := x2 + StartXViewPort;
  1349. y := y + StartYViewPort;
  1350. { if line was fully clipped then exit...}
  1351. if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
  1352. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  1353. exit;
  1354. OldWriteMode := CurrentWriteMode;
  1355. CurrentWriteMode := NormalPut;
  1356. { number of times to go throuh the 8x8 pattern }
  1357. NrIterations := abs(x2 - x1) div 8;
  1358. Inc(NrIterations);
  1359. { Get the current pattern }
  1360. TmpFillPattern := FillPatternTable
  1361. { [FillSettings.Pattern][(((y+viewport.x1) and $7)+1];}
  1362. [FillSettings.Pattern][(y and $7)+1];
  1363. if FillSettings.Pattern = EmptyFill then
  1364. begin
  1365. OldCurrentColor := CurrentColor;
  1366. CurrentColor := CurrentBkColor;
  1367. HLine(x1,x2,y);
  1368. CurrentColor := OldCurrentColor;
  1369. end
  1370. else
  1371. if FillSettings.Pattern = SolidFill then
  1372. begin
  1373. HLine(x1,x2,y);
  1374. end
  1375. else
  1376. begin
  1377. For i:= 0 to NrIterations do
  1378. Begin
  1379. for j:=0 to 7 do
  1380. Begin
  1381. { x1 mod 8 }
  1382. if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
  1383. DirectPutpixel(x1,y)
  1384. else
  1385. begin
  1386. { According to the TP graph manual, we overwrite everything }
  1387. { which is filled up - checked against VGA and CGA drivers }
  1388. { of TP. }
  1389. OldCurrentColor := CurrentColor;
  1390. CurrentColor := CurrentBkColor;
  1391. DirectPutPixel(x1,y);
  1392. CurrentColor := OldCurrentColor;
  1393. end;
  1394. Inc(x1);
  1395. if x1 > x2 then
  1396. begin
  1397. CurrentWriteMode := OldWriteMode;
  1398. exit;
  1399. end;
  1400. end;
  1401. end;
  1402. end;
  1403. CurrentWriteMode := OldWriteMode;
  1404. end;
  1405. procedure LineRel(Dx, Dy: Integer);
  1406. Begin
  1407. Line(CurrentX, CurrentY, CurrentX + Dx, CurrentY + Dy);
  1408. CurrentX := CurrentX + Dx;
  1409. CurrentY := CurrentY + Dy;
  1410. end;
  1411. procedure LineTo(x,y : Integer);
  1412. Begin
  1413. Line(CurrentX, CurrentY, X, Y);
  1414. CurrentX := X;
  1415. CurrentY := Y;
  1416. end;
  1417. procedure Rectangle(x1,y1,x2,y2:integer);
  1418. begin
  1419. { Do not draw the end points }
  1420. Line(x1,y1,x2-1,y1);
  1421. Line(x1,y1+1,x1,y2);
  1422. Line(x2,y1,x2,y2-1);
  1423. Line(x1+1,y2,x2,y2);
  1424. end;
  1425. procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
  1426. begin
  1427. Activelineinfo:=Lineinfo;
  1428. end;
  1429. procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
  1430. var
  1431. i: byte;
  1432. j: byte;
  1433. Begin
  1434. if (LineStyle > UserBitLn) or ((Thickness <> Normwidth) and (Thickness <> ThickWidth)) then
  1435. _GraphResult := grError
  1436. else
  1437. begin
  1438. LineInfo.Thickness := Thickness;
  1439. LineInfo.LineStyle := LineStyle;
  1440. case LineStyle of
  1441. UserBitLn: Lineinfo.Pattern := pattern;
  1442. SolidLn: Lineinfo.Pattern := $ffff; { ------- }
  1443. DashedLn : Lineinfo.Pattern := $F8F8; { -- -- --}
  1444. DottedLn: LineInfo.Pattern := $CCCC; { - - - - }
  1445. CenterLn: LineInfo.Pattern := $FC78; { -- - -- }
  1446. end; { end case }
  1447. { setup pattern styles }
  1448. j:=15;
  1449. for i:=0 to 15 do
  1450. Begin
  1451. { bitwise mask for each bit in the word }
  1452. if (word($01 shl i) AND LineInfo.Pattern) <> 0 then
  1453. LinePatterns[j]:=TRUE
  1454. else
  1455. LinePatterns[j]:=FALSE;
  1456. Dec(j);
  1457. end;
  1458. end;
  1459. end;
  1460. {--------------------------------------------------------------------------}
  1461. { }
  1462. { VIEWPORT RELATED ROUTINES }
  1463. { }
  1464. {--------------------------------------------------------------------------}
  1465. Procedure ClearViewPortDefault;
  1466. var
  1467. j: integer;
  1468. OldWriteMode, OldCurColor: word;
  1469. LineSets : LineSettingsType;
  1470. Begin
  1471. { CP is always RELATIVE coordinates }
  1472. CurrentX := 0;
  1473. CurrentY := 0;
  1474. { Save all old settings }
  1475. OldCurColor := CurrentColor;
  1476. CurrentColor:=CurrentBkColor;
  1477. OldWriteMode:=CurrentWriteMode;
  1478. GetLineSettings(LineSets);
  1479. { reset to normal line style...}
  1480. SetLineStyle(SolidLn, 0, NormWidth);
  1481. { routines are relative here...}
  1482. for J:=0 to ViewHeight do
  1483. HLine(0, ViewWidth, J);
  1484. { restore old settings...}
  1485. SetLineStyle(LineSets.LineStyle, LineSets.Pattern, LineSets.Thickness);
  1486. CurrentColor := OldCurColor;
  1487. CurrentWriteMode := OldWriteMode;
  1488. end;
  1489. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  1490. Begin
  1491. if (X1 > GetMaxX) or (X2 > GetMaxX) or (X1 > X2) or (X1 < 0) then
  1492. Begin
  1493. _GraphResult := grError;
  1494. exit;
  1495. end;
  1496. if (Y1 > GetMaxY) or (Y2 > GetMaxY) or (Y1 > Y2) or (Y1 < 0) then
  1497. Begin
  1498. _GraphResult := grError;
  1499. exit;
  1500. end;
  1501. { CP is always RELATIVE coordinates }
  1502. CurrentX := 0;
  1503. CurrentY := 0;
  1504. StartXViewPort := X1;
  1505. StartYViewPort := Y1;
  1506. ViewWidth := X2-X1;
  1507. ViewHeight:= Y2-Y1;
  1508. ClipPixels := Clip;
  1509. end;
  1510. procedure GetViewSettings(var viewport : ViewPortType);
  1511. begin
  1512. ViewPort.X1 := StartXViewPort;
  1513. ViewPort.Y1 := StartYViewPort;
  1514. ViewPort.X2 := ViewWidth + StartXViewPort;
  1515. ViewPort.Y2 := ViewHeight + StartYViewPort;
  1516. ViewPort.Clip := ClipPixels;
  1517. end;
  1518. procedure ClearDevice;
  1519. var
  1520. ViewPort: ViewPortType;
  1521. begin
  1522. { Reset the CP }
  1523. CurrentX := 0;
  1524. CurrentY := 0;
  1525. { save viewport }
  1526. ViewPort.X1 := StartXviewPort;
  1527. ViewPort.X2 := ViewWidth - StartXViewPort;
  1528. ViewPort.Y1 := StartYViewPort;
  1529. ViewPort.Y2 := ViewHeight - StartYViewPort;
  1530. ViewPort.Clip := ClipPixels;
  1531. { put viewport to full screen }
  1532. StartXViewPort := 0;
  1533. ViewHeight := MaxY;
  1534. StartYViewPort := 0;
  1535. ViewWidth := MaxX;
  1536. ClipPixels := TRUE;
  1537. ClearViewPort;
  1538. { restore old viewport }
  1539. StartXViewPort := ViewPort.X1;
  1540. ViewWidth := ViewPort.X2-ViewPort.X1;
  1541. StartYViewPort := ViewPort.Y1;
  1542. ViewHeight := ViewPort.Y2-ViewPort.Y1;
  1543. ClipPixels := ViewPort.Clip;
  1544. end;
  1545. {--------------------------------------------------------------------------}
  1546. { }
  1547. { BITMAP PUT/GET ROUTINES }
  1548. { }
  1549. {--------------------------------------------------------------------------}
  1550. Procedure GetScanlineDefault (Y : Integer; Var Data);
  1551. {********************************************************}
  1552. { Procedure GetScanLine() }
  1553. {--------------------------------------------------------}
  1554. { Returns the full scanline of the video line of the Y }
  1555. { coordinate. The values are returned in a WORD array }
  1556. { each WORD representing a pixel of the specified scanline}
  1557. {********************************************************}
  1558. Var
  1559. Offset, x : Integer;
  1560. Begin
  1561. For x:=0 to MaxX Do Begin
  1562. WordArray(Data)[x]:=GetPixel(x, y);
  1563. End;
  1564. End;
  1565. Function DefaultImageSize(X1,Y1,X2,Y2: Integer): longint;
  1566. Begin
  1567. { each pixel uses two bytes, to enable modes with colors up to 64K }
  1568. { to work. }
  1569. DefaultImageSize := 12 + (((X2-X1)*(Y2-Y1))*2);
  1570. end;
  1571. Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word);
  1572. type
  1573. pt = array[0..32000] of word;
  1574. ptw = array[0..3] of longint;
  1575. var
  1576. color: word;
  1577. i,j: Integer;
  1578. Y1,X1: Integer;
  1579. k: integer;
  1580. Begin
  1581. X1:= ptw(Bitmap)[0]+X; { get width and adjust end coordinate accordingly }
  1582. Y1:= ptw(Bitmap)[1]+Y; { get height and adjust end coordinate accordingly }
  1583. k:= 12; { Three reserved longs at start of bitmap }
  1584. for j:=Y to Y1 do
  1585. Begin
  1586. for i:=X to X1 do
  1587. begin
  1588. case BitBlt of
  1589. {$R-}
  1590. CopyPut: color:= pt(Bitmap)[k]; { also = normalput }
  1591. XORPut: color:= pt(Bitmap)[k] XOR GetPixel(i,j);
  1592. OrPut: color:= pt(Bitmap)[k] OR GetPixel(i,j);
  1593. AndPut: color:= pt(Bitmap)[k] AND GetPixel(i,j);
  1594. NotPut: color:= not pt(Bitmap)[k];
  1595. {$R+}
  1596. end;
  1597. putpixel(i,j,color);
  1598. Inc(k);
  1599. end;
  1600. end;
  1601. end;
  1602. Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap);
  1603. type
  1604. pt = array[0..32000] of word;
  1605. ptw = array[0..3] of longint;
  1606. var
  1607. i,j: integer;
  1608. k: longint;
  1609. Begin
  1610. k:= 12; { Three reserved longs at start of bitmap }
  1611. for j:=Y1 to Y2 do
  1612. Begin
  1613. for i:=X1 to X2 do
  1614. begin
  1615. {$R-}
  1616. pt(Bitmap)[k] :=getpixel(i,j);
  1617. {$R+}
  1618. Inc(k);
  1619. end;
  1620. end;
  1621. ptw(Bitmap)[0] := X2-X1; { First longint is width }
  1622. ptw(Bitmap)[1] := Y2-Y1; { Second longint is height }
  1623. ptw(bitmap)[2] := 0; { Third longint is reserved}
  1624. end;
  1625. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  1626. Begin
  1627. ArcCoords.X := ArcCall.X;
  1628. ArcCoords.Y := ArcCall.Y;
  1629. ArcCoords.XStart := ArcCall.XStart;
  1630. ArcCoords.YStart := ArcCall.YStart;
  1631. ArcCoords.XEnd := ArcCall.XEnd;
  1632. ArcCoords.YEnd := ArcCall.YEnd;
  1633. end;
  1634. procedure SetVisualPageDefault(page : word);
  1635. begin
  1636. end;
  1637. procedure SetActivePageDefault(page : word);
  1638. begin
  1639. end;
  1640. Procedure DefaultHooks;
  1641. {********************************************************}
  1642. { Procedure DefaultHooks() }
  1643. {--------------------------------------------------------}
  1644. { Resets all hookable routine either to nil for those }
  1645. { which need overrides, and others to defaults. }
  1646. { This is called each time SetGraphMode() is called. }
  1647. {********************************************************}
  1648. Begin
  1649. { All default hooks procedures }
  1650. { required...}
  1651. DirectPutPixel := nil;
  1652. PutPixel := nil;
  1653. GetPixel := nil;
  1654. SetRGBPalette := nil;
  1655. GetRGBPalette := nil;
  1656. { optional...}
  1657. SetActivePage := SetActivePageDefault;
  1658. SetVisualPage := SetVisualPageDefault;
  1659. ClearViewPort := ClearViewportDefault;
  1660. PutImage := DefaultPutImage;
  1661. GetImage := DefaultGetImage;
  1662. ImageSize := DefaultImageSize;
  1663. GraphFreeMemPtr := nil;
  1664. GraphGetMemPtr := nil;
  1665. GetScanLine := GetScanLineDefault;
  1666. Line := LineDefault;
  1667. InternalEllipse := InternalEllipseDefault;
  1668. PatternLine := PatternLineDefault;
  1669. HLine := HLineDefault;
  1670. VLine := VLineDefault;
  1671. end;
  1672. Procedure InitVars;
  1673. {********************************************************}
  1674. { Procedure InitVars() }
  1675. {--------------------------------------------------------}
  1676. { Resets all internal variables, and resets all }
  1677. { overridable routines. }
  1678. {********************************************************}
  1679. Begin
  1680. DirectVideo := TRUE; { By default use fastest access possible }
  1681. ArcCall.X := 0;
  1682. ArcCall.Y := 0;
  1683. ArcCall.XStart := 0;
  1684. ArcCall.YStart := 0;
  1685. ArcCall.XEnd := 0;
  1686. ArcCall.YEnd := 0;
  1687. { Reset to default values }
  1688. IntCurrentMode := 0;
  1689. IntCurrentDriver := 0;
  1690. XAspect := 0;
  1691. YAspect := 0;
  1692. MaxX := 0;
  1693. MaxY := 0;
  1694. MaxColor := 0;
  1695. PaletteSize := 0;
  1696. DirectColor := FALSE;
  1697. HardwarePages := 0;
  1698. DefaultHooks;
  1699. end;
  1700. {$i modes.inc}
  1701. {$i graph.inc}
  1702. function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer;
  1703. begin
  1704. _graphResult := grError;
  1705. end;
  1706. function RegisterBGIDriver(driver: pointer): integer;
  1707. begin
  1708. _graphResult := grError;
  1709. end;
  1710. { ----------------------------------------------------------------- }
  1711. Procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
  1712. var
  1713. OldWriteMode: word;
  1714. Begin
  1715. if (Radius = 0) then
  1716. Exit;
  1717. if (Radius = 1) then
  1718. begin
  1719. { must use clipping ... }
  1720. { don't need to explicitly set NormalPut mode }
  1721. { because PutPixel only supports normal put }
  1722. PutPixel(X, Y,CurrentColor);
  1723. Exit;
  1724. end;
  1725. { Only if we are using thickwidths lines do we accept }
  1726. { XORput write modes. }
  1727. OldWriteMode := CurrentWriteMode;
  1728. if (LineInfo.Thickness = NormWidth) then
  1729. CurrentWriteMode := NormalPut;
  1730. InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle);
  1731. CurrentWriteMode := OldWriteMode;
  1732. end;
  1733. procedure Ellipse(X,Y : Integer; stAngle, EndAngle: word; XRadius,YRadius: word);
  1734. Begin
  1735. InternalEllipse(X,Y,XRadius,YRadius,stAngle,EndAngle);
  1736. end;
  1737. procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  1738. {********************************************************}
  1739. { Procedure FillEllipse() }
  1740. {--------------------------------------------------------}
  1741. { Draws a filled ellipse using (X,Y) as a center point }
  1742. { and XRadius and YRadius as the horizontal and vertical }
  1743. { axes. The ellipse is filled with the current fill color}
  1744. { and fill style, and is bordered with the current color.}
  1745. {--------------------------------------------------------}
  1746. { Important notes: }
  1747. { - CONTRRARY to VGA BGI - SetWriteMode DOES not }
  1748. { affect the contour of the ellipses. BGI mode }
  1749. { supports XORPut but the FloodFill() is still bounded}
  1750. { by the ellipse. In OUR case, XOR Mode is simply }
  1751. { not supported. }
  1752. {********************************************************}
  1753. var
  1754. OldWriteMode: Word;
  1755. begin
  1756. { only normal put supported }
  1757. OldWriteMode := CurrentWriteMode;
  1758. CurrentWriteMode := NormalPut;
  1759. InternalEllipse(X,Y,XRadius,YRadius,0,360);
  1760. FloodFill(X,Y,CurrentColor);
  1761. { restore old write mode }
  1762. CurrentWriteMode := OldWriteMode;
  1763. end;
  1764. procedure Circle(X, Y: Integer; Radius:Word);
  1765. {********************************************************}
  1766. { Draws a circle centered at X,Y with the given Radius. }
  1767. {********************************************************}
  1768. { Important notes: }
  1769. { - Thickwidth circles use the current write mode, while}
  1770. { normal width circles ALWAYS use CopyPut/NormalPut }
  1771. { mode. (Tested against VGA BGI driver -CEC 13/Aug/99 }
  1772. {********************************************************}
  1773. var OriginalArcInfo: ArcCoordsType;
  1774. OldWriteMode: word;
  1775. begin
  1776. if (Radius = 0) then
  1777. Exit;
  1778. if (Radius = 1) then
  1779. begin
  1780. { only normal put mode is supported by a call to PutPixel }
  1781. PutPixel(X, Y, CurrentColor);
  1782. Exit;
  1783. end;
  1784. { save state of arc information }
  1785. { because it is not needed for }
  1786. { a circle call. }
  1787. move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
  1788. if LineInfo.Thickness = Normwidth then
  1789. begin
  1790. OldWriteMode := CurrentWriteMode;
  1791. CurrentWriteMode := CopyPut;
  1792. end;
  1793. InternalEllipse(X,Y,Radius,Radius,0,360);
  1794. if LineInfo.Thickness = Normwidth then
  1795. CurrentWriteMode := OldWriteMode;
  1796. { restore arc information }
  1797. move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
  1798. end;
  1799. procedure Sector(x, y: Integer; StAngle,EndAngle, XRadius, YRadius: Word);
  1800. var angle : real;
  1801. writemode : word;
  1802. begin
  1803. Ellipse(x,y,stAngle,endAngle,XRadius,YRadius);
  1804. { As in the TP graph unit - the line settings are used to }
  1805. { define the outline of the sector. }
  1806. writemode:=Currentwritemode;
  1807. Currentwritemode:=normalput;
  1808. Line(ArcCall.XStart, ArcCall.YStart, x,y);
  1809. Line(x,y,ArcCall.Xend,ArcCall.YEnd);
  1810. { we must take care of clipping so we call PutPixel instead }
  1811. { of DirectPutPixel... }
  1812. PutPixel(ArcCall.xstart,ArcCall.ystart,CurrentColor);
  1813. PutPixel(x,y,CurrentColor);
  1814. PutPixel(ArcCall.xend,ArcCall.yend,CurrentColor);
  1815. stangle:=Stangle mod 360; EndAngle:=Endangle mod 360;
  1816. if stAngle<=Endangle then
  1817. Angle:=(stAngle+EndAngle)/2
  1818. else
  1819. angle:=(stAngle-360+EndAngle)/2;
  1820. { fill from the point in the middle of the slice }
  1821. XRadius:=(longint(XRadius)*10000) div XAspect;
  1822. YRadius:=(longint(YRadius)*10000) div YAspect;
  1823. { avoid rounding errors }
  1824. if abs(ArcCall.xstart-ArcCall.xend)
  1825. +abs(ArcCall.ystart-ArcCall.yend)>2 then
  1826. FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
  1827. y+round(cos((angle+90)*Pi/180)*YRadius/2),CurrentColor);
  1828. CurrentWriteMode := writemode;
  1829. end;
  1830. procedure SetFillStyle(Pattern : word; Color: word);
  1831. begin
  1832. { on invalid input, the current fill setting will be }
  1833. { unchanged. }
  1834. if (Pattern > UserFill) or (Color > GetMaxColor) then
  1835. begin
  1836. _GraphResult := grError;
  1837. exit;
  1838. end;
  1839. FillSettings.Color := Color;
  1840. FillSettings.Pattern := Pattern;
  1841. end;
  1842. procedure SetFillPattern(Pattern: FillPatternType; Color: word);
  1843. {********************************************************}
  1844. { Changes the Current FillPattern to a user defined }
  1845. { pattern and changes also the current fill color. }
  1846. { The FillPattern is saved in the FillPattern array so }
  1847. { it can still be used with SetFillStyle(UserFill,Color) }
  1848. {********************************************************}
  1849. var
  1850. i: integer;
  1851. begin
  1852. if Color > GetMaxColor then
  1853. begin
  1854. _GraphResult := grError;
  1855. exit;
  1856. end;
  1857. FillSettings.Color := Color;
  1858. FillSettings.Pattern := UserFill;
  1859. { Save the pattern in the buffer }
  1860. For i:=1 to 8 do
  1861. FillPatternTable[UserFill][i] := Pattern[i];
  1862. end;
  1863. procedure Bar(x1,y1,x2,y2:integer);
  1864. {********************************************************}
  1865. { Important notes for compatibility with BP: }
  1866. { - WriteMode is always CopyPut }
  1867. { - No contour is drawn for the lines }
  1868. {********************************************************}
  1869. var y : Integer;
  1870. origcolor : longint;
  1871. origlinesettings: Linesettingstype;
  1872. origwritemode : Integer;
  1873. begin
  1874. origlinesettings:=lineinfo;
  1875. origcolor:=CurrentColor;
  1876. { Always copy mode for Bars }
  1877. origwritemode := CurrentWriteMode;
  1878. CurrentWriteMode := CopyPut;
  1879. { All lines used are of this style }
  1880. Lineinfo.linestyle:=solidln;
  1881. Lineinfo.thickness:=normwidth;
  1882. case Fillsettings.pattern of
  1883. EmptyFill :
  1884. begin
  1885. Currentcolor:=CurrentBkColor;
  1886. for y:=y1 to y2 do
  1887. Hline(x1,x2,y);
  1888. end;
  1889. SolidFill :
  1890. begin
  1891. CurrentColor:=FillSettings.color;
  1892. for y:=y1 to y2 do
  1893. Hline(x1,x2,y);
  1894. end;
  1895. else
  1896. Begin
  1897. CurrentColor:=FillSettings.color;
  1898. for y:=y1 to y2 do
  1899. patternline(x1,x2,y);
  1900. end;
  1901. end;
  1902. CurrentColor:= Origcolor;
  1903. LineInfo := OrigLineSettings;
  1904. CurrentWriteMode := OrigWritemode;
  1905. end;
  1906. procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  1907. var
  1908. origwritemode : integer;
  1909. OldX, OldY : integer;
  1910. begin
  1911. origwritemode := CurrentWriteMode;
  1912. CurrentWriteMode := CopyPut;
  1913. Bar(x1,y1,x2,y2);
  1914. Rectangle(x1,y1,x2,y2);
  1915. { Current CP should not be updated in Bar3D }
  1916. { therefore save it and then restore it on }
  1917. { exit. }
  1918. OldX := CurrentX;
  1919. OldY := CurrentY;
  1920. if top then begin
  1921. Moveto(x1,y1);
  1922. Lineto(x1+depth,y1-depth);
  1923. Lineto(x2+depth,y1-depth);
  1924. Lineto(x2,y1);
  1925. end;
  1926. if Depth <> 0 then
  1927. Begin
  1928. Moveto(x2+depth,y1-depth);
  1929. Lineto(x2+depth,y2-depth);
  1930. Lineto(x2,y2);
  1931. end;
  1932. { restore CP }
  1933. CurrentX := OldX;
  1934. CurrentY := OldY;
  1935. CurrentWriteMode := origwritemode;
  1936. end;
  1937. {--------------------------------------------------------------------------}
  1938. { }
  1939. { COLOR AND PALETTE ROUTINES }
  1940. { }
  1941. {--------------------------------------------------------------------------}
  1942. {$i palette.inc}
  1943. procedure SetColor(Color: Word);
  1944. Begin
  1945. CurrentColor := Color;
  1946. end;
  1947. function GetColor: Word;
  1948. Begin
  1949. GetColor := CurrentColor;
  1950. end;
  1951. function GetBkColor: Word;
  1952. Begin
  1953. GetBkColor := CurrentBkColor;
  1954. end;
  1955. procedure SetBkColor(ColorNum: Word);
  1956. { Background color means background screen color in this case, and it is }
  1957. { INDEPENDANT of the viewport settings, so we must clear the whole screen }
  1958. { with the color. }
  1959. var
  1960. ViewPort: ViewportType;
  1961. Begin
  1962. GetViewSettings(Viewport);
  1963. SetViewPort(0,0,MaxX,MaxY,FALSE);
  1964. CurrentBkColor := ColorNum;
  1965. ClearViewPort;
  1966. SetViewport(ViewPort.X1,Viewport.Y1,Viewport.X2,Viewport.Y2,Viewport.Clip);
  1967. end;
  1968. function GetMaxColor: word;
  1969. { Checked against TP VGA driver - CEC }
  1970. begin
  1971. GetMaxColor:=MaxColor-1; { based on an index of zero so subtract one }
  1972. end;
  1973. Procedure MoveRel(Dx, Dy: Integer);
  1974. Begin
  1975. CurrentX := CurrentX + Dx;
  1976. CurrentY := CurrentY + Dy;
  1977. end;
  1978. Procedure MoveTo(X,Y: Integer);
  1979. {********************************************************}
  1980. { Procedure MoveTo() }
  1981. {--------------------------------------------------------}
  1982. { Moves the current pointer in VIEWPORT relative }
  1983. { coordinates to the specified X,Y coordinate. }
  1984. {********************************************************}
  1985. Begin
  1986. CurrentX := X;
  1987. CurrentY := Y;
  1988. end;
  1989. function GraphErrorMsg(ErrorCode: Integer): string;
  1990. Begin
  1991. GraphErrorMsg:='';
  1992. case ErrorCode of
  1993. grOk,grFileNotFound,grInvalidDriver: exit;
  1994. grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
  1995. grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
  1996. grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
  1997. grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
  1998. grFontNotFound: GraphErrorMsg:= 'Font file not found';
  1999. grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
  2000. grError: GraphErrorMsg:='Graphics error';
  2001. grIoError: GraphErrorMsg:='Graphics I/O error';
  2002. grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
  2003. grInvalidVersion: GraphErrorMsg:='Invalid driver version';
  2004. end;
  2005. end;
  2006. Function GetMaxX: Integer;
  2007. { Routine checked against VGA driver - CEC }
  2008. Begin
  2009. GetMaxX := MaxX;
  2010. end;
  2011. Function GetMaxY: Integer;
  2012. { Routine checked against VGA driver - CEC }
  2013. Begin
  2014. GetMaxY := MaxY;
  2015. end;
  2016. Function GraphResult: Integer;
  2017. Begin
  2018. GraphResult := _GraphResult;
  2019. _GraphResult := grOk;
  2020. end;
  2021. Function GetX: Integer;
  2022. Begin
  2023. GetX := CurrentX;
  2024. end;
  2025. Function GetY: Integer;
  2026. Begin
  2027. GetY := CurrentY;
  2028. end;
  2029. Function GetDriverName: string;
  2030. var
  2031. mode: PModeInfo;
  2032. begin
  2033. GetDriverName:=DriverName;
  2034. end;
  2035. procedure graphdefaults;
  2036. { PS: GraphDefaults does not ZERO the ArcCall structure }
  2037. { so a call to GetArcCoords will not change even the }
  2038. { returned values even if GraphDefaults is called in }
  2039. { between. }
  2040. var
  2041. i: integer;
  2042. begin
  2043. lineinfo.linestyle:=solidln;
  2044. lineinfo.thickness:=normwidth;
  2045. { reset line style pattern }
  2046. for i:=0 to 15 do
  2047. LinePatterns[i] := TRUE;
  2048. { By default, according to the TP prog's reference }
  2049. { the default pattern is solid, and the default }
  2050. { color is the maximum color in the palette. }
  2051. fillsettings.color:=GetMaxColor;
  2052. fillsettings.pattern:=solidfill;
  2053. { GraphDefaults resets the User Fill pattern to $ff }
  2054. { checked with VGA BGI driver - CEC }
  2055. for i:=1 to 8 do
  2056. FillPatternTable[UserFill][i] := $ff;
  2057. CurrentColor:=white;
  2058. SetBkColor(Black);
  2059. ClipPixels := TRUE;
  2060. { Reset the viewport }
  2061. StartXViewPort := 0;
  2062. StartYViewPort := 0;
  2063. ViewWidth := MaxX;
  2064. ViewHeight := MaxY;
  2065. { Reset CP }
  2066. CurrentX := 0;
  2067. CurrentY := 0;
  2068. { normal write mode }
  2069. CurrentWriteMode := CopyPut;
  2070. { Schriftart einstellen }
  2071. CurrentTextInfo.font := DefaultFont;
  2072. CurrentTextInfo.direction:=HorizDir;
  2073. CurrentTextInfo.charsize:=1;
  2074. CurrentTextInfo.horiz:=LeftText;
  2075. CurrentTextInfo.vert:=TopText;
  2076. XAspect:=10000; YAspect:=10000;
  2077. end;
  2078. procedure GetAspectRatio(var Xasp,Yasp : word);
  2079. begin
  2080. XAsp:=XAspect;
  2081. YAsp:=YAspect;
  2082. end;
  2083. procedure SetAspectRatio(Xasp, Yasp : word);
  2084. begin
  2085. Xaspect:= XAsp;
  2086. YAspect:= YAsp;
  2087. end;
  2088. procedure SetWriteMode(WriteMode : integer);
  2089. begin
  2090. if (writemode<>xorput) and (writemode<>CopyPut) then
  2091. exit;
  2092. CurrentWriteMode := WriteMode;
  2093. end;
  2094. procedure GetFillSettings(var Fillinfo:Fillsettingstype);
  2095. begin
  2096. Fillinfo:=Fillsettings;
  2097. end;
  2098. procedure GetFillPattern(var FillPattern:FillPatternType);
  2099. begin
  2100. FillPattern:=FillpatternTable[UserFill];
  2101. end;
  2102. procedure DrawPoly(numpoints : word;var polypoints);
  2103. type
  2104. ppointtype = ^pointtype;
  2105. pt = array[0..16000] of pointtype;
  2106. var
  2107. i : longint;
  2108. begin
  2109. if numpoints < 2 then
  2110. begin
  2111. _GraphResult := grError;
  2112. exit;
  2113. end;
  2114. for i:=0 to numpoints-2 do
  2115. line(pt(polypoints)[i].x,
  2116. pt(polypoints)[i].y,
  2117. pt(polypoints)[i+1].x,
  2118. pt(polypoints)[i+1].y);
  2119. end;
  2120. procedure PieSlice(X,Y,stangle,endAngle:integer;Radius: Word);
  2121. var angle : real;
  2122. XRadius, YRadius : word;
  2123. writemode : word;
  2124. begin
  2125. Arc(x,y,StAngle,EndAngle,Radius);
  2126. Line(ArcCall.XStart, ArcCall.YStart, x,y);
  2127. Line(x,y, ArcCall.XEnd, ArcCall.YEnd);
  2128. { must use PutPixel() instead of DirectPutPixel because we need }
  2129. { clipping... }
  2130. PutPixel(ArcCall.xstart,ArcCall.ystart,CurrentColor);
  2131. PutPixel(x,y,CurrentColor);
  2132. PutPixel(ArcCall.xend,ArcCall.yend,CurrentColor);
  2133. Stangle:=stAngle mod 360; EndAngle:=Endangle mod 360;
  2134. if Stangle<=Endangle then
  2135. angle:=(StAngle+EndAngle)/2
  2136. else
  2137. angle:=(Stangle-360+Endangle)/2;
  2138. { fill from the point in the middle of the slice }
  2139. XRadius:=(longint(Radius)*10000) div XAspect;
  2140. YRadius:=(longint(Radius)*10000) div YAspect;
  2141. { avoid rounding errors }
  2142. if abs(ArcCall.xstart-ArcCall.xend)
  2143. +abs(ArcCall.ystart-ArcCall.yend)>2 then
  2144. { FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
  2145. y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);}
  2146. CurrentWriteMode := writemode;
  2147. end;
  2148. {$i fills.inc}
  2149. {$i text.inc}
  2150. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;
  2151. const PathToDriver:String);
  2152. var i,index:Integer;
  2153. LoMode, HiMode: Integer;
  2154. CpyMode: Integer;
  2155. CpyDriver: Integer;
  2156. begin
  2157. { path to the fonts (where they will be searched)...}
  2158. bgipath:=PathToDriver;
  2159. if bgipath[length(bgipath)]<>'\' then
  2160. bgipath:=bgipath+'\';
  2161. { make sure our driver list is setup...}
  2162. QueryAdapterInfo;
  2163. if not assigned(SaveVideoState) then
  2164. RunError(216);
  2165. SaveVideoState;
  2166. InitVars;
  2167. DriverName:=InternalDriverName; { DOS Graphics driver }
  2168. if (Graphdriver=Detect) then
  2169. begin
  2170. HiMode := -1;
  2171. LoMode := -1;
  2172. { We start at VGA-1 }
  2173. GraphDriver := VGA;
  2174. CpyMode := 0;
  2175. { search all possible graphic drivers in ascending order...}
  2176. { usually the new driver numbers indicate newest hardware...}
  2177. { Internal driver numbers start at VGA=9 }
  2178. repeat
  2179. GetModeRange(GraphDriver,LoMode,HiMode);
  2180. { save the highest mode possible...}
  2181. if HiMode = -1 then break;
  2182. CpyMode:=HiMode;
  2183. CpyDriver:=GraphDriver;
  2184. { go to next driver if it exists...}
  2185. Inc(GraphDriver);
  2186. until (CpyMode=-1);
  2187. IntCurrentDriver := CpyDriver;
  2188. { If this is equal to -1 then no graph mode possible...}
  2189. if CpyMode = -1 then
  2190. begin
  2191. _GraphResult := grNotDetected;
  2192. exit;
  2193. end;
  2194. { Actually set the graph mode...}
  2195. SetGraphMode(CpyMode);
  2196. end
  2197. else
  2198. begin
  2199. { Search if that graphics modec actually exists...}
  2200. if SearchMode(GraphDriver,GraphMode) = nil then
  2201. begin
  2202. _GraphResult := grInvalidMode;
  2203. exit;
  2204. end
  2205. else
  2206. begin
  2207. IntCurrentDriver := GraphDriver;
  2208. SetGraphMode(GraphMode);
  2209. end;
  2210. end;
  2211. end;
  2212. procedure SetDirectVideo(DirectAccess: boolean);
  2213. begin
  2214. DirectVideo := DirectAccess;
  2215. end;
  2216. function GetDirectVideo: boolean;
  2217. begin
  2218. GetDirectVideo := DirectVideo;
  2219. end;
  2220. var
  2221. ExitSave: pointer;
  2222. begin
  2223. ModeList := nil;
  2224. SaveVideoState := nil;
  2225. RestoreVideoState := nil;
  2226. { This must be called at startup... because GetGraphMode may }
  2227. { be called even when not in graph mode. }
  2228. QueryAdapterInfo;
  2229. { Install standard fonts }
  2230. { This is done BEFORE startup... }
  2231. InstalledFonts := 0;
  2232. InstallUserFont('TRIP');
  2233. InstallUserFont('LITT');
  2234. InstallUserFont('SANS');
  2235. InstallUserFont('GOTH');
  2236. { This installs an exit procedure which cleans up the mode list...}
  2237. ExitSave := ExitProc;
  2238. ExitProc := @CleanMode;
  2239. end.
  2240. PieSlice
  2241. Sector
  2242. SetGraphBufSize
  2243. SetBkColor
  2244. DetectGraph
  2245. { DetectGraph() }
  2246. { SetBkColor() }