home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GRFTXT.ZIP / GTXTDEMO.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-02-02  |  8.9 KB  |  307 lines
  1. {$I+}    {I/O checking on}
  2. program GtxtDemo;      {Fast display of Text in Graphics mode.}
  3.                        {works on horizontal 8 pixel boundaries }
  4.                        {EGA/VGA only - (tested on EGA only: comments welcomed!}
  5.                        {Author: Tim Godfrey, 72617,2125 }
  6.                        {Previous version loaded Fonts as .OBJ files into TPU }
  7.                        {New Version 27 Jan 89 }
  8.                        {Fixed bug in ASMs causing eventual stack overflow}
  9.                        {Added SetYOfset to allow "Pseudo Paging" for EGA modes}
  10.                        {to write on second page, just add 350 to Y coordinates}
  11.                        {New Version 1 Feb 89 }
  12.                        {Added true paging support of SetActivePage and
  13.                        { SetVisualPage from the Graph Unit}
  14.  
  15.  
  16. Uses
  17.   Crt,Graph,graftext,break;
  18.  
  19. type
  20.    hstype        =   string[2];
  21.    filenametype  =   string[24];
  22.  
  23. var
  24.    err,fchar,xline,idx      :   integer;
  25.    teststr                  :   string;
  26.    resxstr,resystr          :   string[10];
  27.    rowaray                  :   array [0..255] of byte;
  28.    dot,fpix,lentxtpix       :   integer;
  29.    maxtextlines             :   integer;
  30.    akey                     :   char;
  31.    numstr                   :   string[10];
  32.    z,yofs,startaddr           :   word;
  33.  
  34. {----------------Graphics Support Section--------------------}
  35.  
  36.  
  37. const
  38.   { The names of the various device drivers supported }
  39.   DriverNames : array[0..10] of string[8] =
  40.   ('Detect', 'CGA', 'MCGA', 'EGA', 'EGA64', 'EGAMono',
  41.    'RESERVED', 'HercMono', 'ATT400', 'VGA', 'PC3270');
  42.  
  43.   { The five fonts available }
  44.   Fonts : array[0..4] of string[13] =
  45.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  46.  
  47.   { The five predefined line styles supported }
  48.   LineStyles : array[0..4] of string[9] =
  49.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  50.  
  51.   { The twelve predefined fill styles supported }
  52.   FillStyles : array[0..11] of string[14] =
  53.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  54.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  55.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  56.  
  57.   { The two text directions available }
  58.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  59.  
  60.   { The Horizontal text justifications available }
  61.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  62.  
  63.   { The vertical text justifications available }
  64.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  65.  
  66. var
  67.   GraphDriver : integer;  { The Graphics device driver }
  68.   GraphMode   : integer;  { The Graphics mode value }
  69.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  70.   ErrorCode   : integer;  { Reports any graphics errors }
  71.   MaxColor    : word;     { The maximum color value available }
  72.   OldExitProc : Pointer;  { Saves exit procedure address }
  73.   textx,texty : word;
  74.  
  75. {$F+}
  76. procedure MyExitProc;
  77. begin
  78.   ExitProc := OldExitProc; { Restore exit procedure address }
  79.   CloseGraph;              { Shut down the graphics system }
  80. end; { MyExitProc }
  81. {$F-}
  82.  
  83. procedure Initialize;
  84. { Initialize graphics and report any errors that may occur }
  85. begin
  86.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  87.   DirectVideo := False;
  88.   OldExitProc := ExitProc;                { save previous exit proc }
  89.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  90. if (paramcount>0) and ((paramstr(1)='/V') or (paramstr(1)='/v')) then begin
  91.   GraphDriver := VGA;
  92.   graphmode := VGAHi;
  93.   end
  94. else if (paramcount>0) and ((paramstr(1)='/E') or (paramstr(1)='/e')) then begin
  95.   GraphDriver := EGA;
  96.   graphmode := EGAHi;
  97.   end
  98.  
  99.   else
  100.   graphdriver := detect;
  101.  
  102.   InitGraph(GraphDriver, graphmode,'..');  { activate graphics }
  103.   ErrorCode := GraphResult;               { error? }
  104.   if ErrorCode <> grOk then
  105.   begin
  106.     Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  107.     writeln('Note - as written, this program expects to find EGAVGA.BGI in the');
  108.     writeln('parent of the current directory. A /V parameter will force VGA mode.');
  109.  
  110.     Halt(1);
  111.   end;
  112.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  113.   MaxX := GetMaxX;          { Get screen resolution values }
  114.   MaxY := GetMaxY;
  115. end; { Initialize }
  116.  
  117.  
  118. type hexstr = string[10];
  119.  
  120. function Hex(Number:Integer;Bytes:integer):hexstr;
  121.  
  122. const
  123.   T : array[0..15] of char = '0123456789ABCDEF';
  124.  
  125. var
  126.   D : integer;
  127.   H : hexstr;
  128.  
  129. begin H[0]:=chr(bytes+bytes);
  130.  for D:=bytes+bytes downto 1 do begin
  131.    H[D]:=T[number and 15];
  132.    Number:=Number shr 4;
  133.  end;
  134.  Hex:=H;
  135. end;
  136.  
  137.  
  138.  
  139.  
  140. {_______________________________________________________}
  141.  
  142. {-----------------Mainline Program-----------------------}
  143.  
  144.  
  145. begin
  146.  
  147. teststr := 'This is a test 01234567890 (8x8 font) ';
  148.  
  149. Initialize;  {graphics activation}
  150.  
  151. maxtextlines := (Maxy div 8) -1;
  152. str(1+maxx,resxstr);
  153. str(1+maxy,resystr);
  154. teststr := resxstr+'x'+resystr+' test 01234567890 (8x8 font) ';
  155.  
  156.  
  157. setfillStyle(widedotfill,darkgray);
  158.  
  159.  
  160. Bar(0,0,Maxx,Maxy);
  161.  
  162. for idx := 0 to 15 do
  163.    Gtxtsol(8,(9*idx),blue,idx,8,@font8,teststr);
  164. for idx := 0 to 15 do
  165.    Gtxtsol(8,(MaxY div 2)+(9*idx),red,idx,8,@font8,teststr);
  166. for idx := 0 to 15 do
  167.    Gtxtsol(10+(MaxX div 2),(9*idx),green,idx,8,@font8,teststr);
  168. for idx := 0 to 15 do
  169.    Gtxtsol(10+(MaxX div 2),(MaxY div 2)+(9*idx),darkgray,idx,8,@font8,teststr);
  170.  
  171.  
  172.    Akey := readkey;
  173.  
  174.  
  175. {----------------------------------}
  176.  
  177. Bar(0,0,Maxx,Maxy);
  178.  
  179. teststr := resxstr+'x'+resystr+' test 01234567890 (8x14 font) ';
  180.  
  181. for idx := 0 to 7 do
  182.    Gtxtsol(8,(15*idx),blue,idx,14,@font14,teststr);
  183. for idx := 0 to 7 do
  184.    Gtxtsol(8,(MaxY div 3)+(15*idx),red,idx,14,@font14,teststr);
  185. for idx := 0 to 7 do
  186.    Gtxtsol(10+(MaxX div 2),(15*idx),green,idx,14,@font14,teststr);
  187. for idx := 0 to 7 do
  188.    Gtxtsol(10+(MaxX div 2),(MaxY div 3)+(15*idx),darkgray,idx,14,@font14,teststr);
  189. for idx := 0 to 7 do
  190.    Gtxttran(8,(2*(MaxY div 3))+(15*idx),idx,14,@font14,teststr);
  191. for idx := 0 to 7 do
  192.    Gtxttran(10+(MaxX div 2),(2*(MaxY div 3))+(15*idx),8+idx,14,@font14,teststr);
  193.  
  194.  
  195. Akey := readkey;
  196.  
  197. GtxtSol(0,450,blue,white,14,@font14,'Scrolled image. This line is 450, top is 350');
  198.  
  199. for yofs := 0 to 350 do begin   {use loop here to make scrolling visible}
  200.     delay(2);
  201.     SetYofset(yofs);
  202.     end;
  203.  
  204. Akey := readkey;
  205.  
  206. for yofs :=  349 downto 0 do begin
  207.     delay(2);
  208.     SetYofset(yofs);
  209.     end;
  210.  
  211. Akey := readkey;
  212. Bar(0,0,Maxx,Maxy);
  213. setactivepage(1);
  214. setvisualpage(1);
  215.  
  216. setfillStyle(ltbkSlashFill,darkgray);
  217. Bar(0,0,Maxx,Maxy);
  218. setcolor(green);
  219. line(0,0,maxx,maxy);
  220. GtxtSol(0,10,blue,white,14,@font14,'Now on second page using SetActivePage(1)');
  221. GtxtSol(8,100,blue,white,14,@font14,'BIOS buffer addr = '+hex(mem[$40:$4E],1));
  222. GtxtSol(8,200,blue,white,14,@font14,'BIOS vid.page addr= '+hex(mem[$40:$62],1));
  223. If maxy>350 then begin
  224.     GtxtSol(0,300,blue,white,14,@font14,'As you can see, there aren''t two');
  225.     GtxtSol(0,315,blue,white,14,@font14,'independant pages available in');
  226.     GtxtSol(0,330,blue,white,14,@font14,'480 line graphic modes');
  227.     GtxtSol(0,345,blue,white,14,@font14,'Run GTXTDEMO with /E switch');
  228.     GtxtSol(0,360,blue,white,14,@font14,'To see paging at EGA 350 lines');
  229.  
  230.     end;
  231.  
  232.  
  233.  
  234. Akey := readkey;
  235. setactivepage(0);
  236. setvisualpage(0);
  237. GtxtSol(0,50,blue,white,14,@font14,'Now on first page using SetActivePage(0)');
  238. GtxtSol(8,100,blue,white,14,@font14,'BIOS buffer addr = '+hex(mem[$40:$4E],1));
  239. GtxtSol(8,200,blue,white,14,@font14,'BIOS vid.page addr= '+hex(mem[$40:$62],1));
  240. Akey := readkey;
  241.  
  242.  
  243. {rapidly alternate between pages}
  244. if maxy <= 350 then
  245.   for z := 1 to 12 do begin
  246.     delay(12);
  247.     setvisualpage(1);
  248.     delay(12);
  249.     setvisualpage(0);
  250.     end;
  251.  
  252.  
  253. teststr := 'These lines use GtxtSol for speed';
  254. setfillStyle(widedotfill,darkgray);
  255. Bar(0,0,Maxx,Maxy);
  256.  
  257. for idx := 0 to maxtextlines do
  258.    GtxtSol(8,(8*idx),black,idx mod 15,8,@font8,teststr);
  259.  
  260. teststr := 'These lines use OutTextXY ..slower.';
  261.  
  262. setfillstyle(solidfill,black);
  263. for idx := 0 to maxtextlines do  begin
  264.    setcolor(idx mod 15);                      {separate command to set color}
  265.    bar((MaxX div 2),(8*idx),(MaxX div 2)+textwidth(teststr),(8*idx)+textheight(teststr));
  266.                                                         {clear background}
  267.    outtextxy((MaxX div 2),(8*idx),teststr);                      {write the string}
  268.    end;
  269.  
  270.  
  271. Akey := readkey;
  272.  
  273. setfillStyle(widedotfill,darkgray);
  274. teststr := 'These lines use GtxtTran for speed';
  275. Bar(0,0,Maxx,Maxy);
  276.  
  277. for idx := 0 to maxtextlines do
  278.    Gtxttran(8,(8*idx),idx mod 15,8,@font8,teststr);
  279.  
  280. teststr := 'These lines use OutTextXY ..slower.';
  281.  
  282.  
  283. for idx := 0 to maxtextlines do  begin
  284.    setcolor(idx mod 15);
  285.    outtextxy((MaxX div 2),(8*idx),teststr);
  286.    end;
  287.  
  288.  
  289. Akey := readkey;
  290.  
  291.  
  292. CloseGraph;
  293. end.
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.