[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    { SWAG NOTE :  Other unit and Demos at BOTTOM ! }

    {
    LCD.PAS
    Written by Leopoldo Salvo Massieu, april 92. e-mail a900040@zipi.fi.upm.es
    Freeware.

    Written for Borland Pascal 7.0.

    This units implement scalable lcd displays for numerical output in graphics mode.
    Works in any graphic mode. Works in real and protected mode applications.

    Restrictions: Digits must be at most 254 pixels wide horizontally
                    (the digit width is equal to the width of the lcd display divided into the number of digits)
    }

    Unit LCD;
    Interface
     Uses Graph;
         {Uses getmaxx,getmaxy,setcolor,putpixel,bar}

     Type PDisplay = ^Display;
          Display = object
                       private
                         xi,yi,xf,yf : integer;
                         num_cars : byte;
                         col_on, col_off : word;
                         graficos : array [1..9] of pointer;
                         tamano_graficos : array [1..9] of word;
                         buffer : array [1..40] of byte;
                         desbordado : boolean;
                       public

                         constructor init (x1,y1,x2,y2:integer;num_digits:byte;
                                         forecolor,backcolor:word);
       {coordinates of top-left and bottom-right corners, number of digits in the
        display (without counting the decimal point), and color of foreground and
        background}

                         destructor done;
       {Releases memory}

                         procedure display_string (cadena_num:string);
       {Writes a string (only numbers will be displayed)}

                         procedure display_real (ndecimals: integer; r:real);
       {Writes a real with n decimals (use 0 for integers)}

                         procedure redraw;
                    end;

    Implementation
      Const
        palotes_x_digito = 9; {7 segments for each digit, plus the decimal point and an overflow point at the top-left}
        no_error =  0;
      Type
        st40 = string[40];
        digi_font = (cero,uno,dos,tres,cuatro,cinco,seis,siete,ocho,nueve,e,desbordamiento,espacio,menos,punto);
                  {these are all the characters that can be displayed ['0'..'9','E','-',' ', '.'].
                   The '+' caracter is displayed as an space.}
        digi_palo = array[1..6] of pointtype;
                  {each segment has at most 6 extremes (end points)}
        digi_data = array[1..palotes_x_digito] of record
                                                   data:digi_palo;
                                                   longitud: byte;
                                                  end;
                  {number of extremes and the extremes themselves for all segments}
        digi_masc = record              {esta es una forma de guardar los 'trozos' de digito en}
                     esq_si : pointtype;{memoria sin que ocupe demasiado espacio en memoria}
                     num_lin: byte;
                     datos : array[1..256] of record
                                               p,u:byte;
                                              end;
                    end;
                  {structure to keep the scaled segments in memory (only necessary mem allocated, tipycally <256)}
        digi_memo = array[1..palotes_x_digito] of ^digi_masc;
        digi_st   = array[1..40] of digi_font;
      Const
        {this codes what segments must be lighted for each character}
        caracteres : array[cero..punto,1..palotes_x_digito] of boolean =
                      ((true,true,true,false,true,true,true,false,false),      {cero/0}
                       (false,false,true,false,false,true,false,false,false),  {uno/1}
                       (true,false,true,true,true,false,true,false,false),     {dos/2}
                       (true,false,true,true,false,true,true,false,false),     {tres/3}
                       (false,true,true,true,false,true,false,false,false),    {cuatro/4}
                       (true,true,false,true,false,true,true,false,false),     {cinco/5}
                       (true,true,false,true,true,true,true,false,false),      {seis/6}
                       (true,false,true,false,false,true,false,false,false),   {siete/7}
                       (true,true,true,true,true,true,true,true,true),         {ocho/8}
                       (true,true,true,true,false,true,false,false,false),     {nueve/9}
                       (true,true,false,true,true,false,true,false,false),     {E}
                       (false,false,false,false,false,false,false,false,true), {desbordamiento/overflow}
                       (false,false,false,false,false,false,false,false,false),{espacio/space}
                       (false,false,false,true,false,false,false,false,false), {signo menos/'-'}
                       (false,false,false,false,false,false,false,true,false));{punto decimal/'.'}

        {this defines the edges of each segment, scaled to 1:80 vertically and 1::90 horizontally
                 o#9      #1
                      ----------
                  #2 /        /#3
                    /   #4   /
                   /--------/
               #5 /        / #6
                 /   #7   /
                ----------   o #8
        }
        digitos : digi_data =
          (
            ({uno, el horizontal, arriba}
             data : ( (x:20;y:75), (x:26;y:80),
                      (x:78;y:80), (x:80;y:78),
                      (x:69;y:70), (x:28;y:70) );
             longitud : 6
            ),
            ({dos, vertical, izquierda y arriba}
             data : ( (x:19;y:73), (x:27;y:67),
                      (x:25;y:48), (x:18;y:43),
                      (x:15;y:45), (x:-1;y:-1) );
             longitud : 5
            ),
            ({tres, vertical, derecha y arriba}
             data : ( (x:80;y:75), (x:77;y:45),
                      (x:74;y:42), (x:67;y:47),
                      (x:69;y:67), (x:-1;y:-1) );
             longitud : 5
            ),
            ({cuatro, horizontal en el medio}
             data : ( (x:27;y:47), (x:63;y:47),
                      (x:71;y:41), (x:62;y:37),
                      (x:25;y:37), (x:20;y:42) );
             longitud :  6
            ),
            ({cinco, vertical, izquierda y abajo}
             data : ( (x:14;y:40), (x:17;y:42),
                      (x:22;y:36), (x:19;y:12),
                      (x:10;y:09), (x:-1;y:-1) );
             longitud : 5
            ),
            ({seis, vertical, derecha y abajo}
             data : ( (x:73;y:40), (x:75;y:37),
                      (x:70;y:03), (x:68;y:00),
                      (x:61;y:11), (x:64;y:36) );
             longitud :  6
            ),
            ({siete, horizontal, abajo}
             data : ( (x:21;y:10), (x:58;y:10),
                      (x:64;y:00), (x:13;y:00),
                      (x:10;y:05), (x:11;y:07) );
             longitud :  6
            ),
            ({ocho, punto decimal}
             data : ( (x:80;y:10), (x:90;y:10),
                      (x:89;y:00), (x:79;y:00),
                      (x:-1;y:-1), (x:-1;y:-1) );
             longitud : 4
            ),
            ({nueve, desbordamiento}
             data : ( (x:01;y:80), (x:11;y:80),
                      (x:10;y:70), (x:00;y:70),
                      (x:-1;y:-1), (x:-1;y:-1) );
             longitud : 4
            )
          );
    constructor Display.init;
    type
       mem_buffer = array[0..255,0..63] of byte;
         {temp. buffer for initialization}
    var
       xinicial,yinicial:integer;
       resx,resy:real;
       t,l,n,digit:byte;
       si,id:pointtype;
       puntos : array [1..6] of pointtype;
       v_mem : ^mem_buffer;

    procedure pon_mem_XY (x,y:byte);       {putpixel in temp. buffer to draw each segment}
    var sx,ox:byte;
    begin
      sx:=x div 8;ox:=x-sx*8;
      v_mem^[y,sx]:=v_mem^[y,sx] or (1 shl ox);
    end;

    function get_mem_XY (x,y:byte):boolean;  {getpixel from temp. buffer}
    var sx,ox,comp:byte;
    begin
      sx:=x div 8;
      ox:=x-(sx*8);   {faster than mod}
      comp:=1 shl ox;
      get_mem_XY:=(v_mem^[y,sx] and comp)=comp;
    end;

    procedure halla_extremos; {finds minimum area that covers a digit}
    var a:byte;
    begin
      si.x:=getmaxx;si.y:=getmaxy;id.x:=0;id.y:=0;
      for a:=1 to digitos[t].longitud do
         begin
           if (puntos[a].x<si.x) then si.x:=puntos[a].x;
           if (puntos[a].y<si.y) then si.y:=puntos[a].y;
           if (puntos[a].x>id.x) then id.x:=puntos[a].x;
           if (puntos[a].y>id.y) then id.y:=puntos[a].y;
         end;
    end;

    Procedure Linea_mem (X1,Y1,X2,Y2 : integer); {draws a line in temp. buffer}
    var dx,x3,y3:integer; m:real;
    begin
      if (x1>x2) then begin
                       x3:=x1;x1:=x2;x2:=x3;
                       y3:=y1;y1:=y2;y2:=y3;
                      end;
      if (x2<>x1) then
       begin
        m:=(Y2-Y1)/(X2-X1);
        for dx:=X1 to X2 do pon_mem_XY (dx,y1+round(m*(dx-X1)));
       end;
      if (y1>y2) then begin
                       x3:=x1;x1:=x2;x2:=x3;
                       y3:=y1;y1:=y2;y2:=y3;
                      end;
      if (y2<>y1) then
       begin
        m:=(X2-X1)/(Y2-Y1);
        for dx:=Y1 to Y2 do pon_mem_XY(x1+round(m*(dx-Y1)),dx);
       end;
    end;
    procedure graba_palote(pal:byte); {by now a segment is drawn in temp. buffer,
                                       the task is finding the first and last column
                                       for each row}
    var
      lneas:byte;u,p:integer;
    function primer_negro:byte; {primer_extremo}
    var f:byte;
    begin
      primer_negro:=255;
      for f:=si.x to id.x do
        if get_mem_XY(f,lneas) then begin primer_negro:=f;exit;end;
    end;
    function ultimo_negro:byte; {ultimo extremo}
    var f:byte;
    begin
      ultimo_negro:=255;
      for f:=p to id.x do
        if get_mem_XY (f,lneas) and not(get_mem_XY(f+1,lneas)) then ultimo_negro:=f;
    end;

    begin
      digi_masc(graficos[pal]^).num_lin:=id.y-si.y;
        {# of rows to scan}
      digi_masc(graficos[pal]^).esq_si:=si;
        {top-left corner of segment}
      for lneas:=si.y to id.y do
        begin
          p:=primer_negro;
          u:=ultimo_negro;
          digi_masc(graficos[pal]^).datos[lneas-si.y+1].p:=p-si.x;
          digi_masc(graficos[pal]^).datos[lneas-si.y+1].u:=u-si.x;
          {store segments in memory}
         end;
    end;

    begin
      if (x2<x1+num_digits*3) or (x2>x1+254*num_digits) or (y2<=y1+4) or (num_digits<1) then
       begin
        writeln ('Error: Invalid parameters: Area too small or number of digits<1');
        FAIL;
      end;
      xi:=x1;xf:=x2;yi:=y1;yf:=y2;col_on:=forecolor;col_off:=backcolor;num_cars:=num_digits;
      resx:=((x2-x1)/num_digits)*0.0111;
      resy:=(y2-y1)*0.0125;
       {Constants to scale digits}
      xinicial:=xi;
      yinicial:=yi;
      if (MaxAvail<sizeof(mem_buffer)) then
       begin
         writeln ('Out of memory creating lcd display. Initialization failed.');
         fail;
       end;
      new (V_mem); {gets temp. buffer}
      for t:=1 to palotes_x_digito do graficos[t]:=NIL;
      for t:=1 to palotes_x_digito do
        begin
         l:=digitos[t].longitud;
         fillchar (v_mem^,sizeof(mem_buffer),0);
         for n:=1 to l do
          begin
           puntos[n].x:=round(digitos[t].data[n].x*resx);
           puntos[n].y:=round(digitos[t].data[n].y*resy);
          end; {scales points...}
         halla_extremos; {find minimum area}
         tamano_graficos[t]:=5+(2*(id.y-si.y+1));{gets memory to copy coded scaled segments}
         if (MaxAvail<tamano_graficos[t]) then
          begin
           writeln ('Out of memory creating lcd display. Initialization failed.');
           done;
           fail;
          end;
         getmem(graficos[t],tamano_graficos[t]);
         for n:=1 to l do
            linea_mem (puntos[n].x,puntos[n].y,puntos[(n mod l)+1].x,puntos[(n mod l)+1].y);
           {draws segment in memory}
         graba_palote(t);
           {copy segment to memory}
        end;
       dispose (V_mem); {release temp buffer}
       fillchar (buffer,sizeof(buffer),espacio); {nothing written in display}
    end;

    destructor display.done;
    var pal : integer;
    begin
       display_string ('');
       for pal:=1 to palotes_x_digito do
        if (graficos[pal]<>NIL) then freemem (graficos[pal], tamano_graficos[pal])
    end;

    Procedure display.display_string;
    var
      resx:real;xinicial,yinicial:integer;f,digit:byte;cr:digi_font;
      cadena:digi_st;pdecs:byte;
    const
      blancos :st40 = '                                       ';

    procedure barrotes(barrote:byte;encendido:boolean); {draws a segment}
    var lineas:byte;
        color :word;
    begin
      if encendido then color:=col_on
                   else color:=col_off; {segment colour}
      setcolor (color);
      for lineas:=1 to digi_masc(graficos[barrote]^).num_lin do
          if (digi_masc(graficos[barrote]^).datos[lineas].p<>255) then
           line (xinicial+digi_masc(graficos[barrote]^).esq_si.x+digi_masc(graficos[barrote]^).datos[lineas].p,
                 yinicial-digi_masc(graficos[barrote]^).esq_si.y-lineas,
                 xinicial+digi_masc(graficos[barrote]^).esq_si.x+digi_masc(graficos[barrote]^).datos[lineas].u,
                 yinicial-digi_masc(graficos[barrote]^).esq_si.y-lineas);
      {actually draws the segment, scaning rows in memory}
    end;

    Procedure get_font_str(var res:digi_st); {conversion from string to displayable font}
    var f:byte;cr:char;
    begin
      for f:=1 to byte(cadena_num[0]) do
        case cadena_num[f] of
         'E' : res[f]:=E;
         ' ' : res[f]:=espacio;
         '-' : res[f]:=menos;
         '.' : res[f]:=punto;
         '+' : res[f]:=espacio;             {'+' is not representable}
        else
               res[f]:=digi_font(BYTE(cadena_num[f])-48);
       end;
    end;

    procedure display(caracter:digi_font); {displays a character}
    var g:byte;
    begin
      xinicial:=xi+round(digit*resx);
      if (caracter=punto) then barrotes (8,true)
      else
      if (caracter=desbordamiento) then barrotes (9,true)
      else
       begin
        inc(digit);   {# of digit}
        for g:=1 to 7 do
           if (caracteres[caracter,g]<>caracteres[digi_font(buffer[f]),g])
               then barrotes (g,caracteres[caracter,g]);
              {only draws a segment if it has changed}
       end;
    end;

    procedure borra_desborde;  {erases overflow}
    begin
      barrotes (9,false);
    end;
    procedure borra_punto;  {erases decimal point}
    begin
      barrotes (8,false);
    end;

    function num_puntos:byte;
    var a,res:byte;
    begin
      res:=0;
      for a:=1 to ord(cadena_num[0]) do if cadena_num[a]='.' then inc(res);
      num_puntos:=res;
    end;

    begin {proc. display}
      digit:=0; {digitos escritos}
      resx:=(xf-xi)/num_cars;
      yinicial:=yf;
      if desbordado then
       begin
        borra_desborde;
         {erases overflow}
        desbordado:=false;
       end;
      pdecs:=num_puntos;
      if (length(cadena_num)-pdecs<num_cars)
           then
             cadena_num:=copy(blancos,1,pdecs+num_cars-length(cadena_num))+cadena_num
      else
      if (length(cadena_num)-pdecs>num_cars)
           then
            begin
             desbordado:=true;
             cadena_num:=copy(cadena_num,(1+length(cadena_num)-num_cars),num_cars);
            end;
      get_font_str (cadena);
      for f:=1 to num_cars+pdecs do
       begin                 {all characters}
        cr:=cadena[f];
        if (cr<>punto) then
        begin
         {updates decimal point}
         if (digi_font(buffer[f+1])=punto) then
           begin
            if not(cadena[f+1]=punto) then borra_punto
           end
          else
            if (cadena[f+1]=punto) then display (punto);
         if (cr=digi_font(buffer[f]))
           then inc(digit)
           else
            begin
              {only draws a character if it's changed}
              display(cadena[f]);
              buffer[f]:=byte(cr);
            end;
        end;
       end;
      digit:=0; {el signo de desbordamiento se encuentra incluido en el primer digito}
      if desbordado then display(desbordamiento);
      {set overflow if necessary}
    end;

    Procedure display.display_real;
    var cad : STRING;
    begin
      if (ndecimals+1>=num_cars) then ndecimals:=num_cars-2;
      str (r:num_cars-ndecimals-1:ndecimals, cad);
      display_string (cad);
    end;

    Procedure display.redraw;
    var cad : st40;
        i : integer;
    begin
       cad[0]:=char(num_cars);
       for i:=1 to num_cars do
         case digi_font(buffer[i]) OF
           E: cad[i]:='E';
           espacio: cad[i]:=' ';
           menos: cad[i]:='-';
           punto: cad[i]:='.';
         else
           cad[i]:=CHAR(48+buffer[i]);
        end;
       fillchar (buffer, sizeof(buffer), espacio);
       display_string (cad);
    end;

    end.

    { ---------  UNIT NEED FOR THIS SNIPET ----------------------- }
    Unit inisvga;
    interface
     uses Crt,Graph;
     var
       v : byte;
       OldExitProc : Pointer;  { Saves exit procedure address }
       graphdriver,graphmode,errorcode:integer;
       PathToDriver   : string[80];  { Stores the DOS path to *.BGI & *.CHR }
     const
       edit            = 0;
       vga320x200x256  = 1;
       svga640x400x256 = 2;
       svga640x480x256 = 3;
       svga1024x768x256= 4;
       ega640x350x16   = 5;
       herc720x348x2   = 6;

      Procedure Graficos(modo_grafico:byte);
      Procedure Cierragraficos;
      Procedure Dimensiones (Var horizontal, vertical: INTEGER);

    implementation
    var
       err:integer;

    procedure Cierragraficos;
    begin
       closegraph;
    end;

    {$F+}
    procedure MyExitProc;
    begin
      ExitProc := OldExitProc; { Restore exit procedure address }
      CloseGraph;              { Shut down the graphics system }
    end; { MyExitProc }
    {$F-}
    {$F+}
    function DetectVGA256 : integer;
    { Detects VGA or MCGA video cards }
    var
      DetectedDriver : integer;
      SuggestedMode  : integer;
    begin
      DetectGraph(DetectedDriver, SuggestedMode);
      if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
        DetectVGA256 := v        { Default video mode = 0 }
      else
        DetectVGA256 := grError; { Couldn't detect hardware }
    end; { DetectVGA256 }
    {$F-}

    var
      AutoDetectPointer : pointer;

    function Inicializa_svga:byte;
    { Initialize graphics and report any errors that may occur }
    var
      InGraphicsMode : boolean; { Flags initialization of graphics mode }
    begin
      { when using Crt and graphics, turn off Crt's memory-mapped writes }
      DirectVideo := False;
      OldExitProc := ExitProc;                { save previous exit proc }
      ExitProc := @MyExitProc;                { insert our exit proc in chain }
      repeat

        AutoDetectPointer := @DetectVGA256;   { Point to detection routine }
        GraphDriver := InstallUserDriver('SVGA256', AutoDetectPointer);
        GraphDriver := Detect;

        InitGraph(GraphDriver, Graphmode, PathToDriver);
        ErrorCode := GraphResult;             { preserve error return }
        inicializa_svga:=grok;
        if ErrorCode <> grOK then             { error? }
        begin
          Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
          if ErrorCode = grFileNotFound then  { Can't find driver file }
          begin
            Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
            Readln(PathToDriver);
            Writeln;
          end
          else
            inicializa_Svga:=grok;
        end;
      until ErrorCode = grOK;
      Randomize;                { init random number generator }
    end; { Initialize }

    procedure Graficos(modo_grafico:byte);
    var  ch:char;
    procedure egadriver;
    begin
        graphdriver:=EGA;
        graphmode:=EGAHi;
        InitGraph(graphdriver,graphmode,'');
        Err := GraphResult;
        if Err <> grOk then WriteLn('Graphics error:',GraphErrorMsg(Err));
        modo_grafico:=ega640x350x16;
    end;
    procedure Hercules;
    begin
         graphdriver:=hercmono;
         graphmode:=hercmonohi;
         InitGraph(graphdriver,graphmode,'');
         Err := GraphResult;
         if Err <> grOk then WriteLn('Graphics error:',GraphErrorMsg(Err));
         modo_grafico:=herc720x348x2;
    end;
    begin
      if (modo_grafico<1) or (modo_grafico>6) then
       begin
        window (20,8,60,16);
        clrscr;
        Writeln ('       Modos gr ficos');
        writeln;
        Writeln ('1 - VGA 320x200 256 colores');
        Writeln ('2 - SVGA 600x480 256 colores');
        Writeln ('3 - SVGA 640x480 256 colores');
        Writeln ('4 - SVGA 1024x768 256 colores');
        Writeln ('5 - EGA 640x350 16 colores');
        Writeln ('6 - Hercules mono');
        err:=-1;
        Repeat
          ch:=readkey;
          case ch of
          '1' : begin v:=0; modo_grafico:=vga320x200x256;  err:=inicializa_svga; end;
          '2' : begin v:=1; modo_grafico:=svga640x400x256; err:=inicializa_svga; end;
          '3' : begin v:=2; modo_grafico:=svga640x480x256; err:=inicializa_svga; end;
          '4' : begin v:=3; modo_grafico:=svga1024x768x256;err:=inicializa_svga; end;
          '5' : egadriver;
          '6' : hercules;
          end;
        Until (err=grOk);
       end
      else
       begin
        if (modo_grafico=ega640x350x16) then egadriver
        else
        if (modo_grafico=herc720x348x2) then hercules
        else
        if (modo_grafico=vga320x200x256) then
             begin v:=0;err:=inicializa_svga; end
        else
        if (modo_grafico=svga640x400x256) then
             begin v:=1;err:=inicializa_svga; end
        else
        if (modo_grafico=svga640x480x256) then
             begin v:=2; err:=inicializa_svga; end
        else
        if (modo_grafico=svga1024x768x256) then
             begin v:=3;err:=inicializa_svga; end;
       end;
    end;

    Procedure dimensiones (Var horizontal, vertical: INTEGER);
    begin
      horizontal:=Getmaxx;
      vertical:=Getmaxy;
    end;

    begin
      PathToDriver := 'D:\bp\bgi';
    end.

    { --------------------------   DEMO  -----------------------  }
    Program DemoLCD;
    {
       Demo for LCD unit, keeps drawing ellipses until a key is pressed.
       There's a LCD that counts the number of ellipses drawn.

       Leopoldo Salvo, e-mail a900040@zipi.fi.upm.es
    }
    Uses Inisvga,Crt,Graph,Lcd;  { unit INISVGA found at the bottom !! }

    Var
      i, numero:word;
      xq,yq,rx,ry,x,y,maxcolor,maxx,maxy:integer;
      n_str: string;
      graphdriver,graphmode,error:integeR;
      v1 : ^Display;
      ch : char;
    begin
       graficos (edit);
       maxcolor:=256;maxx:=getmaxx;maxy:=getmaxy;numero:=0;
       xq:=maxx div 6;
       yq:=maxy div 10;  {constants for centering stuff}
       new (v1, init (xq,0,5*xq,2*yq,4,15,0));
       {creates and initializes lcd display, digits are white(#15) over black(#0) background}
       if (v1=NIL) then
        begin
         writeln ('Error creating lcd displays, exiting...');
         halt;
        end;
       maxx:=maxx-2*xq;
       maxy:=maxy-4*yq;
       setcolor (15);
       line (xq-4,3*yq-4,5*xq+4,3*yq-4);
       line (5*xq+4,3*yq-4,5*xq+4,9*yq+10);
       line (5*xq+4,9*yq+10,xq-1,9*yq+10);
       line (xq-4,9*yq+10,xq-4,3*yq-4);
       repeat
         setcolor (maxcolor+1);
         x:=random(maxx);
         y:=random(maxy);
         if (x<maxx div 2) then rx:=random(x)
         		       else rx:=random(maxx-x);
         if (y<maxy div 2) then ry:=random(y)
         		       else ry:=random(maxy-y);
         setfillstyle (solidfill,random(maxcolor));
         fillellipse (xq+x,3*yq+y,rx,ry);
         inc(numero);
         v1^.display_real (0, numero);               {updates counter lcd}
       until keypressed;
       dispose (v1, done);
       closegraph;
       ch:=readkey;
    end.

    { --------------------------   DEMO  -----------------------  }

    {
    Demo for LCD unit.

    Leopoldo Salvo Massieu, e-mail a900040@zipi.fi.upm.es

    A rather artistic lcd display show.
    }

    Program demolcd3;

    uses crt,graph,lcd;
    var
      graphdriver,graphmode,err:integer;
      a:byte;
      rx,ry:real;
      maxcol,c: byte;
      s:string;
      v:array[1..6] of ^display;
    const
      tiempo= 350;

    procedure abre (xi,yi,xf,yf,n,c1,c0,w:byte);
    begin
       new (v[w], init (round(xi*rx),round(yi*ry),round(xf*rx),round(yf*ry),n,c1,c0));
       if (v[w]=NIL) then
        begin
          writeln ('Error creating lcd display... halting program...');
          halt;
        end;
    enD;
    procedure pon (num:byte);
    begin
       v[num]^.display_string (char(48+num));
       delay (tiempo);
       v[num]^.display_string (' ');
    end;

    begin
       graphdriver:=detect;
       graphmode:=0;
       initgraph (graphdriver,graphmode,'');
       err:=graphresult;
       if err<>grok then
           begin
            writeln ('had trouble opening graphic mode (probably egavga.bgi not found)',grapherrormsg(err));
            exit;
           end;
      rx:=getmaxx*0.01;
      ry:=getmaxy*0.01;
      maxcol:=getmaxcolor;

      Abre (5,20,25,40,1,30,0,1);
      Abre (43,5,77,18,1,25,0,2);
      Abre (85,25,100,75,1,23,0,3);
      Abre (72,60,93,81,1,4,0,4);
      Abre (36,69,72,85,1,56,0,5);
      Abre (12,44,36,75,1,98,0,6);
      Repeat
        for a:=1 to 6 do pon (a);
        Until keypressed;
      for a:=1 to 6 do dispose (v[a], done);
      closegraph;
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]