GetMaxX
program VTM_GRAPHICS ;  uses Graph,Crt,Dos,Win;  Type forty=string[40];       Func=record           
   f:string[40];  c:0..15            end;       AllFunc=array [1..15] of Func;       C_Size=record  
              XPos,YPos : 0..21;                Size:1..10 ;                Fas,Cas:boolean;        
        Ex:array[1..8] of 0..99              end;       Subrange=record                  Min,Max:lon
gint                end;       ConfigFile=record                  Sz:C_Size;  Sub:Subrange          
      end;       SSType=(User,ReDraw);       dgtype=(cls,normal);       sk=array['A'..'Z'] of real; 
 Const Main='    F2=Draw  F3=Clear  F4=New  F5=FuncEdit  F6=Menu  F7=ChColor  F8=Quit ';        SzLn
='                          '#24','#25'=Choose  Esc=Quit     ';      LnHelp='               '#24','#
25','#26','#27+'=Move Lines   Enter=O.K.        ';      MnHelp='                   Enter lowest x va
lue and press <Enter>';      MxHelp='                  Enter highest x value and press <Enter>';    
    Sect='         With '+#24+','+#25+', change one sector size and press <Enter>';  Var xs:Subrange
; xp,yp:0..21; ska:sk;      fnow:0..15;   grd,grm:integer;      First:Boolean;      Ww:WinState;Wp:P
ointer;Ws:Word;      af:AllFunc;   cnf:c_size;      W:pointer;    isize:word; ccc:byte;      exx:arr
ay [1..15] of 0..99;{$I vtm\VTM11   .pas       }{$I vtm\Find    .pas       }{$I vtm\dalis   .pas    
   }{$I vtm\rw      .pas       }{$I vtm\WriteF  .pas       }{$I vtm\FncEdit .pas       }{$I vtm\ChCo
lor .pas       }{$I vtm\dalis2  .pas       }{$I vtm\tekstai .pas       }{ллллллллллллллллллллллллллл
ллллллллллллллллллллллллллллллллллллллллллллл }  procedure TestGraph;  begin    GrD := Detect;    In
itGraph(GrD, GrM, '');    {if GraphResult <> grOk       then begin              Write('BGI error:',G
raphErrorMsg(GraphResult));Halt(1)            end;    }   { SetGraphMode(2);   }    if GetMaxX<639  
     Then begin              CloseGraph;              RestoreWin(ww);              WriteWin(Wp^);   
           FreeMem(Wp,Ws);              Writeln(GetMaxX,'x',GetMaxY,' pixels?..');              Writ
