[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]