Unit BSS;{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º T E C H N I S C H E U N I V E R S I T Ž T C H E M N I T Z º
º º
º Programm zur Ansteuerung des AD/DA-Wandlermoduls mit Einchip- º
º rechner 68HC11 º
º º
º UNIT Bildschirmschoner º
º º
º Programmierer: Torsten Levin º
º 03 AET 89 º
º TU Chemnitz-Zwickau º
º º
º Chemnitz, Januar-April 1993 º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
INTERFACE
USES crt,dos,graph,maus;
Type st = String[30];
Procedure Darkness(nr:byte;Wort:st;stanz,stverz:integer);
IMPLEMENTATION
Procedure Darkness(nr:byte;Wort:st;stanz,stverz:integer);
Var mx,my,mb:integer;
po1,po2,po3:pointer;
ss1,ss2,ss3:word;
Function Eingabe:Boolean;
var mxn,myn,mbn:integer;
begin
if mx=639 then
Begin
mx:=638;
setmauspos(638,my);
End;
mauspos(mxn,myn,mbn);
if (mxn<>mx) or (myn<>my) or (mbn<>mb) or (keypressed) then
Eingabe:=true else Eingabe:=false;
end;
Procedure Savescreen;
begin
ss1:=imagesize(0,0,639,199);
ss2:=imagesize(0,200,639,399);
ss3:=imagesize(0,400,639,479);
getmem(po1,ss1);
getmem(po2,ss2);
getmem(po3,ss3);
getimage(0,0,639,199,po1^);
getimage(0,200,639,399,po2^);
getimage(0,400,639,479,po3^);
end;
Procedure loadscreen;
begin
putimage(0,0,po1^,normalput);
putimage(0,200,po2^,normalput);
putimage(0,400,po3^,normalput);
freemem(po1,ss1);
freemem(po2,ss2);
freemem(po3,ss3);
end;
Procedure TextBSS;
Var i,x,y,Color,font,size : integer;
Schrift : String[30];
h,m,s,b:word;
hs,ms,ss:string[2];
Procedure IFTime;
Begin
if Wort='Time' then
begin
gettime(h,m,s,b);
str(h,hs);
str(m,ms);
if length(ms)=1 then ms:='0'+ms;
str(s,ss);
if length(ss)=1 then ss:='0'+ss;
Schrift:=Concat(hs,':',ms,'.',ss);
end
else Schrift:=Wort;
End;
Begin
IFTime;
setfillstyle(1,0);
Randomize;
Font:=random(4);
Case Font of
0: size:=random(3)+1;
1: size:=random(4)+3;
2: size:=random(3)+4;
3: size:=random(5)+3;
end;
settextstyle(font,0,size);
x:=random(635-textwidth(Schrift));
y:=Random(475-textheight(Schrift));
color:=random(7)+1;
repeat
for i:=0 to 31 do
begin
case color of
1: setrgbpalette(15,0,0,i*2);
2: setrgbpalette(15,0,i*2,0);
3: setrgbpalette(15,i*2,0,0);
4: setrgbpalette(15,i*2,i*2,0);
5: setrgbpalette(15,i*2,0,i*2);
6: setrgbpalette(15,0,i*2,i*2);
7: setrgbpalette(15,i*2,i*2,i*2);
end;
setpalette(15,15);
setcolor(15);
outtextxy(x,y,Schrift);
if eingabe then i:=31;
end;
if not(eingabe) then
for i:=31 downto 0 do
begin
case color of
1: setrgbpalette(15,0,0,i*2);
2: setrgbpalette(15,0,i*2,0);
3: setrgbpalette(15,i*2,0,0);
4: setrgbpalette(15,i*2,i*2,0);
5: setrgbpalette(15,i*2,0,i*2);
6: setrgbpalette(15,0,i*2,i*2);
7: setrgbpalette(15,i*2,i*2,i*2);
end;
setpalette(15,15);
setcolor(15);
outtextxy(x,y,Schrift);
if eingabe then i:=0;
end;
cleardevice;
Font:=random(4);
Case Font of
0: size:=random(3)+1;
1: size:=random(4)+3;
2: size:=random(3)+4;
3: size:=random(5)+3;
end;
settextstyle(font,0,size);
IFTime;
x:=random(639-textwidth(Schrift));
y:=Random(479-textheight(Schrift));
color:=random(7)+1;
until eingabe;
settextstyle(0,0,0);
setrgbpalette(15,63,63,63);
setpalette(15,15);
setcolor(15);
End;
Procedure Stars;
Type Pos = Record x,y : Integer;
End;
Var Feld : Array[1..1000] of Pos;
Color : byte;
i : integer;
Begin
i:=1;
Randomize;
repeat
Putpixel(Feld[i].x,Feld[i].y,0);
Feld[i].x:=Random(639);
Feld[i].y:=Random(479);
Color:=Random(16)+1;
Putpixel(Feld[i].x,Feld[i].y,Color);
delay(stverz);
if i<stanz then i:=i+1 else i:=1;
until eingabe;
End;
Procedure Fog;
Type RGBRec = record
R,G,B : Integer;
End;
Const
Wert=4;
Default : array[0..15]
of RGBRec = (
( R:00; G:00; B:00 ),
( R:00; G:00; B:42 ),
( R:00; G:42; B:00 ),
( R:00; G:42; B:42 ),
( R:42; G:00; B:00 ),
( R:42; G:00; B:42 ),
( R:42; G:21; B:00 ),
( R:42; G:42; B:42 ),
( R:21; G:21; B:21 ),
( R:21; G:21; B:63 ),
( R:21; G:63; B:21 ),
( R:21; G:63; B:63 ),
( R:63; G:21; B:21 ),
( R:63; G:21; B:63 ),
( R:63; G:63; B:21 ),
( R:63; G:63; B:63 ));
Var i : Byte;
Begin
for i:=0 to 15 do setrgbpalette(i,Default[i].r div wert,Default[i].g div wert,Default[i].b div wert);
for i:=15 downto 0 do setpalette(i,i);
Repeat Until Eingabe;
for i:=0 to 15 do setrgbpalette(i,Default[i].r,Default[i].g,Default[i].b);
for i:=0 to 15 do setpalette(i,i);
End;
Begin
mauspos(mx,my,mb);
if nr in [1..2] then
begin
hidemaus;
savescreen;
cleardevice;
case nr of
1: textbss;
2: stars;
end;
loadscreen;
showmaus;
end
else fog;
End;
End.
| Detected encoding: ANSI (CP1252) | 4
|
|
|