eln(#7,'It''s too less for VTM graphics!');              Halt(1)            end  end;  procedure WND
W ( Tp:boolean; fs:byte);  begin    if tp then begin                  isize:=ImageSize(97,297,533,38
3);                  GetMem (w,isize); GetImage(97,297,533,383,w^);                  SFS(1,0); bar (
181,307,533,383);                  SFS(1,8); bar (107,307,179,383);                  SFS(1,fs); bar 
(97,297,523,373);                  sc(15);RectAngle(100,300,520,370);               end           el
se begin                  PutImage (97,297,W^,CopyPut);                  FreeMem (W,isize)          
      end  end;  Procedure Start;    var a,b:string;  begin    FillChar(exx,SizeOf(exx),1);    sts (
0,0,0); sfs(1,7); sc(15);    bar(0,0,180,460); line(0,460,640,460);    ra(0,0,180,460);    ra(0,0,63
9,479);    tt(6,6,'Function  1');    line(1,16,179,16);    Frame(4,154,176,200,True);    Frame(4,100
,176,140,True);    tt(16,116,'Exactness:');    Frame(4,406,176,446,true);    OutTextXY(3,410,' Graph
ics Version 1.2');    OutTextXY(3,422,'  Copyright (C) 1993 ');    OutTextXY(5,434,'   VTM Corporati
on   ');    if First then begin ReadFunc; ReadCnf end;    sts(0,0,0);    tt(12,162,'One  section = '
+scl(cnf.size));    str(xs.min,a); str(xs.max,b);    tt(12,182,'X in '+a+'..'+b);    str(cnf.ex[cnf.
size],b);    sts(0,0,2);    tt(144,112,b);    sts(0,0,0);    WriteF;    HelpLine(Main);    sts(0,0,2
);  end;  procedure SizeSet (par :sstype);    label 11;    var a,a2,k:byte; pr:Word;    procedure sc
aleset;      var k:byte; th:string;    begin      HelpLine(Sect);      k:=ork;      sts(0,0,0);     
 while (k<>13) do begin        if k=0 then begin           k:=ork;           case k of             7
2:with cnf do                  if size>1 then size:=size-1 else size:=8;             80:with cnf do 
                 if size<8 then size:=size+1 else size:=1           end;           sc(0);tt(122,pr+2
,'лллллл');           sc(15);tt(122,pr+2,scl(cnf.size))        end;        k:=ork      end;      sc(
7);      tt(124,162,'лллллл');      SetFillStyle(1,0);      bar(182,2,638,458);      sc(15);lines;  
    tt(124,162,scl(cnf.size));      sts(0,0,2);      str(cnf.ex[cnf.size],th);      sfs(1,7);bar(140
,101,175,139);      tt(144,112,th);      ScaleOn;HelpLine(SzLn)    End;    procedure LinesSet;      
var k:byte;    begin      HelpLine(LnHelp);      sfs(1,0);bar (181,1,638,459);      sc(15);Lines;k:=
ork;      while k<>13 do begin        if k=0 then begin           k:=ork;           sc(0);lines;    
       case k of             72:if xp>0 then xp:=xp-1 else xp:=21;             80:if xp<21 then xp:=
xp+1 else xp:=0;             75:if yp>0 then yp:=yp-1 else yp:=21;             77:if yp<21 then yp:=
yp+1 else yp:=0           end;           sc(15);lines         end;         k:=ork       end;       c
nf.xpos:=xp;       cnf.ypos:=yp;       ScaleOn;       HelpLine(SzLn)     End;     procedure SubSet; 
      var Size:word; mn,mx:longint; hr:Byte;           error:boolean; v:pointer; a,b:string;       p
rocedure ReadSk(var sk :longint);         var a:string; b:char; ec,c:integer;         label 1;      
 begin  sc(hr);         a:=''; tt(222,312,'_');       1:b:=readkey;       while (ord(b)<>13) and (or
d(b)<>27) do begin         if b=#8 then a:=copy(a,1,length(a)-1)                 else if length(a)<6
                         then if b in ['-','0'..'9']                                 then a:=a+b    
                             else                         else Beep;         SetFillStyle(1,7);     
    bar(222,312,334,328);         tt(222,312,a+'_');         b:=readkey;       end;       ec:=0;    
   if b=#27 then sk:=-20000001                else val (a,sk,ec);       if (ec<>0)  then begin      
                 Beep;                       tt(142,342,'Error.Press Esc');                       wh
ile c<> 27 do c:=ork;                       sc(7);                       tt(142,342,'ллллллллллллллл
лллл');                       tt(222,312,'ллллллллллллллллл');                       sc(hr);a:=''; g
oto 1                     end       end;       Procedure Control(n1,n2:longint;var error: boolean); 
      begin         if n1>n2  then begin                          sc(hr);                          t
t(142,352,'Min>Max?!');                          error:=true;delay(2000); sc(7);                    
      tt(142,352,'ллллллллллл');                          sc(hr);                          mn:=-2000
0000;                          mx:=-20000000                        end                   else error
:=false       end;     begin                                        hr:=14;       SetFillStyle(1,7);
       wndw(true,7);       error:=true; mn:=-20000000;       mx:=-20000000;       while error do beg
in sc(hr);         while mn=-20000000 do begin           HelpLine(MnHelp);           tt(162,312,'Min
:');           readsk(mn);sc(7);           tt(162,312,'лллллллллллллллл');sc(hr)         end;       
  while mx=-20000000 do begin           HelpLine(MxHelp);           tt(162,312,'Max:');           re
adsk(mx);sc(7);           tt(162,312,'лллллллллллллллл')         end  ;         if (mn<>-20000001) a
nd (mx<>-20000001)          then control(mn,mx,error)          else error:=false       end;       wn
dw(false,0);       HelpLine(SzLn);       if mn<>-20000001 then xs.min:=mn;       if mx<>-20000001 th
en xs.max:=mx;       sc(7);str(xs.max,a);str(xs.min,b);       sts(0,0,0);       tt(52,182,'ллллллллл
ллллл');sc(15);       tt(52,182,b+'..'+a);sts(0,0,2)     end;     procedure wr(l:byte);     begin   
    tt(2,pr+l*10+2,n(l));     end;   BEGIN   IF PAR=USER THEN BEGIN     HelpLine(SzLn);     pr:=240;
     sts(0,0,0);     sc(15);     tt(65,pr-16,'Menu');     Line(60,pr-6,100,pr-6);     sfs(1,0);     
Bar(1,pr,179,pr+10);     for a:=0 to 9 do Wr(a);     a:=0;a2:=0;  11:k:=ork;     while (k<>13) and (
k<>27) do begin       if k=0 then begin          k:=ork;          a2:=a;          case k of         
   72 : if a=0 then a:=9 else a:=a-1;            80 : if a=9 then a:=0 else a:=a+1          end;    
      if a2<>a then begin                          sfs(1,7);                          bar (1,pr+a2*1
0,179,pr+a2*10+10);wr(a2);                          sfs(1,0);bar(1,pr+a*10,179,pr+a*10+10);         
                 Wr(a)                        end       end;       k:=ork     end;     if k=13      
  then begin               case a of                0:ScaleSet;                1:LinesSet;          
      2:subset;                3:begin WriteFunc;  HelpLine(SzLn) end;                4:begin SaveCo
nfiguration(Cnf); HelpLine(szln) end;                5:begin ChColor; HelpLine(SzLn) end;           
     6:begin                    Cnf.Fas:=Not Cnf.Fas; sc(0);                    tt(122,pr+62,'ллл');
sc(15);tt(122,pr+62,Sb(Cnf.Fas))                  end;                7:begin                    Cnf
.Cas:=Not Cnf.Cas; sc(0);                    tt(122,pr+72,'ллл');sc(15);tt(122,pr+72,Sb(Cnf.Cas))   
               end;                8:begin ReadFunc;  WriteF; HelpLine(SzLn) end;                9:b
egin ReadCnf; HelpLine(SzLn) end;               end;               sts(0,0,0);               Sc(15);
               goto 11             end;     sfs (1,7); bar (1,pr-16,179,pr+110);     HelpLine(Main) 
  END   ELSE BEGIN          sfs(1,0);          bar (181,1,638,459);          sc(15);          Lines;
ScaleOn        END  End;  function klaida:Boolean;    var g:string; k:Byte; ab:boolean;    procedure
 WrM(a:boolean);      var c1,c2:0..15;    begin      if a then begin c1:=4; c2:=15 end           els
e begin c2:=4; c1:=15 end;      sfs(1,c1);bar(120,330,280,347);      sfs(1,c2);bar(350,330,510,347);
      sc(c2); tt(140,332,'Continue');      sc(c1);tt(390,332,'Cancel')    end;  begin    Wndw(true,4
); ab:=false; sc(15); sts(0,0,0); str(ska['X'],g);    G:=' Draw time error at x='+g; tt(142,316,g);S
ts(0,0,2);Wrm(ab);    Beep;    k:=ork;if k=0 then k:=ork;    While k<>13 do begin      ab:=not ab;Wr
m(ab);k:=ork;if k=0 then k:=ork    end;    klaida:=ab; Wndw(false,0);  end;  procedure DrawGraph(a:d
gtype);    var rs : subrange;        f:string; d:real;        k,e,err,kx,ky:integer;        x,y,x1,y
1,l:longint;m:real;  begin    x:=0; x1:=0; y:=0; y1:=0;    case cnf.size of       1  :begin         
    rs.min:=-round(yp*0.2+1);             rs.max:= round((21-yp)*0.2+1);m:=0.2/20;           end;   
    2  :begin             rs.min:=-round(yp*0.5+1);             rs.max:= round((21-yp)*0.5+1);m:=0.5
/20;           end     else  begin             val(scl(cnf.size),e,err);           {  l:=round(50*(1
/e))+1;     }             rs.min:=-round(yp*e);m:=e/20;             rs.max:=round((21-yp)*e)        
   end    end;    l:=cnf.ex[cnf.size];    if a=cls then l:=exx[fnow];    if rs.min<xs.min then rs.mi
n:=xs.min;    if rs.max>xs.max then rs.max:=xs.max;    x1:=0; y1:=0;    f:=compact(af[fnow].f);    k
x:=200+yp*20;    ky:=20+ xp*20;    if a=Normal then begin                       HelpLine('          
          Drawing... <Esc> quits');                       sc(af[fnow].c) ;                       exx
[fnow]:=l;                     end                else begin                       HelpLine('       
             Clearing... <Esc> quits');                       sc(0)                     end;    for 
e:=rs.min to rs.max-1 do      for k:=1 to l do begin        ska['X']:=e+k/l;        d:=value(f);    
    if (d=2E+4) and (a=Normal)           then if klaida then begin HelpLine(Main);exit end          
                 else sc(af[fnow].c);        if KeyPressed then if readkey=#27 then begin HelpLine(M
ain);Exit end;        y:=ky-round(d/m) ;        x:=kx+round(ska['X']/m);        if  (y >20) and (y<4
40) and (y1<440) and (y1 >20)            and (x1>200) and(x>200)and(x<620) and(x1<620)            th
en line(x,y,x1,y1);        x1:=x; y1:=y      end;      if a=CLS then begin sc(15); Lines; ScaleOn en
d;      Beep;      HelpLine(Main)  end;  Procedure GraphEdit;    var grd,grm,key:integer; tg:string;
    Function AskAndQuit:boolean;      var k:char; Size:word; v:pointer;    begin      HelpLine('    
                 Y=Quit   Any other key=Cancel     ');      wndw(true,4);sc(15);      SetTextStyle(0
,0,2);      tt(103,312,'Do you really want to quit');      tt(102,342,'   VTM Graphics (Y/N) ?');   
   k:=readkey; wndw(false,0);      HelpLine(Main);      if upcase(k)='Y' then AskAndQuit:=true      
                 else AskAndQuit:=false    end;  Begin    TestGraph;    Start;    First:=False;    S
izeSet(ReDraw);    key:=ork;    While True do begin      case key of        0:begin           key :=
 ork;           case key of            72:begin                 if fnow>1 then fnow:=fnow-1 else fno
w:=15;                 WriteF               end;            80:begin                 if fnow<15 then
 fnow:=fnow+1 else fnow:=1;                 WriteF               end;            60:DrawGraph(Normal
);            61:DrawGraph(cls);            62:SizeSet(Redraw);            63:FuncEdit;            6
4:SizeSet(User);            65:begin ChColor; HelpLine(Main) end;            66:if AskAndQuit then b
egin                                    if Cnf.Cas                                       then SaveCo
nfiguration(cnf);                                    if Cnf.Fas                                     
  then WriteFunc;                                    closegraph; exit                               
   end           end         end;         48..57:begin                  with Cnf do                 
   ex[size]:= ex[size] mod 10*10 +key-ord('0');                  str(cnf.ex[cnf.size],tg);          
        sc(15);sts(0,0,2);                  sfs(1,7);bar(140,101,175,139);                  if cnf.e
x[cnf.size]<10 then tg:='0'+tg;                  tt(144,112,tg);                  sts(0,0,0)        
        end;      end;      key:=ork;    end;  end;  BEGIN {****************************************
********}    Fnow:=1;First:=true;    Writeln('Graphics version 1.2 .Copyright (C) 1993 VTM Corporati
on.');    Writeln('                   Wellcome !                            ');    SaveWin(WW);    W
s:=WinSize;    GetMem(Wp,ws);    ReadWin(Wp^);    Delay(500);    Ska['E']:=exp(1.0);    Ska['P']:=pi
;    GraphEdit;    RestoreWin(ww);    WriteWin(Wp^);    FreeMem(Wp,Ws);    Writeln;    Writeln('    
      Thank you for using VTM corporation product.');    Writeln('                       Good luck !
                    ')  END.