Sleeptimer mit Mausoption Turbo Pascal
aus Paswiki Turbo Pascal, der freien Wissensdatenbank
Beschreibung
Ein Programm, das sich jeder wünscht: Ein Sleeptimer, der mit Hilfe von assembler auch Mausoptionen beinhaltet.
Bekannte Fehler :
- Funktioniert nur unter Windows XP
- Wer keinen PC oder keinen Bildschirm hat, der wird es schwer haben das Programm zum Laufen zu bringen.
Programm
{$M $4000,0,0 }
program sleeptimer;
uses crt,dos;
VAR n,m,knopf:WORD; c,i,k,g,u,code,x,y,x2,y2:integer;
regs:registers;
o:string; ch:char;
procedure pc_aus;
begin
SwapVectors;
EXEC('c:\windows\system32\shutdown.exe','-s -t 00');
end;
procedure druck;assembler;
asm
mov ax, 0003h
int 33h
mov n,cx
mov m,dx
mov knopf,bx
end;
procedure maus_an; assembler;
asm
mov ax, 01h
int 33h
end;
procedure schreib0;
begin
writeln(' .. ');
writeln('. . ');
writeln('. . ');
writeln('. . ');
writeln(' .. ');
end;
procedure schreib1;
begin
writeln(' .. ');
writeln(' . . ');
writeln(' . ');
writeln(' . ');
writeln(' . ');
end;
procedure schreib2;
begin
writeln('.... ');
writeln(' . ');
writeln('.... ');
writeln('. ');
writeln('.... ');
end;
procedure schreib3;
begin
writeln('.... ');
writeln(' . ');
writeln('.... ');
writeln(' . ');
writeln('.... ');
end;
procedure schreib8;
begin
writeln('.... ');
writeln('. . ');
writeln('.... ');
writeln('. . ');
writeln('.... ');
end;
procedure schreib4;
begin
writeln('. . ');
writeln('. . ');
writeln('.... ');
writeln(' . ');
writeln(' . ');
end;
procedure schreib5;
begin
writeln('.... ');
writeln('. ');
writeln('.... ');
writeln(' . ');
writeln('.... ');
end;
procedure schreib6;
begin
writeln('.... ');
writeln('. ');
writeln('.... ');
writeln('. . ');
writeln('.... ');
end;
procedure schreib7;
begin
writeln('.... ');
writeln(' . ');
writeln(' ...');
writeln(' . ');
writeln(' . ');
end;
procedure schreib9;
begin
writeln('.... ');
writeln('. . ');
writeln('.... ');
writeln(' . ');
writeln('.... ');
end;
procedure button;
var d,j,m,w:word; z,z2:string;
begin
getdate(j,m,d,w);
window(1,2,22,22);
textbackground(7);
clrscr;
textcolor(0);
window(1,1,80,25);
textbackground(7);
gotoxy(4,5);write(' Los geht',#39,'s ');
gotoxy(4,12);write(' Neustart ');
gotoxy(4,19);write(' Exit ');
textbackground(7);
gotoxy(65,1);write(' Begonnen um: ');
gotoxy(65,2);write(' ');
gotoxy(65,3);write(' ',d,'.',m,' ',j,' ');
gettime(j,m,d,w);
if m<10 then z:='0' else z:='';
if j<10 then z2:='0' else z2:='';
gotoxy(65,4);write(' ',z2,j,':',z,m,' Uhr ');
gotoxy(65,5);write(' ');
textcolor(x);
textbackground(7);
gotoxy(3,3);write(#218#196#196#196#196#196#196#196#196#196#196#196#196#196#196#191);
gotoxy(3,4);write(#179); gotoxy(3,5);write(#179); gotoxy(3,6);write(#179); gotoxy(3,7);write(#192);
textcolor(x2);
gotoxy(18,5);write(#179); gotoxy(18,4);write(#179); gotoxy(18,3);write(#191); gotoxy(18,6);write(#179);
gotoxy(4,7);write(#196#196#196#196#196#196#196#196#196#196#196#196#196#196#217);
textcolor(y);
gotoxy(3,10);write(#218#196#196#196#196#196#196#196#196#196#196#196#196#196#196#191);
gotoxy(3,11);write(#179);gotoxy(3,12);write(#179); gotoxy(3,13);write(#179); gotoxy(3,14);write(#192);
textcolor(y2);
gotoxy(18,12);write(#179); gotoxy(18,11);write(#179); gotoxy(18,10);write(#191); gotoxy(18,13);write(#179);
gotoxy(4,14);write(#196#196#196#196#196#196#196#196#196#196#196#196#196#196#217);
textcolor(15);
gotoxy(3,17);write(#218#196#196#196#196#196#196#196#196#196#196#196#196#196#196#191);
gotoxy(3,18);write(#179);gotoxy(3,19);write(#179); gotoxy(3,20);write(#179); gotoxy(3,21);write(#192);
textcolor(0);
gotoxy(18,19);write(#179); gotoxy(18,18);write(#179); gotoxy(18,17);write(#191); gotoxy(18,20);write(#179);
gotoxy(4,21);write(#196#196#196#196#196#196#196#196#196#196#196#196#196#196#217);
textcolor(15);
textbackground(0);
end;
procedure start;
var h3,m3,s3,s1003,h2,m2,s2,s1002,q:word;
time1,time2,time3,timeneu:real;
begin
gotoxy(30,4);write(#201#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#187);
gotoxy(30,5);write(#186,'Bitte Zeit eingeben : ',#186);
gotoxy(30,6);write(#186,' ',#186);
gotoxy(30,7);write(#186,'(in Min.): ',#186);
gotoxy(30,8);write(#200#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#205#188);
gotoxy(42,7);write(#16#16); gotoxy(52,7);write(#17#17);
regs.ax := $0100;
regs.cx := $0607;
intr($10, regs);
gotoxy(47,7);read(g);
regs.ax := $0100;
regs.cx := $2607;
intr($10, regs);
window(31,13,62,22);
textbackground(0);
clrscr;
textcolor(14);
gettime(h2,m2,s2,s1002);
time1:=(h2*3600+60*m2+s2+(s1002/100));
time3:=(time1+g*60);
q:=0;
repeat
inc(q);
gettime(h3,m3,s3,s1003);
time2:=3600*h3+m3*60+s3+(s1003/100);
u:=round(time3-time2) div 60 ; str(u,o);
if u<10 then begin o[2]:=o[1]; o[1]:='0';end;
val(o[1],u,code);
case u of
0:begin window(33,15,38,20);schreib0;end;
1:begin window(33,15,38,20);schreib1;end;
2:begin window(33,15,38,20);schreib2;end;
3:begin window(33,15,38,20);schreib3;end;
4:begin window(33,15,38,20);schreib4;end;
5:begin window(33,15,38,20);schreib5;end;
6:begin window(33,15,38,20);schreib6;end;
7:begin window(33,15,38,20);schreib7;end;
8:begin window(33,15,38,20);schreib8;end;
9:begin window(33,15,38,20);schreib9;end;
end;
val(o[2],u,code);
case u of
0:begin window(39,15,45,21);schreib0;end;
1:begin window(39,15,45,21);schreib1;end;
2:begin window(39,15,45,21);schreib2;end;
3:begin window(39,15,45,21);schreib3;end;
4:begin window(39,15,45,21);schreib4;end;
5:begin window(39,15,45,21);schreib5;end;
6:begin window(39,15,45,21);schreib6;end;
7:begin window(39,15,45,21);schreib7;end;
8:begin window(39,15,45,21);schreib8;end;
9:begin window(39,15,45,21);schreib9;end;
end;
u:=round(time3-time2) mod 60; str(u,o);
if u<10 then begin o[2]:=o[1]; o[1]:='0';end;
val(o[1],u,code);
case u of
0:begin window(49,15,54,20);schreib0;end;
1:begin window(49,15,54,20);schreib1;end;
2:begin window(49,15,54,20);schreib2;end;
3:begin window(49,15,54,20);schreib3;end;
4:begin window(49,15,54,20);schreib4;end;
5:begin window(49,15,54,20);schreib5;end;
6:begin window(49,15,54,20);schreib6;end;
7:begin window(49,15,54,20);schreib7;end;
8:begin window(49,15,54,20);schreib8;end;
9:begin window(49,15,54,20);schreib9;end;
end;
val(o[2],u,code);
case u of
0:begin window(55,15,60,21);schreib0;end;
1:begin window(55,15,60,21);schreib1;end;
2:begin window(55,15,60,21);schreib2;end;
3:begin window(55,15,60,21);schreib3;end;
4:begin window(55,15,60,21);schreib4;end;
5:begin window(55,15,60,21);schreib5;end;
6:begin window(55,15,60,21);schreib6;end;
7:begin window(55,15,60,21);schreib7;end;
8:begin window(55,15,60,21);schreib8;end;
9:begin window(55,15,60,21);schreib9;end;
end;
druck;
if (knopf=1) and ((n div 8)>3) and ((n div 8)<19) and ((m div 8)>17) and ((m div 8)<21) then begin halt;end;
if (knopf=1) and ((n div 8)>1) and ((n div 8)<18) and ((m div 8)>9) and ((m div 8)<14)
then begin time3:=time2+g*60;q:=0; y:=0;y2:=15;button;delay(75);y:=15;y2:=0;button;textcolor(14);end;
until time3=time2;
pc_aus;
end;
BEGIN
regs.ax := $0100;
regs.cx := $2607;
intr($10, regs);
window(1,1,80,25);
randomize;
maus_an;
textcolor(15); x:=15; x2:=0; y:=15; y2:=0;
for i:=1 to 500 do
begin
k:=random(80);
c:=random(25);
gotoxy(k,c);write('.');
end;
button;
begin
repeat
druck;
if (knopf=1) and((n div 8)>3) and ((n div 8)<19) and ((m div 8)>3) and ((m div 8)<7) then
begin x:=0;x2:=15;button;delay(250);x:=15;x2:=0;button;start;end;
if (knopf=1)and((n div 8)>3) and ((n div 8)<19) and ((m div 8)>17) and ((m div 8)<21) then begin halt;end;
until false;
end;
END.
=> Gastarbeiter 14:34, 24. Apr 2006 (CEST)
