Initial commit
This commit is contained in:
commit
bc7c109b0c
199
1046RTL.BAK
Normal file
199
1046RTL.BAK
Normal file
@ -0,0 +1,199 @@
|
||||
program RTL;
|
||||
|
||||
uses Crt, VFx;
|
||||
|
||||
var d: array[0..9999] of boolean;
|
||||
var cd,cn: integer;
|
||||
|
||||
function Form(i: integer): string;
|
||||
var t: string;
|
||||
begin
|
||||
Str(i,t);
|
||||
while (Length(t)<4) do t := '0'+t;
|
||||
Form := t;
|
||||
end;
|
||||
|
||||
procedure SetDone;
|
||||
var f: text;
|
||||
x: string;
|
||||
t,ec: integer;
|
||||
begin
|
||||
for t:=0 to 9999 do d[t] := false;
|
||||
assign(f,'1046rtl.txt');
|
||||
reset(f);
|
||||
ReadLn(f,x);
|
||||
WriteLn(x);
|
||||
while Not Eof(f) do begin
|
||||
ReadLn(f,x);
|
||||
Val(x,t,ec);
|
||||
if NOT d[t] then d[t] := true else Alert(Form(t)+' doppelt getippt!');
|
||||
end;
|
||||
close(f);
|
||||
WriteLn('Datenbank mit Tipps geladen und verarbeitet.');
|
||||
end;
|
||||
|
||||
procedure DoStats;
|
||||
var i: integer;
|
||||
begin
|
||||
cd := 0;
|
||||
cn := 0;
|
||||
for i:=0 to 9999 do begin
|
||||
if d[i] then Inc(cd) else Inc(cn);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ShowStats;
|
||||
var mon: real;
|
||||
begin
|
||||
mon := cd;
|
||||
mon := mon*500;
|
||||
WriteLn('Getippt: ',cd:5,' = ',cd/100:6:2,'% = ',mon:10:2,' DM in ',cd DIV 10:3,' Tagen bei 5.000,- DM pro Tag');
|
||||
mon := cn;
|
||||
mon := mon*500;
|
||||
WriteLn('šbrig : ',cn:5,' = ',cn/100:6:2,'% = ',mon:10:2,' DM in ',cn DIV 10:3,' Tagen');
|
||||
WriteLn('Gesamt : ',cd+cn:5);
|
||||
end;
|
||||
|
||||
procedure ShowNotDone;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=0 to 9999 do begin
|
||||
if not d[i] then Write(Form(i),' ');
|
||||
end;
|
||||
end;
|
||||
|
||||
function Ten(i,e: integer): longint;
|
||||
var x: integer;
|
||||
t: longint;
|
||||
begin
|
||||
if (e>0) then begin
|
||||
for x:=1 to e do i := i * 10;
|
||||
end;
|
||||
Ten := i;
|
||||
end;
|
||||
|
||||
procedure WriteNum(x: integer);
|
||||
begin
|
||||
GotoXY(16,12);
|
||||
Write(x DIV 1000);
|
||||
GotoXY(18,12);
|
||||
Write((x MOD 1000) DIV 100);
|
||||
GotoXY(20,12);
|
||||
Write((x MOD 100) DIV 10);
|
||||
GotoXY(22,12);
|
||||
Write(x MOD 10);
|
||||
end;
|
||||
|
||||
procedure WriteNumFX(x: integer);
|
||||
begin
|
||||
GotoXY(16,12);
|
||||
FXWriteC(Num2Str(x DIV 1000)+' '+Num2Str((x MOD 1000) DIV 100)+' '+Num2Str((x MOD 100) DIV 10)+' '+Num2Str(x MOD 10),15);
|
||||
end;
|
||||
|
||||
procedure GetRandomNumber;
|
||||
var i,x: integer;
|
||||
begin
|
||||
i := 0;
|
||||
Randomize;
|
||||
repeat
|
||||
repeat
|
||||
x := Random(10000);
|
||||
until NOT d[x];
|
||||
WriteNum(x);
|
||||
Sound(1950);
|
||||
Delay(25);
|
||||
NoSound;
|
||||
Delay(i);
|
||||
i := i + 1 + (i DIV 5);
|
||||
until (i>=750);
|
||||
WriteNumFX(x);
|
||||
CursorOff;
|
||||
end;
|
||||
|
||||
procedure DoAsking;
|
||||
var k: char;
|
||||
kc: byte;
|
||||
c: byte;
|
||||
co: integer;
|
||||
i: integer;
|
||||
begin
|
||||
DrawBorder2(20,5,60,20,11,1);
|
||||
Window(21,6,59,19);
|
||||
GotoXY(1,2);
|
||||
FXWriteC('* * * 104.6 RTL * * *',14); WriteLn;
|
||||
FXWriteC('* EURO - MILLIONAER *',15); WriteLn;
|
||||
FXWriteC('* * * * * * * * * * *',14); WriteLn;
|
||||
TextColor(11);
|
||||
WriteLn;
|
||||
WriteFlt(' Knacken Sie den vierstelligen');
|
||||
WriteFlt(' Zahlencode und gewinnen Sie ');
|
||||
WriteLn;
|
||||
TextColor(12);
|
||||
WriteImp(' EINE MILLION EURO');
|
||||
TextColor(11);
|
||||
GotoXY(1,14); FXWriteC('Beenden mit ESC',7);
|
||||
GotoXY(1,12); FXWriteC('_ _ _ _',7);
|
||||
CursorOff;
|
||||
WaitBeep;
|
||||
c := 0;
|
||||
co := 0;
|
||||
repeat
|
||||
k := ReadKey;
|
||||
if k<>#27 then begin
|
||||
if k IN [#48..#57] then begin
|
||||
if (c=0) then begin
|
||||
GotoXY(18,12); TextColor(7); Write('_ _ _');
|
||||
end;
|
||||
GotoXY(16+2*c,12); FXChar(k,15); CursorOff;
|
||||
Inc(c);
|
||||
kc := Ord(k)-48;
|
||||
co := co + Ten(kc,4-c);
|
||||
AckBeep;
|
||||
end;
|
||||
if (k=#8) AND (c>0) then begin
|
||||
Dec(c);
|
||||
GotoXY(16+2*c,12); FXChar('_',7); CursorOff;
|
||||
co := (co DIV Ten(1,4-c)) * Ten(1,4-c);
|
||||
ErrorBeep;
|
||||
end;
|
||||
if (k='r') OR (k='R') then begin
|
||||
TextColor(8);
|
||||
GotoXY(10,13);
|
||||
Write(Space(20));
|
||||
GetRandomNumber;
|
||||
WaitBeep;
|
||||
end;
|
||||
end;
|
||||
if (c=4) then begin
|
||||
GotoXY(10,13);
|
||||
if d[co] then begin
|
||||
TextColor(12);
|
||||
ErrorBeep;
|
||||
WriteFlt('*** CODE FALSCH ***');
|
||||
end else begin
|
||||
TextColor(10);
|
||||
ReadyBeep;
|
||||
WriteFlt('*** PRUEFE CODE ***');
|
||||
end;
|
||||
co := 0;
|
||||
c := 0;
|
||||
CursorOff;
|
||||
end;
|
||||
until k=#27;
|
||||
Window(1,1,80,25);
|
||||
CursorOn;
|
||||
end;
|
||||
|
||||
begin
|
||||
SaveScreen;
|
||||
TextMode(co80);
|
||||
TextColor(7);
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
SetDone;
|
||||
DoStats;
|
||||
{ ShowNotDone; }
|
||||
ShowStats;
|
||||
DoAsking;
|
||||
RestoreScreen;
|
||||
end.
|
||||
202
1046RTL.PAS
Normal file
202
1046RTL.PAS
Normal file
@ -0,0 +1,202 @@
|
||||
program RTL;
|
||||
|
||||
uses Crt, VFx;
|
||||
|
||||
var d: array[0..9999] of boolean;
|
||||
var cd,cn: integer;
|
||||
|
||||
function Form(i: integer): string;
|
||||
var t: string;
|
||||
begin
|
||||
Str(i,t);
|
||||
while (Length(t)<4) do t := '0'+t;
|
||||
Form := t;
|
||||
end;
|
||||
|
||||
procedure SetDone;
|
||||
var f: text;
|
||||
x: string;
|
||||
t,ec: integer;
|
||||
msg: string;
|
||||
begin
|
||||
for t:=0 to 9999 do d[t] := false;
|
||||
assign(f,'1046rtl.txt');
|
||||
reset(f);
|
||||
ReadLn(f,x);
|
||||
WriteLn(x);
|
||||
msg := '';
|
||||
while Not Eof(f) do begin
|
||||
ReadLn(f,x);
|
||||
Val(x,t,ec);
|
||||
if NOT d[t] then d[t] := true else msg := msg + Form(t)+' doppelt getippt!'+crlf;
|
||||
end;
|
||||
close(f);
|
||||
Alert(msg);
|
||||
WriteLn('Datenbank mit Tipps geladen und verarbeitet.');
|
||||
end;
|
||||
|
||||
procedure DoStats;
|
||||
var i: integer;
|
||||
begin
|
||||
cd := 0;
|
||||
cn := 0;
|
||||
for i:=0 to 9999 do begin
|
||||
if d[i] then Inc(cd) else Inc(cn);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ShowStats;
|
||||
var mon: real;
|
||||
begin
|
||||
mon := cd;
|
||||
mon := mon*500;
|
||||
WriteLn('Getippt: ',cd:5,' = ',cd/100:6:2,'% = ',mon:10:2,' DM in ',cd DIV 10:3,' Tagen bei 5.000,- DM pro Tag');
|
||||
mon := cn;
|
||||
mon := mon*500;
|
||||
WriteLn('šbrig : ',cn:5,' = ',cn/100:6:2,'% = ',mon:10:2,' DM in ',cn DIV 10:3,' Tagen');
|
||||
WriteLn('Gesamt : ',cd+cn:5);
|
||||
end;
|
||||
|
||||
procedure ShowNotDone;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=0 to 9999 do begin
|
||||
if not d[i] then Write(Form(i),' ');
|
||||
end;
|
||||
end;
|
||||
|
||||
function Ten(i,e: integer): longint;
|
||||
var x: integer;
|
||||
t: longint;
|
||||
begin
|
||||
if (e>0) then begin
|
||||
for x:=1 to e do i := i * 10;
|
||||
end;
|
||||
Ten := i;
|
||||
end;
|
||||
|
||||
procedure WriteNum(x: integer);
|
||||
begin
|
||||
GotoXY(16,12);
|
||||
Write(x DIV 1000);
|
||||
GotoXY(18,12);
|
||||
Write((x MOD 1000) DIV 100);
|
||||
GotoXY(20,12);
|
||||
Write((x MOD 100) DIV 10);
|
||||
GotoXY(22,12);
|
||||
Write(x MOD 10);
|
||||
end;
|
||||
|
||||
procedure WriteNumFX(x: integer);
|
||||
begin
|
||||
GotoXY(16,12);
|
||||
FXWriteC(Num2Str(x DIV 1000)+' '+Num2Str((x MOD 1000) DIV 100)+' '+Num2Str((x MOD 100) DIV 10)+' '+Num2Str(x MOD 10),15);
|
||||
end;
|
||||
|
||||
procedure GetRandomNumber;
|
||||
var i,x: integer;
|
||||
begin
|
||||
i := 0;
|
||||
Randomize;
|
||||
repeat
|
||||
repeat
|
||||
x := Random(10000);
|
||||
until NOT d[x];
|
||||
WriteNum(x);
|
||||
Sound(1950);
|
||||
Delay(25);
|
||||
NoSound;
|
||||
Delay(i);
|
||||
i := i + 1 + (i DIV 5);
|
||||
until (i>=750);
|
||||
WriteNumFX(x);
|
||||
CursorOff;
|
||||
end;
|
||||
|
||||
procedure DoAsking;
|
||||
var k: char;
|
||||
kc: byte;
|
||||
c: byte;
|
||||
co: integer;
|
||||
i: integer;
|
||||
begin
|
||||
DrawBorder2(20,5,60,20,11,1);
|
||||
Window(21,6,59,19);
|
||||
GotoXY(1,2);
|
||||
FXWriteC('* * * 104.6 RTL * * *',14); WriteLn;
|
||||
FXWriteC('* EURO - MILLIONAER *',15); WriteLn;
|
||||
FXWriteC('* * * * * * * * * * *',14); WriteLn;
|
||||
TextColor(11);
|
||||
WriteLn;
|
||||
WriteFlt(' Knacken Sie den vierstelligen');
|
||||
WriteFlt(' Zahlencode und gewinnen Sie ');
|
||||
WriteLn;
|
||||
TextColor(12);
|
||||
WriteImp(' EINE MILLION EURO');
|
||||
TextColor(11);
|
||||
GotoXY(1,14); FXWriteC('Beenden mit ESC',7);
|
||||
GotoXY(1,12); FXWriteC('_ _ _ _',7);
|
||||
CursorOff;
|
||||
WaitBeep;
|
||||
c := 0;
|
||||
co := 0;
|
||||
repeat
|
||||
k := ReadKey;
|
||||
if k<>#27 then begin
|
||||
if k IN [#48..#57] then begin
|
||||
if (c=0) then begin
|
||||
GotoXY(18,12); TextColor(7); Write('_ _ _');
|
||||
end;
|
||||
GotoXY(16+2*c,12); FXChar(k,15); CursorOff;
|
||||
Inc(c);
|
||||
kc := Ord(k)-48;
|
||||
co := co + Ten(kc,4-c);
|
||||
AckBeep;
|
||||
end;
|
||||
if (k=#8) AND (c>0) then begin
|
||||
Dec(c);
|
||||
GotoXY(16+2*c,12); FXChar('_',7); CursorOff;
|
||||
co := (co DIV Ten(1,4-c)) * Ten(1,4-c);
|
||||
ErrorBeep;
|
||||
end;
|
||||
if (k='r') OR (k='R') then begin
|
||||
TextColor(8);
|
||||
GotoXY(10,13);
|
||||
Write(Space(20));
|
||||
GetRandomNumber;
|
||||
WaitBeep;
|
||||
end;
|
||||
end;
|
||||
if (c=4) then begin
|
||||
GotoXY(10,13);
|
||||
if d[co] then begin
|
||||
TextColor(12);
|
||||
ErrorBeep;
|
||||
WriteFlt('*** CODE FALSCH ***');
|
||||
end else begin
|
||||
TextColor(10);
|
||||
ReadyBeep;
|
||||
WriteFlt('*** PRUEFE CODE ***');
|
||||
end;
|
||||
co := 0;
|
||||
c := 0;
|
||||
CursorOff;
|
||||
end;
|
||||
until k=#27;
|
||||
Window(1,1,80,25);
|
||||
CursorOn;
|
||||
end;
|
||||
|
||||
begin
|
||||
SaveScreen;
|
||||
TextMode(co80);
|
||||
TextColor(7);
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
SetDone;
|
||||
DoStats;
|
||||
{ ShowNotDone; }
|
||||
ShowStats;
|
||||
DoAsking;
|
||||
RestoreScreen;
|
||||
end.
|
||||
291
1046RTL.txt
Normal file
291
1046RTL.txt
Normal file
@ -0,0 +1,291 @@
|
||||
Letzter Eintrag: vom 29.11.2001
|
||||
1034
|
||||
3115
|
||||
4054
|
||||
3003
|
||||
1001
|
||||
1212
|
||||
1156
|
||||
9763
|
||||
2541
|
||||
6349
|
||||
8888
|
||||
2487
|
||||
1172
|
||||
5281
|
||||
7971
|
||||
7049
|
||||
5971
|
||||
4879
|
||||
3653
|
||||
8431
|
||||
1410
|
||||
6971
|
||||
1726
|
||||
8880
|
||||
8221
|
||||
9724
|
||||
0675
|
||||
3185
|
||||
3112
|
||||
8183
|
||||
3874
|
||||
4444
|
||||
8221
|
||||
1305
|
||||
7334
|
||||
7281
|
||||
3823
|
||||
2766
|
||||
3331
|
||||
7559
|
||||
7426
|
||||
0001
|
||||
1768
|
||||
0785
|
||||
3110
|
||||
2408
|
||||
8222
|
||||
5183
|
||||
2018
|
||||
6454
|
||||
9456
|
||||
1545
|
||||
1891
|
||||
2003
|
||||
1163
|
||||
7628
|
||||
7992
|
||||
0251
|
||||
2909
|
||||
1791
|
||||
2811
|
||||
4678
|
||||
9816
|
||||
2648
|
||||
0715
|
||||
7862
|
||||
0929
|
||||
1188
|
||||
8271
|
||||
2305
|
||||
8375
|
||||
3112
|
||||
9093
|
||||
8273
|
||||
5169
|
||||
3645
|
||||
8882
|
||||
5944
|
||||
1222
|
||||
4715
|
||||
2051
|
||||
5444
|
||||
5939
|
||||
9569
|
||||
7342
|
||||
2306
|
||||
5891
|
||||
3624
|
||||
5348
|
||||
6413
|
||||
0000
|
||||
7370
|
||||
0501
|
||||
1109
|
||||
0220
|
||||
2501
|
||||
5185
|
||||
1291
|
||||
6881
|
||||
2609
|
||||
1070
|
||||
8598
|
||||
5869
|
||||
2808
|
||||
1037
|
||||
2743
|
||||
0815
|
||||
2288
|
||||
3830
|
||||
7575
|
||||
0311
|
||||
2509
|
||||
2304
|
||||
6437
|
||||
7166
|
||||
1403
|
||||
7539
|
||||
1328
|
||||
1967
|
||||
1997
|
||||
0803
|
||||
4711
|
||||
6543
|
||||
8230
|
||||
3921
|
||||
3748
|
||||
7777
|
||||
4802
|
||||
4635
|
||||
3951
|
||||
0046
|
||||
1109
|
||||
1276
|
||||
2012
|
||||
0057
|
||||
1492
|
||||
4113
|
||||
7788
|
||||
0612
|
||||
7780
|
||||
1427
|
||||
9008
|
||||
9146
|
||||
9969
|
||||
2481
|
||||
1744
|
||||
0312
|
||||
4967
|
||||
2708
|
||||
6843
|
||||
3879
|
||||
1955
|
||||
1605
|
||||
3904
|
||||
1958
|
||||
1909
|
||||
0508
|
||||
0805
|
||||
2534
|
||||
9867
|
||||
2001
|
||||
1308
|
||||
1948
|
||||
6501
|
||||
6075
|
||||
1550
|
||||
1245
|
||||
4268
|
||||
1920
|
||||
1415
|
||||
1973
|
||||
1510
|
||||
2159
|
||||
2308
|
||||
2146
|
||||
2899
|
||||
4417
|
||||
7851
|
||||
6899
|
||||
7812
|
||||
5841
|
||||
2516
|
||||
4210
|
||||
9232
|
||||
2728
|
||||
2762
|
||||
1956
|
||||
0714
|
||||
8123
|
||||
8245
|
||||
1102
|
||||
3976
|
||||
1376
|
||||
1993
|
||||
6323
|
||||
5398
|
||||
1504
|
||||
1876
|
||||
4378
|
||||
1110
|
||||
1049
|
||||
3430
|
||||
8016
|
||||
0705
|
||||
0616
|
||||
0205
|
||||
0185
|
||||
4805
|
||||
2405
|
||||
1712
|
||||
9823
|
||||
9876
|
||||
0612
|
||||
1956
|
||||
0610
|
||||
1057
|
||||
8192
|
||||
2955
|
||||
1904
|
||||
5620
|
||||
1302
|
||||
2607
|
||||
4521
|
||||
0215
|
||||
8020
|
||||
1234
|
||||
1612
|
||||
1991
|
||||
2256
|
||||
1975
|
||||
1968
|
||||
5396
|
||||
2311
|
||||
1702
|
||||
7236
|
||||
4793
|
||||
7927
|
||||
2112
|
||||
9748
|
||||
2105
|
||||
4100
|
||||
7681
|
||||
1822
|
||||
1460
|
||||
6965
|
||||
1312
|
||||
6401
|
||||
1995
|
||||
2211
|
||||
7821
|
||||
8413
|
||||
6593
|
||||
3008
|
||||
0911
|
||||
1307
|
||||
9328
|
||||
2002
|
||||
2008
|
||||
8187
|
||||
8174
|
||||
1046
|
||||
8316
|
||||
0308
|
||||
9991
|
||||
0190
|
||||
1207
|
||||
5962
|
||||
2412
|
||||
5137
|
||||
2805
|
||||
1354
|
||||
5216
|
||||
4669
|
||||
8802
|
||||
1709
|
||||
2210
|
||||
8848
|
||||
8755
|
||||
4012
|
||||
4386
|
||||
7381
|
||||
3648
|
||||
0909
|
||||
2406
|
||||
3876
|
||||
8467
|
||||
7295
|
||||
0101
|
||||
4848
|
||||
5625
|
||||
83
971211.PAS
Normal file
83
971211.PAS
Normal file
@ -0,0 +1,83 @@
|
||||
program Zeitvertreib111297;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var Warschon: array[1..80, 1..50] of boolean;
|
||||
Randx: integer;
|
||||
Randy: integer;
|
||||
loc: integer;
|
||||
|
||||
label Hier;
|
||||
|
||||
const Chars: string = 'ÛÜß '; {±²°';}
|
||||
xmax = 80;
|
||||
ymax = 49;
|
||||
del = 0;
|
||||
|
||||
procedure Init;
|
||||
var i,j: integer;
|
||||
begin
|
||||
TextBackground(black);
|
||||
Randomize;
|
||||
for i:=1 to xmax do begin
|
||||
for j:=1 to ymax do begin
|
||||
Warschon[i,j] := False;
|
||||
end;
|
||||
end;
|
||||
loc := Length(Chars);
|
||||
end;
|
||||
|
||||
procedure GetRandomNumbers;
|
||||
label Hier2;
|
||||
begin
|
||||
Hier2:
|
||||
Randx := Random(xmax) + 1;
|
||||
Randy := Random(ymax) + 1;
|
||||
if Warschon[randx,randy] then goto Hier2;
|
||||
end;
|
||||
|
||||
function GetRandomChar: string;
|
||||
var rand: integer;
|
||||
begin
|
||||
rand := Random(loc) + 1;
|
||||
GetRandomChar := Chars[rand];
|
||||
end;
|
||||
|
||||
function Check: boolean;
|
||||
var i,j: integer;
|
||||
begin
|
||||
Check := False;
|
||||
for i:=1 to xmax do begin
|
||||
for j:=1 to ymax do begin
|
||||
if Warschon[i,j]=False then begin
|
||||
Check:=True;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WritePix(x,y: integer);
|
||||
begin
|
||||
GotoXY(x,y);
|
||||
TextColor(Random(16));
|
||||
TextBackground(Random(16));
|
||||
Write(GetRandomChar);
|
||||
Warschon[x,y] := true;
|
||||
end;
|
||||
|
||||
begin
|
||||
TextMode(CO80 + Font8x8);
|
||||
ClrScr;
|
||||
Init;
|
||||
Hier:
|
||||
GetRandomNumbers;
|
||||
WritePix(randx,randy);
|
||||
Delay(del);
|
||||
if keypressed then exit;
|
||||
if Check then goto Hier;
|
||||
Init;
|
||||
goto Hier;
|
||||
GotoXY(1,1);
|
||||
ReadKey;
|
||||
end.
|
||||
103
990914.PAS
Normal file
103
990914.PAS
Normal file
@ -0,0 +1,103 @@
|
||||
uses Crt;
|
||||
|
||||
const input='test.bmp'; { 80x49x16 Bitmap }
|
||||
|
||||
var Data: array[1..80,1..98] of byte;
|
||||
Orig: array[0..4096] of byte;
|
||||
pos: integer;
|
||||
first4: boolean;
|
||||
|
||||
function GetNext: byte;
|
||||
begin
|
||||
if (first4) then begin
|
||||
GetNext := Orig[pos] DIV 16;
|
||||
first4 := false;
|
||||
end else begin
|
||||
GetNext := Orig[pos] MOD 16;
|
||||
first4 := true;
|
||||
Inc(pos);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoadFile;
|
||||
const Datadelta=118;
|
||||
var f: File;
|
||||
result: word;
|
||||
i,j: integer;
|
||||
begin
|
||||
Assign(f, input);
|
||||
Reset(f);
|
||||
BlockRead(f, Orig, FileSize(f), result);
|
||||
if (result<>FileSize(f)) then begin
|
||||
TextColor(12);
|
||||
WriteLn('FEHLER!');
|
||||
TextColor(15);
|
||||
WriteLn('Es wurden nur ',result,' Bytes von ',FileSize(f),' gelesen.');
|
||||
ReadKey;
|
||||
end;
|
||||
if (Orig[18]<>80) OR (Orig[22]<>98) then begin
|
||||
TextColor(12);
|
||||
WriteLn('FEHLER!');
|
||||
TextColor(15);
|
||||
WriteLn('Die zu ladende BMP-Datei ist nicht im Format 80x98!');
|
||||
WriteLn(input,': ',Orig[18],'x',Orig[22]);
|
||||
Halt;
|
||||
end;
|
||||
first4 := true;
|
||||
pos := Datadelta;
|
||||
for i:=98 downto 1 do
|
||||
for j:=1 to 80 do
|
||||
Data[j,i] := GetNext;
|
||||
end;
|
||||
|
||||
function BMP2CRT(x: byte): byte;
|
||||
begin
|
||||
case x of
|
||||
0: BMP2CRT:=0;
|
||||
1: BMP2CRT:=4;
|
||||
2: BMP2CRT:=2;
|
||||
3: BMP2CRT:=6;
|
||||
4: BMP2CRT:=1;
|
||||
5: BMP2CRT:=5;
|
||||
6: BMP2CRT:=3;
|
||||
7: BMP2CRT:=8;
|
||||
8: BMP2CRT:=7;
|
||||
9: BMP2CRT:=12;
|
||||
10: BMP2CRT:=10;
|
||||
11: BMP2CRT:=14;
|
||||
12: BMP2CRT:=9;
|
||||
13: BMP2CRT:=13;
|
||||
14: BMP2CRT:=11;
|
||||
15: BMP2CRT:=15;
|
||||
else
|
||||
BMP2CRT:=x;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ShowFile;
|
||||
var i,j: integer;
|
||||
c1,c2: byte;
|
||||
begin
|
||||
for i:=1 to 49 do
|
||||
for j:=1 to 80 do begin
|
||||
GotoXY(j,i);
|
||||
c1 := Data[j,i*2-1];
|
||||
c2 := Data[j,i*2];
|
||||
{ if (c1>7) then c1 := c1-8;
|
||||
if (c2>7) then c2 := c2-8; }
|
||||
TextColor(BMP2CRT(c1));
|
||||
TextBackground(BMP2CRT(c2));
|
||||
Write('ß');
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
TextMode(co80 + Font8x8);
|
||||
TextColor(15);
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
LoadFile;
|
||||
ShowFile;
|
||||
|
||||
|
||||
end.
|
||||
114
990915.PAS
Normal file
114
990915.PAS
Normal file
@ -0,0 +1,114 @@
|
||||
uses Graph, Crt, BGIP;
|
||||
|
||||
const input='face.bmp'; { Bitmap x*y*16 }
|
||||
firstblock=118;
|
||||
blocksize=4095;
|
||||
|
||||
var Orig: array[0..blocksize] of byte;
|
||||
pos: integer;
|
||||
first4: boolean;
|
||||
wi,he: longint;
|
||||
f: file;
|
||||
result: word;
|
||||
xmax,ymax: integer;
|
||||
|
||||
procedure OpenFile;
|
||||
begin
|
||||
Assign(f,input);
|
||||
Reset(f,1);
|
||||
BlockRead(f,Orig,SizeOf(Orig),result);
|
||||
if (result<>SizeOf(Orig)) AND (result<>FileSize(f) MOD blocksize) then begin
|
||||
TextColor(12);
|
||||
WriteLn('FEHLER!!');
|
||||
TextColor(15);
|
||||
WriteLn('Es wurden nur ',result,' Bytes gelesen, statt ',SizeOf(Orig),'.');
|
||||
Halt;
|
||||
end;
|
||||
wi := Orig[19]*256 + Orig[18];
|
||||
he := Orig[23]*256 + Orig[22];
|
||||
WriteLn('Image size: ',wi,'x',he,' (',(wi*he) DIV 2,' Bytes image data)');
|
||||
WriteLn(FileSize(f),' Bytes filesize');
|
||||
ReadKey;
|
||||
pos := firstblock;
|
||||
first4 := true;
|
||||
end;
|
||||
|
||||
procedure GraphInit;
|
||||
var grDriver, grMode : integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
{ VGAlo 640x200x16
|
||||
VGAmed 640x350x16
|
||||
VGAhi 640x480x16 }
|
||||
grMode := VGAhi;
|
||||
InitGraph(grDriver,grMode,BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
end;
|
||||
|
||||
function BMP2CRT(x: byte): byte;
|
||||
begin
|
||||
case x of
|
||||
0: BMP2CRT:=0;
|
||||
1: BMP2CRT:=4;
|
||||
2: BMP2CRT:=2;
|
||||
3: BMP2CRT:=6;
|
||||
4: BMP2CRT:=1;
|
||||
5: BMP2CRT:=5;
|
||||
6: BMP2CRT:=3;
|
||||
7: BMP2CRT:=8;
|
||||
8: BMP2CRT:=7;
|
||||
9: BMP2CRT:=12;
|
||||
10: BMP2CRT:=10;
|
||||
11: BMP2CRT:=14;
|
||||
12: BMP2CRT:=9;
|
||||
13: BMP2CRT:=13;
|
||||
14: BMP2CRT:=11;
|
||||
15: BMP2CRT:=15;
|
||||
else
|
||||
BMP2CRT:=x;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetNextPixCol: byte;
|
||||
begin
|
||||
if (first4) then begin
|
||||
GetNextPixCol := Orig[pos] DIV 16;
|
||||
first4 := false;
|
||||
end else begin
|
||||
GetNextPixCol := Orig[pos] MOD 16;
|
||||
first4 := true;
|
||||
Inc(pos);
|
||||
end;
|
||||
if (pos>blocksize) then begin
|
||||
BlockRead(f,Orig,SizeOf(Orig),result);
|
||||
if (result<>SizeOf(Orig)) AND (result<>FileSize(f) MOD (blocksize+1)) AND (result<>0) then begin
|
||||
CloseGraph;
|
||||
TextMode(co80);
|
||||
TextColor(12);
|
||||
WriteLn('FEHLER!!');
|
||||
TextColor(15);
|
||||
WriteLn('Es wurden nur ',result,' Bytes gelesen, statt ',SizeOf(Orig),'.');
|
||||
Halt;
|
||||
end;
|
||||
pos := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ShowGraph;
|
||||
var i,j: integer;
|
||||
begin
|
||||
for j:=he downto 1 do
|
||||
for i:=1 to wi+6 do begin
|
||||
{ WriteLn(i,'x',j,'- ',GetNextPixCol); }
|
||||
PutPixel(i,j,BMP2CRT(GetNextPixCol));
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
OpenFile;
|
||||
Graphinit;
|
||||
ShowGraph;
|
||||
ReadKey;
|
||||
|
||||
end.
|
||||
61
991011.PAS
Normal file
61
991011.PAS
Normal file
@ -0,0 +1,61 @@
|
||||
program JumpDot;
|
||||
|
||||
uses Crt, Graph, BGIP, DOS;
|
||||
|
||||
const grav=9.80665;
|
||||
fac=15;
|
||||
|
||||
var xmax,ymax: word;
|
||||
xmed,ymed: word;
|
||||
dx, dy: word;
|
||||
i: integer;
|
||||
down: boolean;
|
||||
di: word;
|
||||
h,m,s,ss: word;
|
||||
sts, sss: longint;
|
||||
|
||||
procedure Init;
|
||||
var grDriver, grMode : integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAHi;
|
||||
InitGraph(grDriver,grMode,BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xmax DIV 2;
|
||||
ymed := ymax DIV 2;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
dx := 0; dy := 10;
|
||||
down := true;
|
||||
{ GetTime(h,m,s,ss);
|
||||
sts := h*60*60*100 + m*60*100 + s*100 + ss; }
|
||||
di := 0;
|
||||
for i:=0 to xmax do begin
|
||||
{ GetTime(h,m,s,ss);
|
||||
sss := (h*60*60*100 + m*60*100 + s*100 + ss)-(sts); }
|
||||
dx := i;
|
||||
{ dy := Round((9.80665)*Sqr(sss/100)); }
|
||||
if (down) then dy := Round((grav/2)*Sqr((i-di)/fac)) else dy := Round((grav/2)*Sqr((di-(i-di))/fac));
|
||||
if (dy>ymax) then begin
|
||||
down:=false;
|
||||
dy:=ymax-1;
|
||||
di:=i-di;
|
||||
end;
|
||||
if (dy<=0) AND (di<i-10) then begin
|
||||
down:=true;
|
||||
dy:=0;
|
||||
di:=i;
|
||||
end;
|
||||
PutPixel(dx,dy,15);
|
||||
if (down) then PutPixel(0,0,10) else PutPixel(0,0,12);
|
||||
Delay(10);
|
||||
|
||||
|
||||
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
80
991129.PAS
Normal file
80
991129.PAS
Normal file
@ -0,0 +1,80 @@
|
||||
program BinaryWatch;
|
||||
|
||||
uses Crt, Graph, BGIP;
|
||||
|
||||
type TTri=record
|
||||
P: array[1..3] of PointType;
|
||||
end;
|
||||
TRow1=record
|
||||
Tri: array[1..3] of TTri;
|
||||
end;
|
||||
TRow23=record
|
||||
Tri: array[1..5] of TTri;
|
||||
end;
|
||||
|
||||
const Cu=4;
|
||||
Cd=3;
|
||||
Row1: TRow1 =(Tri:((P:((X:430;Y: 10),(X:510;Y:150),(X:349;Y:150))),(P:((X:320;Y:150),(X:239;Y: 10),(X:400;Y: 10))),
|
||||
(P:((X:210;Y: 10),(X:290;Y:150),(X:129;Y:150)))));
|
||||
Row2: TRow23=(Tri:((P:((X:540;Y:170),(X:620;Y:310),(X:459;Y:310))),(P:((X:430;Y:310),(X:349;Y:170),(X:510;Y:170))),
|
||||
(P:((X:320;Y:170),(X:400;Y:310),(X:239;Y:310))),(P:((X:210;Y:310),(X:129;Y:170),(X:290;Y:170))),
|
||||
(P:((X:100;Y:170),(X:180;Y:310),(X: 19;Y:310)))));
|
||||
Row3: TRow23=(Tri:((P:((X:540;Y:470),(X:459;Y:330),(X:620;Y:330))),(P:((X:430;Y:330),(X:510;Y:470),(X:349;Y:470))),
|
||||
(P:((X:320;Y:470),(X:239;Y:330),(X:400;Y:330))),(P:((X:210;Y:330),(X:290;Y:470),(X:129;Y:470))),
|
||||
(P:((X:100;Y:470),(X: 19;Y:330),(X:180;Y:330)))));
|
||||
|
||||
var xmax,ymax: integer;
|
||||
|
||||
procedure GraphInit;
|
||||
var grDriver, grMode : integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
{ VGAlo 640x200x16
|
||||
VGAmed 640x350x16
|
||||
VGAhi 640x480x16 }
|
||||
grMode := VGAhi;
|
||||
InitGraph(grDriver,grMode,BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
end;
|
||||
|
||||
procedure GraphOutit;
|
||||
begin
|
||||
TextMode(co80 + Font8x8);
|
||||
end;
|
||||
|
||||
procedure DrawTriangles;
|
||||
var i,c: integer;
|
||||
begin
|
||||
{ Upper row }
|
||||
for i:=1 to 3 do begin
|
||||
if (i MOD 2)=0 then c:=3 else c:=4;
|
||||
SetColor(c);
|
||||
SetFillStyle(SolidFill,c);
|
||||
FillPoly(SizeOf(Row1.Tri[i]) DIV SizeOf(PointType), Row1.Tri[i]);
|
||||
end;
|
||||
{ Middle row }
|
||||
for i:=1 to 5 do begin
|
||||
if (i MOD 2)=0 then c:=3 else c:=4;
|
||||
SetColor(c);
|
||||
SetFillStyle(SolidFill,c);
|
||||
FillPoly(SizeOf(Row2.Tri[i]) DIV SizeOf(PointType), Row2.Tri[i]);
|
||||
end;
|
||||
{ Lower row }
|
||||
for i:=1 to 5 do begin
|
||||
if (i MOD 2)=0 then c:=4 else c:=3;
|
||||
SetColor(c);
|
||||
SetFillStyle(SolidFill,c);
|
||||
FillPoly(SizeOf(Row3.Tri[i]) DIV SizeOf(PointType), Row3.Tri[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
GraphInit;
|
||||
SetFillStyle(SolidFill,15);
|
||||
SetColor(15);
|
||||
Bar(0,0,xmax,ymax);
|
||||
DrawTriangles;
|
||||
ReadKey;
|
||||
GraphOutit;
|
||||
end.
|
||||
50
ADDARRAY.PAS
Normal file
50
ADDARRAY.PAS
Normal file
@ -0,0 +1,50 @@
|
||||
program AddArray;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var Ergb: integer;
|
||||
List: array[1..100] of integer;
|
||||
ASize: integer;
|
||||
|
||||
procedure AddValue(index: integer; var ender: integer);
|
||||
begin
|
||||
ender := ender + List[index];
|
||||
end;
|
||||
|
||||
procedure GetArray;
|
||||
var i: integer;
|
||||
label InpNext;
|
||||
begin
|
||||
i := 1;
|
||||
WriteLn('Werte eingeben! Ende mit 0.');
|
||||
repeat
|
||||
Write('Wert ',i,' = ');
|
||||
ReadLn(List[i]);
|
||||
ASize := i;
|
||||
Inc(i);
|
||||
until List[i-1]=0;
|
||||
end;
|
||||
|
||||
procedure CalcArray;
|
||||
var i: integer;
|
||||
begin
|
||||
Ergb := 0;
|
||||
for i:=1 to ASize do begin
|
||||
Ergb := Ergb + List[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
WriteLn('-=ðþ MBUIAZ þð=-'); { Markus Birth's Ultimativer Intellektueller Array Zusammenfasser }
|
||||
WriteLn;
|
||||
GetArray;
|
||||
WriteLn;
|
||||
CalcArray;
|
||||
WriteLn('Ergebnis: ',Ergb);
|
||||
WriteLn;
|
||||
WriteLn('=== BITTE TASTE DRšCKEN ===');
|
||||
ReadKey;
|
||||
end.
|
||||
60
ALK.PAS
Normal file
60
ALK.PAS
Normal file
@ -0,0 +1,60 @@
|
||||
program Alkoholberechnung; { Autor: Markus Birth }
|
||||
uses Crt, Logo;
|
||||
var Menge, Gewicht, Alkoholml, Alkoholg, Promille, Abbauzeit, AZh, AZm, AZs, Redfaktor: real;
|
||||
vol: integer;
|
||||
Geschlecht: char;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
TextColor(15);
|
||||
WriteLn('-=ðþ Alkoholberechnung þð=-');
|
||||
WriteLn;
|
||||
WriteLn('3rd program by');
|
||||
WriteLogo;
|
||||
TextColor(15);
|
||||
Write('Aufgenommene Menge in ml: ');
|
||||
ReadLn(Menge);
|
||||
Write('Anteil Alkohol (% vol.): ');
|
||||
ReadLn(vol);
|
||||
Write('Gewicht der Person in kg: ');
|
||||
ReadLn(Gewicht);
|
||||
TextColor(7);
|
||||
Write('Ist die Person ein ');
|
||||
TextColor(14);
|
||||
Write('M');
|
||||
TextColor(7);
|
||||
Write('ann oder eine ');
|
||||
TextColor(14);
|
||||
Write('F');
|
||||
TextColor(7);
|
||||
Write('rau? ');
|
||||
TextColor(15);
|
||||
Geschlecht := ReadKey;
|
||||
WriteLn(Geschlecht);
|
||||
case Geschlecht of
|
||||
'm','M': Redfaktor := 0.7;
|
||||
'f','F': Redfaktor := 0.6;
|
||||
else
|
||||
WriteLn('ERROR! Using male factor.');
|
||||
Redfaktor := 0.7;
|
||||
end;
|
||||
WriteLn('============');
|
||||
WriteLn('Reduktionsfaktor : ',Redfaktor:1:1);
|
||||
Alkoholml := Menge*(vol/100);
|
||||
WriteLn('Enthaltener Alkohol in ml: ',Alkoholml:4:2);
|
||||
Alkoholg := Alkoholml*0.8;
|
||||
WriteLn('Enthaltener Alkohol in g : ',Alkoholg:4:2);
|
||||
Promille := Alkoholg/(Gewicht*Redfaktor);
|
||||
WriteLn('Promille im Blut : ',Promille:1:4);
|
||||
if Promille > 3.2 then Write('Dieser Mensch ist schon so gut wie tot!');
|
||||
if Promille > 5 then WriteLn(' --- Berichtigung: Er IST tot! ---') else WriteLn;
|
||||
Abbauzeit := Promille/0.15;
|
||||
WriteLn('Abbauzeit in h : ',Abbauzeit:3:4);
|
||||
AZh := Int(Abbauzeit);
|
||||
AZm := (Abbauzeit-Int(Abbauzeit))*60;
|
||||
AZs := (AZm-Int(AZm))*60;
|
||||
WriteLn('Abbauzeit : ',AZh:2:0,'h ',AZm:2:0,'m ',AZs:2:0,'s');
|
||||
WriteLn;
|
||||
WriteLn('Bitte eine Taste dr<64>cken...');
|
||||
repeat until Keypressed;
|
||||
end.
|
||||
26
BASICSTR.PAS
Normal file
26
BASICSTR.PAS
Normal file
@ -0,0 +1,26 @@
|
||||
unit BasicStrings;
|
||||
|
||||
interface
|
||||
function Mid(Txt: string; Index: integer; Count: integer): string;
|
||||
function Left(Txt: string; Count: integer): string;
|
||||
function Right(Txt: string; Count: integer): string;
|
||||
|
||||
implementation
|
||||
function Mid(Txt: string; Index: integer; Count: integer): string;
|
||||
begin
|
||||
Mid := Copy(Txt, Index, Count);
|
||||
end;
|
||||
|
||||
function Left(Txt: string; Count: integer): string;
|
||||
begin
|
||||
Left := Copy(Txt, 1, Count);
|
||||
end;
|
||||
|
||||
function Right(Txt: string; Count: integer): string;
|
||||
begin
|
||||
Right := Copy(Txt, Length(Txt)-Count+1, Length(Txt)-(Length(Txt)-Count));
|
||||
end;
|
||||
|
||||
begin
|
||||
WriteLn('þ Loading Unit: BasicStrings - geschrieben von RoboCop IND.');
|
||||
end.
|
||||
13
BASICTST.PAS
Normal file
13
BASICTST.PAS
Normal file
@ -0,0 +1,13 @@
|
||||
program TestBasicStrings;
|
||||
|
||||
uses BasicStrings, Crt;
|
||||
|
||||
var Txt: string;
|
||||
|
||||
begin
|
||||
Txt := 'Dies ist ein Test-String';
|
||||
WriteLn('Urstring: '+Txt);
|
||||
WriteLn('8 Linke Zeichen: '+Left(Txt, 8));
|
||||
WriteLn('7 Zeichen ab 6. Position: '+Mid(Txt, 6, 7));
|
||||
WriteLn('6 Rechte Zeichen: '+Right(Txt , 6));
|
||||
end.
|
||||
1
BGIPATH.PAS
Normal file
1
BGIPATH.PAS
Normal file
@ -0,0 +1 @@
|
||||
BGIPath = 'C:\SCHULS~1\TP\BGI';
|
||||
42
BLINK.PAS
Normal file
42
BLINK.PAS
Normal file
@ -0,0 +1,42 @@
|
||||
program blink;
|
||||
|
||||
uses Crt,CursorOnOff;
|
||||
|
||||
const xlen=20;
|
||||
ylen=10;
|
||||
|
||||
var x1,x2,y1,y2: byte;
|
||||
|
||||
procedure FillCol(col: byte);
|
||||
var i,j: byte;
|
||||
begin
|
||||
TextColor(col);
|
||||
GotoXY(1,1);
|
||||
for i:=y1 to y2 do begin
|
||||
for j:=x1 to x2 do begin
|
||||
Write('Û');
|
||||
end;
|
||||
end;
|
||||
delay(50);
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
x1 := 40-xlen div 2;
|
||||
x2 := 40+xlen div 2;
|
||||
y1 := 12-ylen div 2;
|
||||
y2 := 12+ylen div 2;
|
||||
|
||||
window(x1,y1,x2,y2);
|
||||
CursorOff;
|
||||
repeat
|
||||
FillCol(0);
|
||||
FillCol(8);
|
||||
FillCol(7);
|
||||
FillCol(15);
|
||||
FillCol(7);
|
||||
FillCol(8);
|
||||
until keypressed;
|
||||
CursorOn;
|
||||
ReadKey;
|
||||
end.
|
||||
167
BLUES.PAS
Normal file
167
BLUES.PAS
Normal file
@ -0,0 +1,167 @@
|
||||
program BlueS;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const FILEZ:array[0..27] of string=('atapi.sys','Disk.sys','Ntfs.sys','Cdrom.SYS','Null.SYS','Beep.SYS',
|
||||
'i8042prt.sys','kbdclass.sys','s3mini.sys','Msfs.SYS','NDIS.SYS',
|
||||
's3trio3d.dll','FSFILTER.SYS','FSAVP.SYS','nbf.sys','Floppy.SYS',
|
||||
'CLASS2.SYS','SCSIPORT.SYS','win32k.sys','Cdfs.SYS','Fastfat.SYS',
|
||||
'hcioPort.SYS','ParVdm.SYS','Parport.SYS','afd.sys','netbt.sys',
|
||||
'nwlnkb.sys','###');
|
||||
|
||||
var FILEZc: integer;
|
||||
exitnow: boolean;
|
||||
oldhex: string;
|
||||
|
||||
procedure Init;
|
||||
var i: integer;
|
||||
begin
|
||||
exitnow := false;
|
||||
i := 0;
|
||||
repeat
|
||||
Inc(i);
|
||||
until (FILEZ[i]='###');
|
||||
FILEZc := i;
|
||||
Randomize;
|
||||
TextMode(co80 + Font8x8);
|
||||
TextColor(7);
|
||||
TextBackground(1);
|
||||
ClrScr;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
GotoXY(1,1);
|
||||
if NOT (exitnow) then ReadKey;
|
||||
end;
|
||||
|
||||
procedure RandHex(x,y: integer; pre, cap, lowonly, old: boolean);
|
||||
const HexSet:string='0123456789abcdef';
|
||||
var i,mx: integer;
|
||||
begin
|
||||
GotoXY(x,y);
|
||||
if (pre) then Write('0x');
|
||||
if (lowonly) then begin
|
||||
Write('0000');
|
||||
mx := 4;
|
||||
end else mx := 8;
|
||||
if (NOT old) then begin
|
||||
oldhex := '';
|
||||
for i:=1 to mx do oldhex := oldhex + HexSet[Random(16)+1];
|
||||
end;
|
||||
if (cap) then for i:=1 to Length(oldhex) do Write(UpCase(oldhex[i])) else Write(oldhex);
|
||||
end;
|
||||
|
||||
procedure RandFile(x,y: integer);
|
||||
begin
|
||||
GotoXY(x,y);
|
||||
Write(FILEZ[Random(FILEZc)]);
|
||||
end;
|
||||
|
||||
procedure Mask;
|
||||
var i: integer;
|
||||
begin
|
||||
GotoXY(1,6);
|
||||
Write('CPUID:');
|
||||
i := Random(3)+1;
|
||||
case i of
|
||||
1: Write('AuthenticAMD');
|
||||
2: Write('IntelInside');
|
||||
3: Write('CyrixInstead');
|
||||
end;
|
||||
Write(' 5.8.c irql:1f ');
|
||||
i := Random(2);
|
||||
if (i=1) then Write('DPC ');
|
||||
Write('SYSVER 0xoooooooo');
|
||||
RandHex(WhereX-10,6,true,false,false,false);
|
||||
GotoXY(1,8);
|
||||
Write('Dll Base DateStmp - Name Dll Base DateStmp - Name');
|
||||
GotoXY(1,35);
|
||||
Write('Address dword dump Build [1381] - Name');
|
||||
end;
|
||||
|
||||
procedure FillOutError;
|
||||
begin
|
||||
begin
|
||||
GotoXY(1,2);
|
||||
WriteLn('*** STOP: 0xoooooooo (0xoooooooo, 0xoooooooo, 0xoooooooo, 0xoooooooo)');
|
||||
WriteLn('IRQL_NOT_LESS_OR_EQUAL*** Address oooooooo has base at oooooooo - ');
|
||||
RandHex(11,2,true,true,true,false);
|
||||
RandHex(23,2,true,true,false,false);
|
||||
RandHex(35,2,true,true,true,false);
|
||||
RandHex(47,2,true,true,true,false);
|
||||
RandHex(59,2,true,true,false,false);
|
||||
RandHex(35,3,false,false,false,true);
|
||||
RandHex(56,3,false,false,false,false);
|
||||
RandFile(67,3);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FillOutDlls;
|
||||
var c,x: integer;
|
||||
done: boolean;
|
||||
begin
|
||||
GotoXY(1,9);
|
||||
for c:=1 to 25 do begin
|
||||
done := false;
|
||||
repeat
|
||||
if (done) then x:=40 else x:=1;
|
||||
GotoXY(x,WhereY);
|
||||
RandHex(WhereX,WhereY,false,false,false,false);
|
||||
Write(' ');
|
||||
RandHex(WhereX,WhereY,false,false,false,false); { DATUM }
|
||||
Write(' - ');
|
||||
RandFile(WhereX,WhereY);
|
||||
done := true;
|
||||
until ((done) AND (x=40));
|
||||
WriteLn;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FillOutDump;
|
||||
var c,i: integer;
|
||||
begin
|
||||
GotoXY(1,36);
|
||||
for c:=1 to 10 do begin
|
||||
for i:=1 to 7 do begin
|
||||
RandHex(WhereX,WhereY,false,false,false,false);
|
||||
Write(' ');
|
||||
end;
|
||||
Write('- ');
|
||||
if (c=1) then Write('ntoskrnl.exe') else RandFile(WhereX,WhereY);
|
||||
WriteLn;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MemDump;
|
||||
var i: integer;
|
||||
begin
|
||||
i := 0;
|
||||
GotoXY(1,47);
|
||||
WriteLn('Beginnen des Speicherabbildes');
|
||||
Write('Speicher wird auf Datentr„ger abgebildet: ');
|
||||
for i:=1 to 100 do begin
|
||||
GotoXY(43,48);
|
||||
Write(i:3);
|
||||
GotoXY(1,1);
|
||||
Delay(Random(300)+250);
|
||||
if (keypressed) then begin
|
||||
ReadKey;
|
||||
exitnow := true;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
GotoXY(1,48);
|
||||
WriteLn('Speicherabbild abgeschlossen. Wenden Sie sich an den Systemadministrator');
|
||||
Write('oder einen Techniker.');
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
Mask;
|
||||
FillOutError;
|
||||
FillOutDlls;
|
||||
FillOutDump;
|
||||
MemDump;
|
||||
Outit;
|
||||
end.
|
||||
20
BP-HILFE/BAR3D.PAS
Normal file
20
BP-HILFE/BAR3D.PAS
Normal file
@ -0,0 +1,20 @@
|
||||
uses Graph;
|
||||
|
||||
var
|
||||
Gd, Gm: Integer;
|
||||
Y0, Y1, Y2, X1, X2: Integer;
|
||||
begin
|
||||
Gd := Detect;
|
||||
InitGraph(Gd, Gm, 'F:\SPRACHEN\BP\BGI\');
|
||||
if GraphResult <> grOk then
|
||||
Halt(1);
|
||||
Y0 := 10;
|
||||
Y1 := 60;
|
||||
Y2 := 110;
|
||||
X1 := 10;
|
||||
X2 := 50;
|
||||
Bar3D(X1, Y0, X2, Y1, 10, TopOn);
|
||||
Bar3D(X1, Y1, X2, Y2, 10, TopOff);
|
||||
Readln;
|
||||
CloseGraph;
|
||||
end.
|
||||
14
BP-HILFE/ORD.PAS
Normal file
14
BP-HILFE/ORD.PAS
Normal file
@ -0,0 +1,14 @@
|
||||
{Ord.PAS}
|
||||
|
||||
{Beispielcode f<>r die Funktion Ord }
|
||||
|
||||
uses Crt;
|
||||
|
||||
type
|
||||
Colors = (RED,GREEN,BLUE);
|
||||
begin
|
||||
Writeln('BLUE has an ordinal value of ',
|
||||
Ord(BLUE));
|
||||
Writeln('The ASCII code for "c" is ',
|
||||
Ord('c'), ' decimal');
|
||||
end.
|
||||
36
CODER_T.OLD
Normal file
36
CODER_T.OLD
Normal file
@ -0,0 +1,36 @@
|
||||
program Coder_Test;
|
||||
|
||||
uses Crt, Coder;
|
||||
|
||||
var org,x: string;
|
||||
|
||||
begin
|
||||
TextBackground(0);
|
||||
TextColor(15);
|
||||
ClrScr;
|
||||
Write('Zu verschl<68>sselnder Text: ');
|
||||
ReadLn(org);
|
||||
RSInit := Length(org)*11;
|
||||
WriteLn('RandSeed: ',RSInit);
|
||||
WriteLn;
|
||||
|
||||
x := org;
|
||||
Write('OrdCode (co=true) :');
|
||||
OrdCode(x,code);
|
||||
WriteLn(x);
|
||||
|
||||
x := org;
|
||||
Write('OrdCode (co=false) :');
|
||||
OrdCode(x,decode);
|
||||
WriteLn(x);
|
||||
|
||||
x := org;
|
||||
Write('SortCode (co=true) :');
|
||||
SortCode(x,code);
|
||||
WriteLn(x);
|
||||
|
||||
x := org;
|
||||
Write('SortCode (co=false):');
|
||||
SortCode(x,decode);
|
||||
WriteLn(x);
|
||||
end.
|
||||
56
CODER_T.PAS
Normal file
56
CODER_T.PAS
Normal file
@ -0,0 +1,56 @@
|
||||
program Coder_Test;
|
||||
|
||||
uses Crt, Coder;
|
||||
|
||||
var org,x: string;
|
||||
|
||||
begin
|
||||
TextColor(15);
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
Write('Zu verschl<68>sselnder Text: ');
|
||||
ReadLn(org);
|
||||
RSInit := Length(org) * 11;
|
||||
WriteLn('RandSeed: ',RSInit);
|
||||
WriteLn;
|
||||
|
||||
x := org;
|
||||
WriteLn('OrdCode (co=true)');
|
||||
OrdCode(x,code);
|
||||
WriteLn(x);
|
||||
OrdCode(x,decode);
|
||||
WriteLn(x);
|
||||
WriteLn;
|
||||
|
||||
x := org;
|
||||
WriteLn('OrdCode (co=false)');
|
||||
OrdCode(x,decode);
|
||||
WriteLn(x);
|
||||
OrdCode(x,code);
|
||||
WriteLn(x);
|
||||
WriteLn;
|
||||
|
||||
x := org;
|
||||
WriteLn('SortCode (co=true)');
|
||||
SortCode(x,code);
|
||||
WriteLn(x);
|
||||
SortCode(x,decode);
|
||||
WriteLn(x);
|
||||
WriteLn;
|
||||
|
||||
x := org;
|
||||
WriteLn('SortCode (co=false)');
|
||||
SortCode(x,decode);
|
||||
WriteLn(x);
|
||||
SortCode(x,code);
|
||||
WriteLn(x);
|
||||
WriteLn;
|
||||
|
||||
x := org;
|
||||
WriteLn('Hebrew');
|
||||
Hebrew(x);
|
||||
WriteLn(x);
|
||||
Hebrew(x);
|
||||
WriteLn(x);
|
||||
WriteLn;
|
||||
end.
|
||||
40
COMPTON.PAS
Normal file
40
COMPTON.PAS
Normal file
@ -0,0 +1,40 @@
|
||||
program Physik;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const W:real=3.204E-14; { Wkin = 200 keV }
|
||||
C:real=2.99792458E8; { c }
|
||||
M:real=9.1093897E-31; { Elektronenmasse }
|
||||
comp=13;
|
||||
|
||||
var mx, vx: real;
|
||||
omx,ovx: real;
|
||||
mc, omc, vc, ovc: string;
|
||||
ct: longint;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
mx := M;
|
||||
vx := 0;
|
||||
ct := 0;
|
||||
WriteLn('Gew<65>nschte Genauigkeit: ',comp-2,' Stellen nach dem Kommata.');
|
||||
repeat
|
||||
omx := mx;
|
||||
ovx := vx;
|
||||
vx := Sqrt((2*W)/(mx));
|
||||
mx := M/Sqrt(1-Sqr(vx/C));
|
||||
Inc(ct);
|
||||
Str(mx,mc);
|
||||
Str(omx,omc);
|
||||
Str(vx,vc);
|
||||
Str(ovx,ovc);
|
||||
mc := Copy(mc,1,comp);
|
||||
omc := Copy(omc,1,comp);
|
||||
vc := Copy(vc,1,comp);
|
||||
ovc := Copy(ovc,1,comp);
|
||||
GotoXY(1,3);
|
||||
WriteLn('[',ct:5,'] Elektronenmasse m: ',mx,' ');
|
||||
WriteLn('[',ct:5,'] Geschwindigkeit v: ',vx,' ');
|
||||
Delay(200);
|
||||
until (mc=omc) AND (vc=ovc);
|
||||
end.
|
||||
218
CONTEST/AUFG1.PAS
Normal file
218
CONTEST/AUFG1.PAS
Normal file
@ -0,0 +1,218 @@
|
||||
{ Aufgabe f<>r den Bundeswettbewerb in Informatik
|
||||
|
||||
Aufgabe 1
|
||||
|
||||
Belagerung um Farnsworth Castle
|
||||
|
||||
AD 1314. Nicht mehr lange k”nnen die Ritter K”nigin Eleonores auf Farns-
|
||||
worth Castle die Angreifer des Blythletwick-Clans abhalten. Die einzige
|
||||
Hoffnung der K”nigin ist die Benachrichtigung ihres Sohnes John, der sich
|
||||
mit Julee, der Prinzessin des Clans, verlobt hat. W„re sie auf Farnsworth,
|
||||
m<>áten die Blythlethwicks verhandeln. Doch die K”nigin kann sich nicht
|
||||
sicher sein, daá ihr Bote nicht abgefangen wird. W<>rde ihr Plan bekannt,
|
||||
w„re Blutvergieáen unvermeidbar. Eleonore schickt darum zwei Boten: Einen
|
||||
mit einer verschl<68>sselten Botschaft, den anderen mit einem Schl<68>ssel. Bei
|
||||
der Verschl<68>sselung geht sie folgendermaáen vor: Sie schneidet eine qua-
|
||||
dratische Schablone aus Leder, die in quadratische Felder eingeteilt ist.
|
||||
Manche dieser Felder sind ausgeschnitten. Diese Schablone legt die K”nigin
|
||||
auf ein St<53>ck Papier und schreibt die ersten Buchstaben ihrer Botschaft
|
||||
von links nach rechts, oben nach unten, durch die ausgeschnittenen Felder.
|
||||
Dann dreht sie die Schablone um 90 Grad im Uhrzeigersinn, schreibt weiter
|
||||
und wiederholt diesen Vorgang noch zwei weitere Male.
|
||||
Die Nachricht ist:
|
||||
|
||||
KOMM UND BRING JULEE NACH FARNSWORTH
|
||||
|
||||
Schablone und verschl<68>sselte Nachricht sehen so aus:
|
||||
|
||||
ÛÛ ÛÛ BRKOAE
|
||||
ÛÛÛÛ Û ER IMN
|
||||
Û Û ÛÛ NMS WN
|
||||
ÛÛÛÛÛÛ OGA CJ
|
||||
ÛÛ Û UHRNUD
|
||||
ÛÛÛÛÛ L FTH
|
||||
|
||||
1. Welchen Anforderungen m<>ssen Anzahl und Anordnung der L”cher gen<65>gen,
|
||||
damit die Schablone zur Verschl<68>sselung geeignet ist?
|
||||
2. Gib ein einfaches Verfahren f<>r den Entwurf von geeigneten Schablonen
|
||||
an.
|
||||
3. Schreibe ein Programm, das anhand einer gegebenen Schablone eine Nach-
|
||||
richt ver- und entschl<68>sseln kann. Wie sieht die mit der obigen Scha-
|
||||
blone verschl<68>sselte Fassung folgender R<>ckantwort aus?
|
||||
|
||||
JULEE MIT STALLKNECHT DURCHGEBRANNT
|
||||
}
|
||||
|
||||
program Belagerung_um_Farnsworth_Castle;
|
||||
{ L”sung ausgearbeitet von Markus Birth }
|
||||
|
||||
uses Crt;
|
||||
|
||||
var Template: array[1..6] of string[6];
|
||||
chosen: char;
|
||||
i, j: integer;
|
||||
MaxC: integer;
|
||||
|
||||
procedure InitTemplate;
|
||||
begin
|
||||
Template[1] := '001100';
|
||||
Template[2] := '000010';
|
||||
Template[3] := '010100';
|
||||
Template[4] := '000000';
|
||||
Template[5] := '100101';
|
||||
Template[6] := '100000';
|
||||
end;
|
||||
|
||||
procedure WriteTemplate(y,x: integer);
|
||||
begin
|
||||
GotoXY(x,y);
|
||||
MaxC := 0;
|
||||
for i:=1 to 6 do begin
|
||||
for j:=1 to 6 do begin
|
||||
if Copy(Template[i],j,1)='0' then Write('Û') else begin
|
||||
Write('ú');
|
||||
Inc(MaxC);
|
||||
end;
|
||||
end;
|
||||
GotoXY(x,y+i);
|
||||
end;
|
||||
MaxC := MaxC * 4;
|
||||
end;
|
||||
|
||||
procedure TurnTemplate;
|
||||
var Temp: array[1..6] of string[6];
|
||||
begin
|
||||
for i := 1 to 6 do begin
|
||||
Temp[i] := Template[i];
|
||||
Template[i] := '';
|
||||
end;
|
||||
for i := 1 to 6 do begin
|
||||
for j := 1 to 6 do Template[i] := Template[i] + Copy(Temp[7-j],i,1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Coding;
|
||||
var Text2Code: string;
|
||||
take, curchar: integer;
|
||||
|
||||
const xco = 3;
|
||||
yco = 3;
|
||||
|
||||
begin
|
||||
curchar := 1;
|
||||
ClrScr;
|
||||
TextColor(White);
|
||||
Write('Text eingeben (max. ', MaxC, ' Zeichen): ');
|
||||
TextColor(LightGray);
|
||||
ReadLn(Text2Code);
|
||||
TextColor(White);
|
||||
Write('Anzahl Buchstaben: ');
|
||||
TextColor(LightGray);
|
||||
WriteLn(Length(Text2Code));
|
||||
TextColor(White);
|
||||
for take := 1 to 4 do begin
|
||||
WriteTemplate(yco+1, xco+10);
|
||||
for i := 1 to 6 do begin
|
||||
for j := 1 to 6 do begin
|
||||
if Copy(Template[i],j,1)='1' then begin
|
||||
GotoXY(xco+j,yco+i);
|
||||
Write(Copy(Text2Code,curchar,1));
|
||||
GotoXY(xco+17+curchar,yco+6);
|
||||
Write(Copy(Text2Code,curchar,1));
|
||||
Inc(curchar);
|
||||
end;
|
||||
Delay(50);
|
||||
end;
|
||||
end;
|
||||
TurnTemplate;
|
||||
end;
|
||||
GotoXY(3, yco+10);
|
||||
TextColor(Yellow);
|
||||
WriteLn('Taste dr<64>cken, wenn bereit...');
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
procedure DeCoding;
|
||||
var Coded: array[1..6] of string[6];
|
||||
take, curchar: integer;
|
||||
|
||||
const xco = 19;
|
||||
yco = 2;
|
||||
|
||||
begin
|
||||
curchar := 1;
|
||||
ClrScr;
|
||||
WriteLn('Pro Zeile nur 6 Buchstaben!');
|
||||
for i := 1 to 6 do begin
|
||||
Write('Zeile ', i, ': ');
|
||||
ReadLn(Coded[i]);
|
||||
GotoXY(1,i+1);
|
||||
WriteLn(' ');
|
||||
end;
|
||||
for take := 1 to 4 do begin
|
||||
WriteTemplate(yco, xco);
|
||||
for i := 1 to 6 do begin
|
||||
for j := 1 to 6 do begin
|
||||
if Copy(Template[i],j,1)='1' then begin
|
||||
GotoXY(xco+curchar+8,yco+5);
|
||||
Write(Copy(Coded[i],j,1));
|
||||
Inc(curchar);
|
||||
GotoXY(j+9, i+1);
|
||||
Write(' ');
|
||||
end;
|
||||
Delay(50);
|
||||
end;
|
||||
end;
|
||||
TurnTemplate;
|
||||
end;
|
||||
GotoXY(3, yco+10);
|
||||
TextColor(Yellow);
|
||||
WriteLn('Taste dr<64>cken, wenn bereit...');
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
TextColor(White);
|
||||
WriteLn('-=ðþ Belagerung um Farnsworth Castle þð=-');
|
||||
TextColor(Cyan);
|
||||
WriteLn('Aufgabe 1 vom Bundeswettbewerb f<>r Informatik 97');
|
||||
TextColor(LightGray);
|
||||
WriteLn;
|
||||
WriteLn('Umgesetzt von Markus Birth');
|
||||
InitTemplate;
|
||||
TextColor(Yellow);
|
||||
WriteLn('Verwendete Schablone mit Drehergebnissen:');
|
||||
TextColor(LightGray);
|
||||
Delay(500);
|
||||
WriteTemplate(6,1);
|
||||
TextColor(DarkGray);
|
||||
TurnTemplate;
|
||||
Delay(500);
|
||||
WriteTemplate(6,11);
|
||||
TurnTemplate;
|
||||
Delay(500);
|
||||
WriteTemplate(6,21);
|
||||
TurnTemplate;
|
||||
Delay(500);
|
||||
WriteTemplate(6,31);
|
||||
TurnTemplate;
|
||||
TextColor(Yellow);
|
||||
WriteLn;
|
||||
Write('Maximale Zeichenanzahl: ');
|
||||
TextColor(LightGray);
|
||||
WriteLn(MaxC);
|
||||
WriteLn;
|
||||
Write('Wollen Sie ');
|
||||
TextColor(Yellow);
|
||||
Write('v');
|
||||
TextColor(LightGray);
|
||||
Write('erschl<68>sseln oder ');
|
||||
TextColor(Yellow);
|
||||
Write('e');
|
||||
TextColor(LightGray);
|
||||
Write('ntschl<68>sseln (andere Taste - quit)? ');
|
||||
chosen := UpCase(ReadKey);
|
||||
if chosen='V' then Coding;
|
||||
if chosen='E' then DeCoding;
|
||||
end.
|
||||
205
CONTEST/AUFG4.PAS
Normal file
205
CONTEST/AUFG4.PAS
Normal file
@ -0,0 +1,205 @@
|
||||
{ Aufgabe f<>r den Bundeswettbewerb in Informatik
|
||||
|
||||
Aufgabe 4
|
||||
|
||||
Wetter in Quadratien
|
||||
|
||||
Quadratien ist ein quadratisches Gebiet aus quadratischen Feldern. Das Feld
|
||||
in der Nordwest-Ecke hat die Zeilennummer 0 und die Spaltennummer 0.
|
||||
|
||||
Das Wetter in Quadratien wird durch quadratische Wolken bestimmt, die genau
|
||||
ein Feld groá sind. Solche Wolken r<>cken getaktet <20>ber Quadratien vor, und
|
||||
zwar von Norden nach S<>den 2 Felder pro Takt und, in einer anderen H”he,
|
||||
von Westen nach Osten 3 Felder pro Takt. Es regnet <20>berall dort, wo sich
|
||||
nach einem Vorr<72>cken sowohl eine Nord-S<>d- als auch eine West-Ost-Wolke
|
||||
befindet. Wolken, aus denen regnet, l”sen sich auf.
|
||||
|
||||
Die Wolkenvorhersage gibt an, an welchen Stellen (in der Form: Zeilennum-
|
||||
mer, Spaltennummer) sich zum aktuellen Zeitpunkt Wolken befinden. Daraus
|
||||
l„át sich dann ermitteln, wo es in Quadratien regnen wird, denn es werden
|
||||
nur solche Wolken angegeben, die <20>ber Quadratien hinwegziehen werden.
|
||||
|
||||
Beispiel:
|
||||
Wolkenvorhersage:
|
||||
-5/ 6 -4/ 6 -2/ 7 7/-6 -2/ 9 -5/ 7
|
||||
1/-2 8/-6 6/-6 7/-7 6/-7 1/-3 -2/ 8.
|
||||
|
||||
Es wird jeweils einmal regnen an den Stellen 1,6, 1,7 und 8,9.
|
||||
|
||||
Aufgabe:
|
||||
Schreibe ein Programm, welches folgendes leistet:
|
||||
1. Einlesen der GrӇe von Quadratien (Anzahl Zeilen bzw. Spalten)
|
||||
2. Einlesen einer Wolkenvorhersage
|
||||
3. Ausgabe, wo in Quadratien wie oft Regen f„llt
|
||||
|
||||
Sende uns 3 Beispiele, darunter eines f<>r ein Quadratien der GrӇe 10x10
|
||||
und folgender Wolkenvorhersage:
|
||||
2/-3 -5/ 5 -3/ 4 1/-4 6/-12 -3/ 5
|
||||
-7/ 5 3/-10 -6/ 6 6/-11 -7/ 4 3/-4
|
||||
-4/ 5 -3/ 3 -6/ 9 2/-4
|
||||
}
|
||||
|
||||
program Wetter_in_Quadratien;
|
||||
{ L”sung ausgearbeitet von Markus Birth }
|
||||
|
||||
uses Crt;
|
||||
|
||||
type W=record
|
||||
x,y: integer;
|
||||
dir: integer;
|
||||
end;
|
||||
R=record
|
||||
x,y: integer;
|
||||
w1,w2: integer;
|
||||
end;
|
||||
|
||||
const simdel=500;
|
||||
|
||||
var Wolke: array[1..50] of W;
|
||||
Rain: array[1..50] of R;
|
||||
QX, QY: integer;
|
||||
count, rct: integer;
|
||||
MatrixX, MatrixY: integer;
|
||||
i, j, k, l: integer;
|
||||
maxtakes: integer;
|
||||
|
||||
procedure InitClouds;
|
||||
{ Wolke.Dir: 1= li=>re
|
||||
2= ob=>un }
|
||||
begin
|
||||
for i:=1 to count do begin
|
||||
if Wolke[i].x<0 then Wolke[i].dir := 1;
|
||||
if Wolke[i].x<MatrixX then MatrixX := Wolke[i].x;
|
||||
if Wolke[i].y<0 then Wolke[i].dir := 2;
|
||||
if Wolke[i].y<MatrixY then MatrixY := Wolke[i].y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteMatrix(x,y: integer);
|
||||
begin
|
||||
for i := MatrixX to QX do begin
|
||||
for j := MatrixY to QY do begin
|
||||
GotoXY(x+(i-MatrixX),y+(j-MatrixY));
|
||||
TextColor(LightBlue);
|
||||
Write('ú');
|
||||
end;
|
||||
end;
|
||||
for i := MatrixX to QX do begin
|
||||
for j := MatrixY to QY do begin
|
||||
for k := 1 to count do begin
|
||||
GotoXY(x+(i-MatrixX),y+(j-MatrixY));
|
||||
if (Wolke[k].x=i) AND (Wolke[k].y=j) AND (Wolke[k].dir<>0) then begin
|
||||
TextColor(LightCyan);
|
||||
Write('þ');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SimClouds;
|
||||
begin
|
||||
for i:=1 to count do begin
|
||||
if Wolke[i].dir=1 then Wolke[i].x:=Wolke[i].x+3;
|
||||
if Wolke[i].dir=2 then Wolke[i].y:=Wolke[i].y+2;
|
||||
if (Wolke[i].dir<0) OR (Wolke[i].dir>2) then WriteLn('ERRRORRR!!!');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckForRain;
|
||||
begin
|
||||
for j:=1 to count do begin
|
||||
for k:=j to count do begin
|
||||
if (Wolke[j].x=Wolke[k].x) AND (Wolke[j].y=Wolke[k].y) AND (j<>k)
|
||||
AND (Wolke[j].dir<>0) AND (Wolke[k].dir<>0) then begin
|
||||
Rain[rct].x := Wolke[j].x; Rain[rct].y := Wolke[j].y;
|
||||
Rain[rct].w1 := j; Rain[rct].w2 := k;
|
||||
Inc(rct);
|
||||
Wolke[k].x := 0; Wolke[k].y := 0; Wolke[k].dir := 0;
|
||||
Wolke[j].x := 0; Wolke[j].y := 0; Wolke[j].dir := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ProgHeader;
|
||||
begin
|
||||
TextColor(White);
|
||||
WriteLn('-=ðþ Wetter in Quadratien þð=-');
|
||||
TextColor(Cyan);
|
||||
WriteLn('Aufgabe 4 vom Bundeswettbewerb f<>r Informatik');
|
||||
TextColor(LightGray);
|
||||
WriteLn;
|
||||
WriteLn('Umgesetzt von Markus Birth');
|
||||
WriteLn;
|
||||
end;
|
||||
|
||||
procedure InputData;
|
||||
begin
|
||||
TextColor(Yellow);
|
||||
Write('Geben Sie die Breite Quadratiens ein: ');
|
||||
TextColor(LightGray);
|
||||
ReadLn(QX);
|
||||
TextColor(Yellow);
|
||||
Write('Geben Sie nun die H”he Quadratiens ein: ');
|
||||
TextColor(LightGray);
|
||||
ReadLn(QY);
|
||||
WriteLn;
|
||||
TextColor(White);
|
||||
WriteLn('Jetzt kommen die Wolken... (Beenden durch Eingabe von 0 und 0! 5|-10;-5|5)');
|
||||
for i:=1 to 50 do begin
|
||||
if k=0 then j := 0;
|
||||
if k=1 then j := 27;
|
||||
if k=2 then j := 54;
|
||||
Inc(k);
|
||||
if k>2 then k := 0;
|
||||
GotoXY(j, WhereY-1);
|
||||
TextColor(Yellow);
|
||||
Write('Wolke ', i, ' Y: ');
|
||||
TextColor(LightGray);
|
||||
ReadLn(Wolke[i].y);
|
||||
GotoXY(16+j, WhereY-1);
|
||||
TextColor(Yellow);
|
||||
Write('X: ');
|
||||
TextColor(LightGray);
|
||||
ReadLn(Wolke[i].x);
|
||||
if (Wolke[i].y = 0) AND (Wolke[i].x = 0) then break;
|
||||
Inc(count);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
Inc(rct);
|
||||
ProgHeader;
|
||||
InputData;
|
||||
TextColor(Yellow);
|
||||
Write('Anzahl Wolken: ');
|
||||
TextColor(LightGray);
|
||||
WriteLn(count);
|
||||
InitClouds;
|
||||
ClrScr;
|
||||
TextColor(Yellow);
|
||||
WriteLn('-=ðþ Simulation þð=-');
|
||||
WriteMatrix(1,3);
|
||||
maxtakes := Trunc((QX-MatrixX)/3);
|
||||
if Trunc((QY-MatrixY)/2)>maxtakes then maxtakes := Trunc((QY-MatrixY)/2);
|
||||
maxtakes := maxtakes+1;
|
||||
for l:=1 to maxtakes do begin
|
||||
SimClouds;
|
||||
Delay(simdel);
|
||||
WriteMatrix(1,3);
|
||||
CheckForRain;
|
||||
end;
|
||||
|
||||
for i:=1 to rct-1 do begin
|
||||
GotoXY(1,i);
|
||||
TextColor(White);
|
||||
GotoXY(QX-MatrixX+5,2+i);
|
||||
WriteLn(i,'. Regen bei ',Rain[i].y,'|',Rain[i].x,' - Wolken: ',Rain[i].w1,' + ',Rain[i].w2);
|
||||
end;
|
||||
GotoXY(5,24);
|
||||
TextColor(Yellow);
|
||||
WriteLn('Bitte eine Taste dr<64>cken...');
|
||||
ReadKey;
|
||||
end.
|
||||
8
DATABANK/DATABANK.DAT
Normal file
8
DATABANK/DATABANK.DAT
Normal file
@ -0,0 +1,8 @@
|
||||
Birth
|
||||
Markus
|
||||
Musterstrasse
|
||||
1
|
||||
Musterstadt
|
||||
12345
|
||||
+49 123 4567
|
||||
+49 123 5678
|
||||
367
DATABANK/DATABANK.PAS
Normal file
367
DATABANK/DATABANK.PAS
Normal file
@ -0,0 +1,367 @@
|
||||
program Datenbank;
|
||||
uses Crt,Dos;
|
||||
|
||||
const Defaultfile:string ='DataBank.DAT';
|
||||
Cfgfile='DataBank.INI';
|
||||
CName=0;
|
||||
CVorname=1;
|
||||
CStrasse=2;
|
||||
CNummer=3;
|
||||
COrt=4;
|
||||
CPLZ=5;
|
||||
CTel=6;
|
||||
CFax=7;
|
||||
|
||||
type Daten=record
|
||||
Namen: string[30];
|
||||
Vorname: string[15];
|
||||
Strasse: string[30];
|
||||
Nummer: string[6];
|
||||
Ort: string[20];
|
||||
PLZ: string[10];
|
||||
Tel: string[30];
|
||||
Fax: string[30];
|
||||
end;
|
||||
|
||||
type ActiveCheck=record
|
||||
Add: boolean;
|
||||
Edit: boolean;
|
||||
Del: boolean;
|
||||
View: boolean;
|
||||
Load: boolean;
|
||||
Save: boolean;
|
||||
Change: boolean;
|
||||
Init: boolean;
|
||||
end;
|
||||
|
||||
var Adresse: array[0..99] of Daten;
|
||||
Act: ActiveCheck;
|
||||
CenterPos, RetValue: integer;
|
||||
|
||||
procedure StartInit;
|
||||
begin
|
||||
Act.Load:=true;
|
||||
Act.Change:=true;
|
||||
Act.Init:=true;
|
||||
end;
|
||||
|
||||
procedure ReadyBeep;
|
||||
begin
|
||||
Sound(800);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
Delay(50);
|
||||
Sound(1000);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
Delay(50);
|
||||
Sound(1200);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
end;
|
||||
|
||||
procedure ErrorBeep;
|
||||
begin
|
||||
Sound(100);
|
||||
Delay(200);
|
||||
NoSound;
|
||||
end;
|
||||
|
||||
procedure AckBeep;
|
||||
begin
|
||||
Sound(1200);
|
||||
Delay(25);
|
||||
NoSound;
|
||||
end;
|
||||
|
||||
procedure DrawBorder(MaxX,MaxY: integer; TCol, BCol: integer; BType: integer);
|
||||
var i,j: integer;
|
||||
lx,rx,oy,uy,mx,my: integer;
|
||||
DrwDelay, FilDelay: integer;
|
||||
Border: string[8];
|
||||
begin
|
||||
window(1,1,80,25);
|
||||
if (MaxX=0) AND (MaxY=0) AND (TCol=0) AND (BCol=0) then Exit;
|
||||
if BType=1 then Border := 'Ú¿ÀÙ³³ÄÄ';
|
||||
if BType=2 then Border := 'ɻȼººÍÍ';
|
||||
if BType=3 then Border := 'Õ¸Ô¾³³ÍÍ';
|
||||
if BType=4 then Border := 'Ö·Ó½ººÄÄ';
|
||||
if BType=5 then Border := 'ÛÛÛÛÛÛßÜ';
|
||||
if BType=6 then Border := 'Ú·Ô¼³ºÄÍ';
|
||||
lx := 41-MaxX; oy := 13-MaxY; rx := 40+MaxX; uy := 12+MaxY;
|
||||
mx := 40; my := 12; DrwDelay := 1000 div (2*MaxX); FilDelay := 1;
|
||||
TextColor(TCol); TextBackground(BCol);
|
||||
for i:=mx downto lx+1 do begin
|
||||
GotoXY(i,oy); Write(Border[7]);
|
||||
GotoXY((rx+1)-i+lx-1,oy); Write(Border[7]);
|
||||
Delay(DrwDelay);
|
||||
end;
|
||||
GotoXY(lx,oy); Write(Border[1]);
|
||||
GotoXY(rx,oy); Write(Border[2]);
|
||||
Delay(DrwDelay);
|
||||
for i:=oy+1 to uy-1 do begin
|
||||
GotoXY(lx,i); Write(Border[5]);
|
||||
GotoXY(rx,i); Write(Border[6]);
|
||||
Delay(DrwDelay);
|
||||
end;
|
||||
GotoXY(lx,uy); Write(Border[3]);
|
||||
GotoXY(rx,uy); Write(Border[4]);
|
||||
Delay(DrwDelay);
|
||||
for i:=lx+1 to mx do begin
|
||||
GotoXY(i,uy); Write(Border[8]);
|
||||
GotoXY((rx+1)-i+lx-1,uy); Write(Border[8]);
|
||||
Delay(DrwDelay);
|
||||
end;
|
||||
for i:=lx+1 to rx-1 do begin
|
||||
for j:=oy+1 to uy-1 do begin
|
||||
GotoXY(i,j); Write(' ');
|
||||
Delay(FilDelay);
|
||||
end;
|
||||
end;
|
||||
CenterPos := (rx-lx) div 2; window(lx+2,oy+1,rx-2,uy-1);
|
||||
end;
|
||||
|
||||
procedure WriteC(text: string);
|
||||
var x,y: integer;
|
||||
begin
|
||||
x := CenterPos-(Length(text) div 2);
|
||||
y := WhereY;
|
||||
GotoXY(x,y);
|
||||
Write(text);
|
||||
end;
|
||||
|
||||
procedure WriteCLn(text: string);
|
||||
var x,y: integer;
|
||||
begin
|
||||
x := CenterPos-(Length(text) div 2);
|
||||
y := WhereY;
|
||||
GotoXY(x,y);
|
||||
WriteLn(text);
|
||||
end;
|
||||
|
||||
procedure MainWindow;
|
||||
begin
|
||||
DrawBorder(40,12,15,0,4);
|
||||
GotoXY(1,1);
|
||||
TextColor(9); WriteC('- -'); Delay(100);
|
||||
TextColor(3); WriteC('= ='); Delay(100);
|
||||
TextColor(11); WriteC('ð ð'); Delay(100);
|
||||
TextColor(15); WriteC('þ þ'); Delay(100);
|
||||
TextColor(15); WriteC('D K'); Delay(150);
|
||||
TextColor(7); WriteC('D K');
|
||||
TextColor(15); WriteC('A N'); Delay(150);
|
||||
TextColor(8); WriteC('D K');
|
||||
TextColor(7); WriteC('A N');
|
||||
TextColor(15); WriteC('T A'); Delay(150);
|
||||
TextColor(0); WriteC('D K');
|
||||
TextColor(8); WriteC('A N');
|
||||
TextColor(7); WriteC('T A');
|
||||
TextColor(15); WriteC('E B'); Delay(150);
|
||||
TextColor(0); WriteC('A N');
|
||||
TextColor(8); WriteC('T A');
|
||||
TextColor(7); WriteC('E B');
|
||||
TextColor(15); WriteC('N-'); Delay(150);
|
||||
TextColor(0); WriteC('T A');
|
||||
TextColor(8); WriteC('E B');
|
||||
TextColor(7); WriteC('N-'); Delay(150);
|
||||
TextColor(0); WriteC('E B');
|
||||
TextColor(8); WriteC('N-'); Delay(150);
|
||||
TextColor(0); WriteC('N-'); Delay(150);
|
||||
TextColor(8); WriteC('DATEN-BANK'); Delay(200);
|
||||
TextColor(6); WriteC('DATEN-BANK'); Delay(200);
|
||||
TextColor(14); WriteC('DATEN-BANK');
|
||||
end;
|
||||
|
||||
procedure FXWrite(text: string; finc: integer);
|
||||
var x,y,i: integer;
|
||||
finc2: integer;
|
||||
Del1: integer;
|
||||
begin
|
||||
x := WhereX;
|
||||
y := WhereY;
|
||||
Del1 := 750 div Length(text);
|
||||
if Del1>75 then Del1 := 75;
|
||||
for i:=1 to Length(text) do begin
|
||||
GotoXY(x+i-1,y); TextColor(15); Write(text[i]);
|
||||
if i>1 then begin
|
||||
GotoXY(x+i-2,y);
|
||||
TextColor(7);
|
||||
Write(text[i-1]);
|
||||
end;
|
||||
if i>2 then begin
|
||||
GotoXY(x+i-3,y);
|
||||
TextColor(8);
|
||||
Write(text[i-2]);
|
||||
end;
|
||||
Delay(Del1);
|
||||
end;
|
||||
GotoXY(x+Length(text)-1,y); TextColor(7); Write(text[Length(text)]);
|
||||
if Length(text)>1 then begin
|
||||
GotoXY(x+Length(text)-2,y);
|
||||
TextColor(8);
|
||||
Write(text[Length(text)-1]);
|
||||
end;
|
||||
Delay(Del1);
|
||||
GotoXY(x+Length(text)-1,y); TextColor(8); Write(text[Length(text)]);
|
||||
Delay(Del1*3);
|
||||
if finc<=blink then begin
|
||||
if finc<8 then finc2 := finc+8 else finc2 := finc-8;
|
||||
end else begin
|
||||
if finc<8+blink then finc2 := finc+8 else finc2 := finc-8;
|
||||
end;
|
||||
if finc=8 then finc2 := 15;
|
||||
if finc=15 then begin
|
||||
GotoXY(x,y); TextColor(8); Write(text); Delay(100);
|
||||
end;
|
||||
GotoXY(x,y); TextColor(finc2); Write(text);
|
||||
Delay(100);
|
||||
if finc=8 then begin
|
||||
GotoXY(x,y); TextColor(7); Write(text); Delay(100);
|
||||
end;
|
||||
GotoXY(x,y); TextColor(finc); Write(text);
|
||||
end;
|
||||
|
||||
procedure Copyright;
|
||||
begin
|
||||
DrawBorder(20,4,14,2,6); TextColor(DarkGray);
|
||||
WriteCLn('Copyright (C)1997 by Markus Birth');
|
||||
GotoXY(13,1); FXWrite('(C)1997',8);
|
||||
GotoXY(1,3); TextColor(White);
|
||||
WriteCLn('Jeglicher Verstoá gegen dieses');
|
||||
WriteCLn('Copyright wird strafrechtlich');
|
||||
WriteCLn('verfolgt.');
|
||||
TextColor(LightRed); WriteC('Danke f<>r die Beachtung!');
|
||||
end;
|
||||
|
||||
procedure ProgDesc;
|
||||
begin
|
||||
DrawBorder(15,2,11,1,5);
|
||||
TextColor(DarkGray);
|
||||
GotoXY(4,1); Write('-=ðþ DATEN-BANK þð=-');
|
||||
GotoXY(4,1); FXWrite('-=ðþ DATEN-BANK þð=-',15); WriteLn;
|
||||
TextColor(DarkGray); WriteC('by RoboCop');
|
||||
ReadyBeep;
|
||||
end;
|
||||
|
||||
procedure MainMenu;
|
||||
var ActCol: integer;
|
||||
ColAct, ColInA: integer;
|
||||
begin
|
||||
ColAct:=1514; { Nur zur einfacheren Weiterverarbeitung: xxyy }
|
||||
ColInA:=0808; { xx-Textfarbe --- yy-Buchstabe }
|
||||
GotoXY(1,3);
|
||||
TextColor(8);
|
||||
WriteC(' Datendatei: '+Defaultfile+' ');
|
||||
GotoXY(10,5);
|
||||
FXWrite('W„hlen Sie eine Aktion durch dr<64>cken der jeweiligen Taste',10);
|
||||
if Act.Add then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(11,7); FXWrite(' - Adresse hinzuf<75>gen',Trunc(ActCol/100));
|
||||
GotoXY(11,7); FXWrite('A',ActCol-Trunc(ActCol/100)*100);
|
||||
if Act.Edit then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(41,7); FXWrite(' - Adresse bearbeiten',Trunc(ActCol/100));
|
||||
GotoXY(41,7); FXWrite('E',ActCol-Trunc(ActCol/100)*100);
|
||||
if Act.Del then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(11,9); FXWrite(' - Adresse l”schen',Trunc(ActCol/100));
|
||||
GotoXY(11,9); FXWrite('D',ActCol-Trunc(ActCol/100)*100);
|
||||
if Act.View then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(41,9); FXWrite(' - Adressen durchsehen',Trunc(ActCol/100));
|
||||
GotoXY(41,9); FXWrite('V',ActCol-Trunc(ActCol/100)*100);
|
||||
GotoXY(9,11); FXWrite('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ',8);
|
||||
if Act.Load then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(11,13); FXWrite(' - Datendatei laden',Trunc(ActCol/100));
|
||||
GotoXY(11,13); FXWrite('L',ActCol-Trunc(ActCol/100)*100);
|
||||
if Act.Save then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(41,13); FXWrite(' - Datendatei schreiben',Trunc(ActCol/100));
|
||||
GotoXY(41,13); FXWrite('S',ActCol-Trunc(ActCol/100)*100);
|
||||
if Act.Change then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(11,15); FXWrite(' - andere Datendatei',Trunc(ActCol/100));
|
||||
GotoXY(11,15); FXWrite('C',ActCol-Trunc(ActCol/100)*100);
|
||||
if Act.Init then ActCol:=ColAct else ActCol:=ColInA;
|
||||
GotoXY(41,15); FXWrite(' - Datendatei initiieren',Trunc(ActCol/100));
|
||||
GotoXY(41,15); FXWrite('I',ActCol-Trunc(ActCol/100)*100);
|
||||
GotoXY(5,22); FXWrite('Dieses Programm wurde entwickelt von RoboCop IND. a.k.a. Markus Birth',8);
|
||||
end;
|
||||
|
||||
procedure InitNewDatabase;
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure ChangeDatafile;
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure ReadData(Datei: string);
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure WriteData(Datei: string);
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure AddressNew;
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure AddressDelete;
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure AddressEdit;
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure AddressBrowse;
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure AddressSearch;
|
||||
begin
|
||||
RetValue := 1;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure MainSelect;
|
||||
var KeyIn: char;
|
||||
begin
|
||||
KeyIn := ReadKey;
|
||||
if (UpCase(KeyIn)='A') AND (Act.Add) then AddressNew;
|
||||
if (UpCase(KeyIn)='E') AND (Act.Edit) then AddressEdit;
|
||||
if (UpCase(KeyIn)='D') AND (Act.Del) then AddressDelete;
|
||||
if (UpCase(KeyIn)='V') AND (Act.View) then AddressBrowse;
|
||||
if (UpCase(KeyIn)='L') AND (Act.Load) then ReadData(Defaultfile);
|
||||
if (UpCase(KeyIn)='W') AND (Act.Save) then WriteData(Defaultfile);
|
||||
if (UpCase(KeyIn)='C') AND (Act.Change) then ChangeDatafile;
|
||||
if (UpCase(KeyIn)='I') AND (Act.Init) then InitNewDatabase;
|
||||
if RetValue=0 then begin
|
||||
ErrorBeep;
|
||||
MainSelect;
|
||||
end;
|
||||
RetValue := 0;
|
||||
end;
|
||||
|
||||
begin
|
||||
Copyright;
|
||||
Delay(2000);
|
||||
ProgDesc;
|
||||
Delay(1000);
|
||||
MainWindow;
|
||||
StartInit;
|
||||
MainMenu;
|
||||
MainSelect;
|
||||
end.
|
||||
75
DATECALC.PAS
Normal file
75
DATECALC.PAS
Normal file
@ -0,0 +1,75 @@
|
||||
program DateCalc;
|
||||
|
||||
{ Tage zw. 2 Daten ausrechnen }
|
||||
|
||||
const Tage:array[1..12] of byte=(31,0,31,30,31,30,31,31,30,31,30,31);
|
||||
|
||||
var d1,m1,y1,d2,m2,y2: word;
|
||||
dbw: integer;
|
||||
|
||||
procedure GetDate(op: string;var d,m,y: word);
|
||||
var dat: string[10];
|
||||
i,oldp: integer;
|
||||
co: integer;
|
||||
begin
|
||||
Write(op,'. Datum eingeben [tt.mm.yyyy]: ');
|
||||
ReadLn(dat);
|
||||
oldp := 0;
|
||||
for i := 1 to Length(dat) do begin
|
||||
if dat[i]='.' then begin
|
||||
if oldp=0 then Val(Copy(dat,oldp+1,i-oldp-1),d,co);
|
||||
if oldp<>0 then Val(Copy(dat,oldp+1,i-oldp-1),m,co);
|
||||
oldp := i;
|
||||
end;
|
||||
end;
|
||||
Val(Copy(dat,oldp+1,Length(dat)-oldp),y,co);
|
||||
end;
|
||||
|
||||
procedure ValCheck(d1,m1,y1,d2,m2,y2: word);
|
||||
var err: boolean;
|
||||
begin
|
||||
err := false;
|
||||
if (m1=m2) AND (y1=y2) AND (d1>d2) then err := true;
|
||||
if (y1=y2) AND (m1>m2) then err := true;
|
||||
if (y1>y2) then err := true;
|
||||
if (m1>13) OR (m2>13) OR (m1<1) OR (m2<1) then err := true;
|
||||
if (d1>31) OR (d2>31) OR (d1<1) OR (d2<1) then err := true;
|
||||
if err=true then begin
|
||||
WriteLn;
|
||||
WriteLn('Fehler im Datum. Datum 1 ist „lter als Datum 2 oder falsche Zahlen!');
|
||||
Halt;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CalcDays(d1,m1,y1,d2,m2,y2: word; var days: integer);
|
||||
var i: integer;
|
||||
begin
|
||||
if (m1=m2) AND (y1=y2) then begin
|
||||
days := days + (d2-d1);
|
||||
Exit;
|
||||
end;
|
||||
days := 0;
|
||||
if m1<>2 then days := days + (Tage[m1]-d1) else begin
|
||||
if y1/4=y1 DIV 4 then days := days + (29-d1) else days := days + (28-d1);
|
||||
end;
|
||||
if (y1=y2) AND (m2-1>=m1+1) then begin
|
||||
for i:=m1+1 to m2-1 do begin
|
||||
if i<>2 then days := days + Tage[i] else begin
|
||||
if y1/4=y1 DIV 4 then days := days + 29 else days := days + 28;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
days := days + d2;
|
||||
end;
|
||||
|
||||
begin
|
||||
WriteLn('-=+ DateCalc +=- auf Wunsch von Anke');
|
||||
WriteLn;
|
||||
GetDate('1',d1,m1,y1);
|
||||
GetDate('2',d2,m2,y2);
|
||||
WriteLn('Datum 1: ',d1,'.',m1,'.',y1);
|
||||
WriteLn('Datum 2: ',d2,'.',m2,'.',y2);
|
||||
ValCheck(d1,m1,y1,d2,m2,y2);
|
||||
CalcDays(d1,m1,y1,d2,m2,y2,dbw);
|
||||
WriteLn('Tage: ',dbw);
|
||||
end.
|
||||
109
DIGICLK.PAS
Normal file
109
DIGICLK.PAS
Normal file
@ -0,0 +1,109 @@
|
||||
program DigiClock;
|
||||
|
||||
uses Crt, Dos, Graph, BGIP;
|
||||
|
||||
const DigiData: array[0..9] of string[7]=('1110111','0010010','1011101','1011011',
|
||||
'0111010','1101011','1101111','1010010',
|
||||
'1111111','1111011');
|
||||
digacol: byte =14;
|
||||
digdcol: byte =0;
|
||||
|
||||
var xmax,ymax: word;
|
||||
h,m,s,hh: word;
|
||||
olds: word;
|
||||
|
||||
|
||||
procedure InitVid;
|
||||
var grDriver, grMode : integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAhi;
|
||||
InitGraph(grDriver,grMode,BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
end;
|
||||
|
||||
procedure WriteDig(pos,which,col: byte);
|
||||
const sw=40;
|
||||
sh=40;
|
||||
sa=3;
|
||||
ya=20;
|
||||
xa=5;
|
||||
|
||||
var ab: word;
|
||||
|
||||
begin
|
||||
SetColor(col);
|
||||
ab := pos*Trunc(sw*1.9);
|
||||
SetLineStyle(UserBitLn,$AAAA,ThickWidth);
|
||||
case which of
|
||||
1: begin
|
||||
MoveTo(xa+ab+sa,ya);
|
||||
LineTo(xa+ab+sa+sw,ya);
|
||||
end;
|
||||
2: begin
|
||||
MoveTo(xa+ab,ya+sa);
|
||||
LineTo(xa+ab,ya+sa+sh);
|
||||
end;
|
||||
3: begin
|
||||
MoveTo(xa+ab+sa+sw+sa,ya+sa);
|
||||
LineTo(xa+ab+sa+sw+sa,ya+sa+sh);
|
||||
end;
|
||||
4: begin
|
||||
MoveTo(xa+ab+sa,ya+sa+sh+sa);
|
||||
LineTo(xa+ab+sa+sw,ya+sa+sh+sa);
|
||||
end;
|
||||
5: begin
|
||||
MoveTo(xa+ab,ya+sa+sh+sa+sa);
|
||||
LineTo(xa+ab,ya+sa+sh+sa+sa+sh);
|
||||
end;
|
||||
6: begin
|
||||
MoveTo(xa+ab+sa+sw+sa,ya+sa+sh+sa+sa);
|
||||
Lineto(xa+ab+sa+sw+sa,ya+sa+sh+sa+sa+sh);
|
||||
end;
|
||||
7: begin
|
||||
MoveTo(xa+ab+sa,ya+sa+sh+sa+sa+sh+sa);
|
||||
LineTo(xa+ab+sa+sw,ya+sa+sh+sa+sa+sh+sa);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure OutDig(pos,which: byte);
|
||||
var digcs: string[7];
|
||||
i: integer;
|
||||
begin
|
||||
digcs := DigiData[which];
|
||||
for i:=1 to 7 do begin
|
||||
if digcs[i]='0' then WriteDig(pos,i,digdcol) else WriteDig(pos,i,digacol);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure OutitVid;
|
||||
begin
|
||||
TextMode(CO80);
|
||||
WriteLn('Programm beendet.');
|
||||
end;
|
||||
|
||||
begin
|
||||
InitVid;
|
||||
Randomize;
|
||||
repeat
|
||||
while olds=s do begin
|
||||
GetTime(h,m,s,hh);
|
||||
if keypressed then begin
|
||||
ReadKey;
|
||||
Halt;
|
||||
end;
|
||||
end;
|
||||
{ digacol := Random(8)+8; }
|
||||
olds := s;
|
||||
OutDig(0,h DIV 10);
|
||||
OutDig(1,h MOD 10);
|
||||
OutDig(3,m DIV 10);
|
||||
OutDig(4,m MOD 10);
|
||||
OutDig(6,s DIV 10);
|
||||
OutDig(7,s MOD 10);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
OutitVid;
|
||||
end.
|
||||
39
DIGUHR.PAS
Normal file
39
DIGUHR.PAS
Normal file
@ -0,0 +1,39 @@
|
||||
program DIGUHR;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const sstd1=2; { Std1 }
|
||||
sstd2=1; { Std2 }
|
||||
smin1=4; { Min1 }
|
||||
smin2=5; { Min2 }
|
||||
ssek1=5; { Sek1 }
|
||||
ssek2=3; { Sek2 }
|
||||
sset: boolean=true;
|
||||
|
||||
var std1,std2,ende,min1,min2,sek1,sek2: byte;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
repeat
|
||||
for std1:=0 to 2 do begin
|
||||
if std1=2 then ende:=3 else ende:=9;
|
||||
for std2:=0 to ende do
|
||||
for min1:=0 to 5 do
|
||||
for min2:=0 to 9 do
|
||||
for sek1:=0 to 5 do
|
||||
for sek2:=0 to 9 do begin
|
||||
GotoXY(1,1);
|
||||
Write(std1,std2,':',min1,min2,'.',sek1,sek2);
|
||||
if sset then begin
|
||||
if (std1=sstd1) AND (std2=sstd2) AND
|
||||
(min1=smin1) AND (min2=smin2) AND
|
||||
(sek1=ssek1) AND (sek2=ssek2) then sset:=false;
|
||||
end else Delay(1000);
|
||||
if keypressed then begin
|
||||
ReadKey;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until 0=1;
|
||||
end.
|
||||
84
DREIE3D.PAS
Normal file
84
DREIE3D.PAS
Normal file
@ -0,0 +1,84 @@
|
||||
program Dreiecksberechnung_3D; {Autor: RoboCop of nOOb}
|
||||
|
||||
|
||||
|
||||
{ Die Volumenberechnung ist nicht komplett!!! }
|
||||
|
||||
|
||||
|
||||
uses Crt,Logo;
|
||||
var AX,AY,AZ,BX,BY,BZ,CX,CY,CZ,LAB,LBC,LCA,V,MABX,MABY,MABZ,MBCX,MBCY,MBCZ,MCAX,MCAY,MCAZ,SA,SB,SC: real;
|
||||
|
||||
function Mittelpunkt(P1,P2:real):real;
|
||||
begin
|
||||
Mittelpunkt := (P1+P2)/2;
|
||||
end;
|
||||
|
||||
function Laenge(P1X,P1Y,P1Z,P2X,P2Y,P2Z:real):real;
|
||||
begin
|
||||
Laenge := Sqrt(Sqr(P2X-P1X)+Sqr(P2Y-P1Y)+Sqr(P2Z-P1Z));
|
||||
end;
|
||||
|
||||
function Volumen(P1X,P1Y,P1Z,P2X,P2Y,P2Z,P3X,P3Y,P3Z:real):real;
|
||||
begin
|
||||
Volumen := 0.5*Abs(P1Y*(P3X-P2X)+P2Y*(P1X-P3X)+P3Y*(P2X-P1X));
|
||||
end;
|
||||
|
||||
begin;
|
||||
ClrScr;
|
||||
TextColor(15);
|
||||
WriteLn('-=ðþ 3D - DREIECKSBERECHNUNG þð=-');
|
||||
WriteLn;
|
||||
WriteLn('Another program by');
|
||||
WriteLogo;
|
||||
TextColor(7);
|
||||
Write('Punkt A - X:');
|
||||
ReadLn(AX);
|
||||
Write('Punkt A - Y:');
|
||||
ReadLn(AY);
|
||||
Write('Punkt A - Z:');
|
||||
ReadLn(AZ);
|
||||
Write('Punkt B - X:');
|
||||
ReadLn(BX);
|
||||
Write('Punkt B - Y:');
|
||||
ReadLn(BY);
|
||||
Write('Punkt B - Z:');
|
||||
ReadLn(BZ);
|
||||
Write('Punkt C - X:');
|
||||
ReadLn(CX);
|
||||
Write('Punkt C - Y:');
|
||||
ReadLn(CY);
|
||||
Write('Punkt C - Z:');
|
||||
ReadLn(CZ);
|
||||
MABX := Mittelpunkt(AX,BX);
|
||||
MABY := Mittelpunkt(AY,BY);
|
||||
MABZ := Mittelpunkt(AZ,BZ);
|
||||
MBCX := Mittelpunkt(BX,CX);
|
||||
MBCY := Mittelpunkt(BY,CY);
|
||||
MBCZ := Mittelpunkt(BZ,CZ);
|
||||
MCAX := Mittelpunkt(CX,AX);
|
||||
MCAY := Mittelpunkt(CY,AY);
|
||||
MCAZ := Mittelpunkt(CZ,AZ);
|
||||
WriteLn('M-AB: ',MABX:0:2,'|',MABY:0:2,'|',MABZ:0:2);
|
||||
WriteLn('M-BC: ',MBCX:0:2,'|',MBCY:0:2,'|',MBCZ:0:2);
|
||||
WriteLn('M-CA: ',MCAX:0:2,'|',MCAY:0:2,'|',MCAZ:0:2);
|
||||
LAB := Laenge(AX,AY,AZ,BX,BY,BZ);
|
||||
LBC := Laenge(BX,BY,BZ,CX,CY,CZ);
|
||||
LCA := Laenge(CX,CY,CZ,AX,AY,AZ);
|
||||
WriteLn('L„nge AB: ',LAB:5:2,' LE');
|
||||
WriteLn('L„nge BC: ',LBC:5:2,' LE');
|
||||
WriteLn('L„nge CA: ',LCA:5:2,' LE');
|
||||
V := Volumen(AX,AY,AZ,BX,BY,BZ,CX,CY,CZ);
|
||||
Write('Volumeninhalt: ',V:5:2,' VE');
|
||||
{ IF F=0 THEN WriteLn(' === Die Punkte sind kollinear. DAS IST KEIN 3ECK!!') ELSE WriteLn; }
|
||||
SA := Laenge(MBCX,MBCY,MBCZ,AX,AY,AZ);
|
||||
SB := Laenge(MCAX,MCAY,MCAZ,BX,BY,BZ);
|
||||
SC := Laenge(MABX,MABY,MABZ,CX,CY,CZ);
|
||||
WriteLn('Seitenhalbierende A-MBC: ',SA:5:2,' LE');
|
||||
WriteLn('Seitenhalbierende B-MCA: ',SB:5:2,' LE');
|
||||
WriteLn('Seitenhalbierende C-MAB: ',SC:5:2,' LE');
|
||||
WriteLn;
|
||||
WriteLn('Bitte Taste dr<64>cken...');
|
||||
ReadKey;
|
||||
WriteLn('=== FERTIG! ===');
|
||||
end.
|
||||
68
DREIECK.PAS
Normal file
68
DREIECK.PAS
Normal file
@ -0,0 +1,68 @@
|
||||
program Nennen_wir_es_Dreiecksberechnung; {Autor: RoboCop IND.}
|
||||
uses Crt,Logo;
|
||||
var AX,AY,BX,BY,CX,CY,LAB,LBC,LCA,F,MABX,MABY,MBCX,MBCY,MCAX,MCAY,SA,SB,SC: real;
|
||||
|
||||
function Mittelpunkt(P1,P2:real):real;
|
||||
begin
|
||||
Mittelpunkt := (P1+P2)/2;
|
||||
end;
|
||||
|
||||
function Laenge(P1X,P1Y,P2X,P2Y:real):real;
|
||||
begin
|
||||
Laenge := Sqrt(Sqr(P2X-P1X)+Sqr(P2Y-P1Y));
|
||||
end;
|
||||
|
||||
function Flaeche(P1X,P1Y,P2X,P2Y,P3X,P3Y:real):real;
|
||||
begin
|
||||
Flaeche := 0.5*Abs(P1Y*(P3X-P2X)+P2Y*(P1X-P3X)+P3Y*(P2X-P1X));
|
||||
end;
|
||||
|
||||
begin;
|
||||
ClrScr;
|
||||
TextColor(15);
|
||||
WriteLn('-=ðþ DREIECKSBERECHNUNG þð=-');
|
||||
WriteLn;
|
||||
WriteLn('2nd program by');
|
||||
WriteLogo;
|
||||
TextColor(7);
|
||||
Write('Punkt A - X:');
|
||||
ReadLn(AX);
|
||||
Write('Punkt A - Y:');
|
||||
ReadLn(AY);
|
||||
Write('Punkt B - X:');
|
||||
ReadLn(BX);
|
||||
Write('Punkt B - Y:');
|
||||
ReadLn(BY);
|
||||
Write('Punkt C - X:');
|
||||
ReadLn(CX);
|
||||
Write('Punkt C - Y:');
|
||||
ReadLn(CY);
|
||||
MABX := Mittelpunkt(AX,BX);
|
||||
MABY := Mittelpunkt(AY,BY);
|
||||
MBCX := Mittelpunkt(BX,CX);
|
||||
MBCY := Mittelpunkt(BY,CY);
|
||||
MCAX := Mittelpunkt(CX,AX);
|
||||
MCAY := Mittelpunkt(CY,AY);
|
||||
WriteLn('M-AB: ',MABX:2:2,'|',MABY:2:2);
|
||||
WriteLn('M-BC: ',MBCX:2:2,'|',MBCY:2:2);
|
||||
WriteLn('M-CA: ',MCAX:2:2,'|',MCAY:2:2);
|
||||
LAB := Laenge(AX,AY,BX,BY);
|
||||
LBC := Laenge(BX,BY,CX,CY);
|
||||
LCA := Laenge(CX,CY,AX,AY);
|
||||
WriteLn('L„nge AB: ',LAB:5:2,' LE');
|
||||
WriteLn('L„nge BC: ',LBC:5:2,' LE');
|
||||
WriteLn('L„nge CA: ',LCA:5:2,' LE');
|
||||
F := Flaeche(AX,AY,BX,BY,CX,CY);
|
||||
Write('Fl„che: ',F:5:2,' FE');
|
||||
IF F=0 THEN WriteLn(' === Die Punkte sind kollinear. DAS IST KEIN 3ECK!!') ELSE WriteLn;
|
||||
SA := Laenge(MBCX,MBCY,AX,AY);
|
||||
SB := Laenge(MCAX,MCAY,BX,BY);
|
||||
SC := Laenge(MABX,MABY,CX,CY);
|
||||
WriteLn('Seitenhalbierende A-MBC: ',SA:5:2,' LE');
|
||||
WriteLn('Seitenhalbierende B-MCA: ',SB:5:2,' LE');
|
||||
WriteLn('Seitenhalbierende C-MAB: ',SC:5:2,' LE');
|
||||
WriteLn;
|
||||
WriteLn('Bitte Taste dr<64>cken...');
|
||||
ReadKey;
|
||||
WriteLn('=== FERTIG! ===');
|
||||
end.
|
||||
84
DRWBRD.PAS
Normal file
84
DRWBRD.PAS
Normal file
@ -0,0 +1,84 @@
|
||||
program BorderTest;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var i: integer;
|
||||
|
||||
procedure DrawBorder(MaxX,MaxY: integer; TCol, BCol: integer; BType: integer);
|
||||
var i,j: integer;
|
||||
lx,rx,oy,uy,mx,my: integer;
|
||||
DrwDelay, FilDelay: integer;
|
||||
Border: string[8];
|
||||
CenterPos: integer;
|
||||
begin
|
||||
window(1,1,80,25);
|
||||
if (MaxX=0) AND (MaxY=0) AND (TCol=0) AND (BCol=0) then Exit;
|
||||
if BType=1 then Border := 'Ú¿ÀÙ³³ÄÄ';
|
||||
if BType=2 then Border := 'ɻȼººÍÍ';
|
||||
if BType=3 then Border := 'Õ¸Ô¾³³ÍÍ';
|
||||
if BType=4 then Border := 'Ö·Ó½ººÄÄ';
|
||||
if BType=5 then Border := 'ÛÛÛÛÛÛßÜ';
|
||||
if BType=6 then Border := 'Ú·Ô¼³ºÄÍ';
|
||||
lx := 41-MaxX; oy := 13-MaxY; rx := 40+MaxX; uy := 12+MaxY;
|
||||
mx := 40; my := 12; DrwDelay := 1000 div (2*MaxX); FilDelay := 1;
|
||||
TextColor(TCol); TextBackground(BCol);
|
||||
for i:=mx downto lx+1 do begin
|
||||
GotoXY(i,oy); Write(Border[7]);
|
||||
GotoXY((rx+1)-i+lx-1,oy); Write(Border[7]);
|
||||
Delay(DrwDelay);
|
||||
end;
|
||||
GotoXY(lx,oy); Write(Border[1]);
|
||||
GotoXY(rx,oy); Write(Border[2]);
|
||||
Delay(DrwDelay);
|
||||
for i:=oy+1 to uy-1 do begin
|
||||
GotoXY(lx,i); Write(Border[5]);
|
||||
GotoXY(rx,i); Write(Border[6]);
|
||||
Delay(DrwDelay);
|
||||
end;
|
||||
GotoXY(lx,uy); Write(Border[3]);
|
||||
GotoXY(rx,uy); Write(Border[4]);
|
||||
Delay(DrwDelay);
|
||||
for i:=lx+1 to mx do begin
|
||||
GotoXY(i,uy); Write(Border[8]);
|
||||
GotoXY((rx+1)-i+lx-1,uy); Write(Border[8]);
|
||||
Delay(DrwDelay);
|
||||
end;
|
||||
for i:=lx+1 to rx-1 do begin
|
||||
for j:=oy+1 to uy-1 do begin
|
||||
GotoXY(i,j); Write(' ');
|
||||
Delay(FilDelay);
|
||||
end;
|
||||
end;
|
||||
CenterPos := (rx-lx) div 2; window(lx+2,oy+1,rx-2,uy-1);
|
||||
end;
|
||||
|
||||
procedure NameBorder(num: integer);
|
||||
begin
|
||||
GotoXY(1,1);
|
||||
WriteLn('B');
|
||||
WriteLn('O');
|
||||
WriteLn('R');
|
||||
WriteLn('D');
|
||||
WriteLn('E');
|
||||
WriteLn('R');
|
||||
WriteLn('#');
|
||||
WriteLn(num);
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
DrawBorder(40,12,15,0,1);
|
||||
NameBorder(1);
|
||||
DrawBorder(35,11,14,1,2);
|
||||
NameBorder(2);
|
||||
DrawBorder(30,10,13,2,3);
|
||||
NameBorder(3);
|
||||
DrawBorder(25,9,12,3,4);
|
||||
NameBorder(4);
|
||||
DrawBorder(20,8,11,4,5);
|
||||
NameBorder(5);
|
||||
DrawBorder(15,7,10,5,6);
|
||||
NameBorder(6);
|
||||
Write('Jedes Fenster ist durch ein window-Befehl begrenzt. Dadurch wird ein Zerst”ren des Fensters durch einen Umbruch');
|
||||
WriteLn(' verhindert.');
|
||||
end.
|
||||
23
FILLMEM.PAS
Normal file
23
FILLMEM.PAS
Normal file
@ -0,0 +1,23 @@
|
||||
program MemTest;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var i: longint;
|
||||
|
||||
procedure FillMem(x: longint);
|
||||
begin
|
||||
WriteLn('FillMem [',x,'] <-');
|
||||
if x<1982 then FillMem(x+1);
|
||||
WriteLn('FillMem [',x,'] ->');
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
{ i := 0;
|
||||
repeat
|
||||
Inc(i);
|
||||
FillMem(i);
|
||||
until keypressed;
|
||||
ReadKey; }
|
||||
FillMem(1);
|
||||
end.
|
||||
137
FUNCTION.PAS
Normal file
137
FUNCTION.PAS
Normal file
@ -0,0 +1,137 @@
|
||||
program BGIGraph;
|
||||
|
||||
uses Crt, Graph, BGIP;
|
||||
|
||||
const xsize=600; { Breite des Funktionsfensters }
|
||||
ysize=440; { H”he des Funktionsfensters }
|
||||
xscaledelay=0;
|
||||
yscaledelay=0;
|
||||
graphdelay=6;
|
||||
WaitAfterInit=500;
|
||||
|
||||
var xmax, ymax: integer;
|
||||
xmed, ymed: integer;
|
||||
xsmed, ysmed: integer;
|
||||
|
||||
|
||||
procedure InitGraphic; { Initialisiert die Grafik und definiert alle wichtigen Variablen }
|
||||
var BGIMode, BGIDriv: integer;
|
||||
begin
|
||||
BGIDriv := 9;
|
||||
BGIMode := 2;
|
||||
InitGraph(BGIDriv,BGIMode,BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xsize div 2; { Mitte-X des Funktionsfensters }
|
||||
ymed := ysize div 2; { Mitte-Y des Funktionsfensters }
|
||||
xsmed := xmax div 2; { Mitte-X des Bildschirmes }
|
||||
ysmed := ymax div 2; { Mitte-Y des Bildschirmes }
|
||||
Delay(WaitAfterInit);
|
||||
end;
|
||||
|
||||
procedure CloseGraphic;
|
||||
begin
|
||||
CloseGraph;
|
||||
end;
|
||||
|
||||
procedure MakeScale;
|
||||
var i: integer;
|
||||
begin
|
||||
SetTextStyle(DefaultFont, HorizDir, 1);
|
||||
SetColor(14);
|
||||
OutTextXY(150,10,'-=+ RoboCop''s ultimativer Funktionsplotter +=-');
|
||||
SetColor(8);
|
||||
Line(xsmed-xmed,ysmed,xsmed+xmed,ysmed);
|
||||
Line(xsmed,ysmed-ymed,xsmed,ysmed+ymed);
|
||||
for i:=xsmed-xmed to xsmed+xmed do begin
|
||||
if ((i-(xsmed-xmed))/10=Int((i-(xsmed-xmed))/10)) then begin
|
||||
if ((i-(xsmed-xmed))/50=Int((i-(xsmed-xmed))/50)) then begin
|
||||
SetColor(7);
|
||||
Line(i,ysmed-2,i,ysmed+2);
|
||||
end else begin
|
||||
SetColor(8);
|
||||
Line(i,ysmed-1,i,ysmed+1);
|
||||
end;
|
||||
end;
|
||||
Delay(xscaledelay);
|
||||
end;
|
||||
for i:=ysmed-ymed to ysmed+ymed do begin
|
||||
if ((i-(ysmed-ymed))/10=Int((i-(ysmed-ymed))/10)) then begin
|
||||
if ((i-(ysmed-ymed))/50=Int((i-(ysmed-ymed))/50)) then begin
|
||||
SetColor(7);
|
||||
Line(xsmed-2,i,xsmed+2,i);
|
||||
end else begin
|
||||
SetColor(8);
|
||||
Line(xsmed-1,i,xsmed+1,i);
|
||||
end;
|
||||
end;
|
||||
Delay(yscaledelay);
|
||||
end;
|
||||
SetColor(15);
|
||||
OutTextXY(xmed+xsmed,ysmed+10,'x');
|
||||
OutTextXY(xsmed+10,ysmed-ymed-5,'y');
|
||||
end;
|
||||
|
||||
function y(x: real): real;
|
||||
begin
|
||||
y := x*x*x-3*x*x+2;
|
||||
end;
|
||||
|
||||
procedure MakeFunction;
|
||||
var i: integer;
|
||||
ty: integer;
|
||||
fr,fpr,x: real;
|
||||
begin
|
||||
SetColor(9);
|
||||
for i:=xsmed-xmed to xsmed+xmed do begin
|
||||
x := ((i-1)-xsmed)/(xmed/10);
|
||||
fpr := y(x);
|
||||
if fpr>32767 then fpr := 32767;
|
||||
if fpr<-32767 then fpr := -32767;
|
||||
fr := fpr*(ysize div 20);
|
||||
ty := ysmed-Trunc(fr);
|
||||
if ty>ysmed+ymed then begin
|
||||
SetColor(0);
|
||||
ty := ysmed+ymed;
|
||||
end else if ty<ysmed-ymed then begin
|
||||
SetColor(0);
|
||||
ty := ysmed-ymed;
|
||||
end else SetColor(9);
|
||||
MoveTo(i,ty);
|
||||
|
||||
x := (i-xsmed)/(xmed/10);
|
||||
fpr := y(x);
|
||||
if fpr>32767 then fpr := 32767;
|
||||
if fpr<-32767 then fpr := -32767;
|
||||
fr := fpr*(ysize div 20);
|
||||
ty := ysmed-Trunc(fr);
|
||||
if ty>ysmed+ymed then begin
|
||||
SetColor(0);
|
||||
ty := ysmed+ymed;
|
||||
end else if ty<ysmed-ymed then begin
|
||||
SetColor(0);
|
||||
ty := ysmed-ymed;
|
||||
end else SetColor(9);
|
||||
PutPixel(i,ymax-19,7);
|
||||
PutPixel(i,5,7);
|
||||
LineTo(i,ty);
|
||||
Delay(graphdelay);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SystemReady;
|
||||
begin
|
||||
SetColor(10);
|
||||
OutTextXY(160,470,'Graph fertig! Bitte dr<64>cken Sie eine Taste!');
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
InitGraphic;
|
||||
MakeScale;
|
||||
MakeFunction;
|
||||
SystemReady;
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
WriteLn('Programm beendet.');
|
||||
end.
|
||||
190
GRAPHT.PAS
Normal file
190
GRAPHT.PAS
Normal file
@ -0,0 +1,190 @@
|
||||
program Grafiktest;
|
||||
|
||||
uses Crt;
|
||||
|
||||
procedure InitGraph;
|
||||
begin
|
||||
asm
|
||||
mov ah,0
|
||||
mov al,13h
|
||||
int 10h
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PutPixel(x,y: integer; c: byte);
|
||||
begin
|
||||
asm
|
||||
mov ah,0Ch
|
||||
mov al,c
|
||||
mov cx,x
|
||||
mov dx,y
|
||||
int 10h
|
||||
end;
|
||||
(* Sound(c);
|
||||
NoSound; *)
|
||||
end;
|
||||
|
||||
procedure CloseGraph;
|
||||
begin
|
||||
asm
|
||||
mov ah,0
|
||||
mov al,3h
|
||||
int 10h
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Line(x1,y1,x2,y2: integer; c: byte);
|
||||
var i,y: integer;
|
||||
begin
|
||||
if x2>x1 then begin
|
||||
for i:=x1 to x2 do begin
|
||||
y := Trunc(((y2-y1)/(x2-x1))*(i-x1)+y1);
|
||||
PutPixel(i,y,c);
|
||||
end;
|
||||
end else if x1>x2 then begin
|
||||
for i:=x1 downto x2 do begin
|
||||
y := trunc(((y2-y1)/(x2-x1))*(i-x1)+y1);
|
||||
PutPixel(i,y,c);
|
||||
end;
|
||||
end else if y2>y1 then begin
|
||||
for i:=y1 to y2 do PutPixel(x1,i,c);
|
||||
end else if y1>y2 then begin
|
||||
for i:=y1 downto y2 do PutPixel(x1,i,c);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Square(x1,y1,x2,y2: integer; c:byte);
|
||||
begin
|
||||
Line(x1,y1,x2,y1,c);
|
||||
Line(x1,y1,x1,y2,c);
|
||||
Line(x1,y2,x2,y2,c);
|
||||
Line(x2,y1,x2,y2,c);
|
||||
end;
|
||||
|
||||
procedure Lines;
|
||||
begin
|
||||
InitGraph;
|
||||
repeat
|
||||
Line(0,0,320,200,Random(256));
|
||||
Line(320,0,0,200,Random(256));
|
||||
Line(160,0,160,200,Random(256));
|
||||
Line(0,100,320,100,Random(256));
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
end;
|
||||
|
||||
procedure RandPix;
|
||||
begin
|
||||
InitGraph;
|
||||
repeat
|
||||
PutPixel(Random(320),Random(200),Random(256));
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
end;
|
||||
|
||||
procedure FillScreen(c: byte);
|
||||
var i,j: integer;
|
||||
begin
|
||||
InitGraph;
|
||||
for i:=0 to 200 do begin
|
||||
for j:=0 to 320 do begin
|
||||
PutPixel(j,i,c);
|
||||
if keypressed then begin
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
end;
|
||||
|
||||
procedure WhitePix;
|
||||
const MarkCol=8;
|
||||
begin
|
||||
InitGraph;
|
||||
Line(160,98,160,80,MarkCol);
|
||||
PutPixel(159,97,MarkCol);
|
||||
PutPixel(161,97,MarkCol);
|
||||
Line(160,102,160,120,MarkCol);
|
||||
PutPixel(159,103,MarkCol);
|
||||
PutPixel(161,103,MarkCol);
|
||||
Line(158,100,140,100,MarkCol);
|
||||
PutPixel(157,99,MarkCol);
|
||||
PutPixel(157,101,MarkCol);
|
||||
Line(162,100,180,100,MarkCol);
|
||||
PutPixel(163,99,MarkCol);
|
||||
PutPixel(163,101,MarkCol);
|
||||
Square(150,90,170,110,MarkCol);
|
||||
repeat
|
||||
PutPixel(160,100,12);
|
||||
PutPixel(160,100,10);
|
||||
PutPixel(160,100,11);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
end;
|
||||
|
||||
procedure RandSquare;
|
||||
var x1,y1,x2,y2,c: integer;
|
||||
begin
|
||||
InitGraph;
|
||||
repeat
|
||||
x1 := Random(320);
|
||||
y1 := Random(200);
|
||||
x2 := Random(320);
|
||||
y2 := Random(200);
|
||||
c := Random(256);
|
||||
Square(x1,y1,x2,y2,c);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
end;
|
||||
|
||||
procedure ColorTable;
|
||||
var i,j: integer;
|
||||
tm: byte;
|
||||
begin
|
||||
InitGraph;
|
||||
for i:=0 to 199 do begin
|
||||
for j:=0 to 319 do begin
|
||||
{ PutPixel(j,i,Trunc(((j/20)+1)*((i/12.5)+1))); }
|
||||
tm := Trunc((j/20)*(i/12.5));
|
||||
PutPixel(j,i,tm);
|
||||
if keypressed then begin
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
ReadKey;
|
||||
CloseGraph;
|
||||
ClrScr;
|
||||
end;
|
||||
|
||||
|
||||
{ Ellipsengleichung
|
||||
|
||||
xý yý
|
||||
-- + -- = 1
|
||||
a b }
|
||||
|
||||
procedure Ellipsoid(x1,y1,x2,y2: integer; c:byte);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
Randomize;
|
||||
|
||||
Lines;
|
||||
RandPix;
|
||||
FillScreen(Random(256));
|
||||
WhitePix;
|
||||
RandSquare;
|
||||
ColorTable;
|
||||
end.
|
||||
185
GRAV.OUT
Normal file
185
GRAV.OUT
Normal file
@ -0,0 +1,185 @@
|
||||
-=ðþ RoboCop's Gravitation þð=-
|
||||
|
||||
Log vom: 26.8.1998 / 12:40.10,12
|
||||
|
||||
Initialh”he : 1000000.00000 m
|
||||
Gravitationskonstante: 6.7E-0011 m^3*kg^-1*s^-2
|
||||
Masse K”rper 1 : 1 kg
|
||||
Masse K”rper 2 : 7.4E+0022 kg
|
||||
Radius K”rper 2 : 1738000 m
|
||||
Schrittweite : 20 s
|
||||
Genauigkeit : 0.00010 s
|
||||
Anfang : 0 s
|
||||
Ende : 1200 s
|
||||
|
||||
Zeit --- H”he
|
||||
########.##### --- ########.#####
|
||||
20.00010s --- 999869.14487m
|
||||
40.00020s --- 999476.42930m
|
||||
60.00030s --- 998821.40197m
|
||||
80.00030s --- 997903.31339m
|
||||
100.00030s --- 996721.09900m
|
||||
120.00030s --- 995273.38423m
|
||||
140.00030s --- 993558.47481m
|
||||
160.00030s --- 991574.34799m
|
||||
180.00030s --- 989318.64189m
|
||||
200.00030s --- 986788.64287m
|
||||
220.00030s --- 983981.27079m
|
||||
240.00030s --- 980893.06198m
|
||||
260.00030s --- 977520.14959m
|
||||
280.00040s --- 973858.22214m
|
||||
300.00050s --- 969902.55212m
|
||||
320.00060s --- 965647.91573m
|
||||
340.00070s --- 961088.57601m
|
||||
360.00080s --- 956218.24549m
|
||||
380.00090s --- 951030.04370m
|
||||
400.00100s --- 945516.44900m
|
||||
420.00110s --- 939669.24377m
|
||||
440.00120s --- 933479.45189m
|
||||
460.00130s --- 926937.26752m
|
||||
480.00140s --- 920031.97344m
|
||||
500.00150s --- 912751.84731m
|
||||
520.00160s --- 905084.05379m
|
||||
540.00170s --- 897014.51968m
|
||||
560.00180s --- 888527.78904m
|
||||
580.00190s --- 879606.85415m
|
||||
600.00200s --- 870232.95741m
|
||||
620.00210s --- 860385.35794m
|
||||
640.00220s --- 850041.05484m
|
||||
660.00230s --- 839174.45704m
|
||||
680.00240s --- 827756.98675m
|
||||
700.00250s --- 815756.59932m
|
||||
720.00260s --- 803137.19715m
|
||||
740.00270s --- 789857.90761m
|
||||
760.00280s --- 775872.18446m
|
||||
780.00290s --- 761126.67690m
|
||||
800.00300s --- 745559.78856m
|
||||
820.00310s --- 729099.81558m
|
||||
840.00320s --- 711662.50319m
|
||||
860.00330s --- 693147.78194m
|
||||
880.00340s --- 673435.31940m
|
||||
900.00350s --- 652378.31521m
|
||||
920.00360s --- 629794.60818m
|
||||
940.00370s --- 605453.51800m
|
||||
960.00380s --- 579055.61594m
|
||||
980.00390s --- 550200.13543m
|
||||
1000.00400s --- 518329.30345m
|
||||
1020.00410s --- 482625.76914m
|
||||
1040.00420s --- 441803.28351m
|
||||
1060.00430s --- 393611.94057m
|
||||
1080.00440s --- 333359.35994m
|
||||
1100.00450s --- 246824.13935m
|
||||
1120.00460s --- 61331.81844m
|
||||
1140.00470s --- -55209.82198m
|
||||
1160.00480s --- 535105.10044m
|
||||
1180.00490s --- -2440783.59073m
|
||||
1200.00500s --- -6272963.42890m
|
||||
Endzeit: 1201.00010 s
|
||||
Endh”he: 705716.27092 m
|
||||
|
||||
Mindestwert bei 1152.68540 s mit 0.96213 m.
|
||||
|
||||
### Beendet: 26.8.1998 / 12:40.45,77
|
||||
|
||||
|
||||
-=ðþ RoboCop's Gravitation þð=-
|
||||
|
||||
Log vom: 13.4.1999 / 9:45.56,54
|
||||
|
||||
Initialh”he : 1000000.00000 m
|
||||
Gravitationskonstante: 6.7E-0011 m^3*kg^-1*s^-2
|
||||
Masse K”rper 1 : 1 kg
|
||||
Masse K”rper 2 : 7.4E+0022 kg
|
||||
Radius K”rper 2 : 1738000 m
|
||||
Schrittweite : 20 s
|
||||
Genauigkeit : 0.00010 s
|
||||
Anfang : 0 s
|
||||
Ende : 1200 s
|
||||
|
||||
Zeit --- H”he
|
||||
########.##### --- ########.#####
|
||||
20.00010s --- 999869.14487m
|
||||
40.00020s --- 9-=ðþ RoboCop's Gravitation þð=-
|
||||
|
||||
Log vom: 24.11.2000 / 21:59.0,82
|
||||
|
||||
Initialh”he : 1000000.00000 m
|
||||
Gravitationskonstante: 6.7E-0011 m^3*kg^-1*s^-2
|
||||
Masse K”rper 1 : 1 kg
|
||||
Masse K”rper 2 : 7.4E+0022 kg
|
||||
Radius K”rper 2 : 1738000 m
|
||||
Schrittweite : 20 s
|
||||
Genauigkeit : 0.00010 s
|
||||
Anfang : 0 s
|
||||
Ende : 1200 s
|
||||
|
||||
Zeit --- H”he
|
||||
########.##### --- ########.#####
|
||||
20.00010s --- 999869.14487m
|
||||
40.00020s --- 999476.42930m
|
||||
60.00030s --- 998821.40197m
|
||||
80.00030s --- 997903.31339m
|
||||
100.00030s --- 996721.09900m
|
||||
120.00030s --- 995273.38423m
|
||||
140.00030s --- 993558.47481m
|
||||
160.00030s --- 991574.34799m
|
||||
180.00030s --- 989318.64189m
|
||||
200.00030s --- 986788.64287m
|
||||
220.00030s --- 983981.27079m
|
||||
240.00030s --- 980893.06198m
|
||||
260.00030s --- 977520.14959m
|
||||
280.00040s --- 973858.22214m
|
||||
300.00050s --- 969902.55212m
|
||||
320.00060s --- 965647.91573m
|
||||
340.00070s --- 961088.57601m
|
||||
360.00080s --- 956218.24549m
|
||||
380.00090s --- 951030.04370m
|
||||
400.00100s --- 945516.44900m
|
||||
420.00110s --- 939669.24377m
|
||||
440.00120s --- 933479.45189m
|
||||
460.00130s --- 926937.26752m
|
||||
480.00140s --- 920031.97344m
|
||||
500.00150s --- 912751.84731m
|
||||
520.00160s --- 905084.05379m
|
||||
540.00170s --- 897014.51968m
|
||||
560.00180s --- 888527.78904m
|
||||
580.00190s --- 879606.85415m
|
||||
600.00200s --- 870232.95741m
|
||||
620.00210s --- 860385.35794m
|
||||
640.00220s --- 850041.05484m
|
||||
660.00230s --- 839174.45704m
|
||||
680.00240s --- 827756.98675m
|
||||
700.00250s --- 815756.59932m
|
||||
720.00260s --- 803137.19715m
|
||||
740.00270s --- 789857.90761m
|
||||
760.00280s --- 775872.18446m
|
||||
780.00290s --- 761126.67690m
|
||||
800.00300s --- 745559.78856m
|
||||
820.00310s --- 729099.81558m
|
||||
840.00320s --- 711662.50319m
|
||||
860.00330s --- 693147.78194m
|
||||
880.00340s --- 673435.31940m
|
||||
900.00350s --- 652378.31521m
|
||||
920.00360s --- 629794.60818m
|
||||
940.00370s --- 605453.51800m
|
||||
960.00380s --- 579055.61594m
|
||||
980.00390s --- 550200.13543m
|
||||
1000.00400s --- 518329.30345m
|
||||
1020.00410s --- 482625.76914m
|
||||
1040.00420s --- 441803.28351m
|
||||
1060.00430s --- 393611.94057m
|
||||
1080.00440s --- 333359.35994m
|
||||
1100.00450s --- 246824.13935m
|
||||
1120.00460s --- 61331.81844m
|
||||
1140.00470s --- -55209.82198m
|
||||
1160.00480s --- 535105.10044m
|
||||
1180.00490s --- -2440783.59073m
|
||||
1200.00500s --- -6272963.42890m
|
||||
Endzeit: 1201.00010 s
|
||||
Endh”he: 705716.27092 m
|
||||
|
||||
Mindestwert bei 1152.68540 s mit 0.96213 m.
|
||||
|
||||
### Beendet: 24.11.2000 / 21:59.36,30
|
||||
|
||||
|
||||
175
GRAV.PAS
Normal file
175
GRAV.PAS
Normal file
@ -0,0 +1,175 @@
|
||||
{$N+}
|
||||
program Gravitation;
|
||||
|
||||
uses Crt,Dos;
|
||||
|
||||
var act,old,tim,last: extended;
|
||||
percges: extended;
|
||||
steps: extended;
|
||||
actstep,oldact: longint;
|
||||
proz,oldproz: real;
|
||||
lowt: extended;
|
||||
lowh: extended;
|
||||
perc: real;
|
||||
h,m,s,hu: word;
|
||||
d,mm,y,dof: word;
|
||||
ofile: text;
|
||||
|
||||
|
||||
const Hoehe=1E+06;
|
||||
Gravk=6.67259E-11;
|
||||
Erdm=7.35E+22; { Erde: 5.976E+24, Mond: 7.35E+22 }
|
||||
Erdrad=1738000; { Erde: 6371025 , Mond: 1738000 }
|
||||
Schritt=20;
|
||||
IS:extended=1E-4;
|
||||
Start=0;
|
||||
Ende=1200;
|
||||
Arg=9;
|
||||
Va=11;
|
||||
AnU:integer=10000;
|
||||
OUT:boolean=TRUE;
|
||||
|
||||
function GetHeight(tim,old: extended):extended;
|
||||
begin
|
||||
GetHeight:=Hoehe-((Gravk*Erdm)/(2*Sqr(Erdrad+old)))*Sqr(tim);
|
||||
end;
|
||||
|
||||
procedure ArgOut(desc:string;val:extended;un:string;x:integer);
|
||||
begin
|
||||
TextColor(Arg);
|
||||
Write(desc+': ');
|
||||
TextColor(Va);
|
||||
Write(val:0:x);
|
||||
TextColor(Arg);
|
||||
WriteLn(' '+un+' ');
|
||||
end;
|
||||
|
||||
function LTo14(num: extended): string;
|
||||
var temp: string;
|
||||
i: integer;
|
||||
begin
|
||||
Str(num:8:5,temp);
|
||||
for i:=1 to 14-Length(temp) do temp:=' '+temp;
|
||||
LTo14 := temp;
|
||||
end;
|
||||
|
||||
procedure ShowMeThat;
|
||||
var temp,temp2: string;
|
||||
i: integer;
|
||||
begin
|
||||
GotoXY(1,6);
|
||||
ArgOut('Zeit',tim,'s',5);
|
||||
ArgOut('H”he',act,'m',5);
|
||||
if OUT then WriteLn(ofile,LTo14(tim),'s --- ',LTo14(act),'m');
|
||||
end;
|
||||
|
||||
procedure IncStep;
|
||||
begin
|
||||
actstep:=actstep+1;
|
||||
if (actstep>0) then proz:=(actstep/steps)*100 else proz:=0;
|
||||
if proz>=oldproz+0.1 then begin
|
||||
oldproz:=proz;
|
||||
GotoXY(40,3);
|
||||
ArgOut('Rechnung',actstep,'',0);
|
||||
GotoXY(40,4);
|
||||
ArgOut('Prozent',proz,'',1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckOut;
|
||||
begin
|
||||
if tim>=last+Schritt then begin
|
||||
last:=tim;
|
||||
ShowMeThat;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure StartCalc;
|
||||
label 1;
|
||||
begin
|
||||
1:act:=GetHeight(tim,old);
|
||||
old:=act;
|
||||
IncStep;
|
||||
if ((act<lowh) AND (act>0)) then begin
|
||||
lowh:=act;
|
||||
lowt:=tim;
|
||||
end;
|
||||
CheckOut;
|
||||
if tim<Ende+1 then begin
|
||||
tim:=tim+IS;
|
||||
goto 1
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
ClrScr;
|
||||
actstep:=0;
|
||||
steps:=(Ende-Start)/IS;
|
||||
GotoXY(1,1);
|
||||
TextColor(Yellow);
|
||||
WriteLn('-=ðþ RoboCop''s Gravitation þð=-');
|
||||
old:=Hoehe;
|
||||
lowh:=Hoehe;
|
||||
TextColor(White);
|
||||
GotoXY(1,3);
|
||||
ArgOut('Initialh”he',Hoehe,'m',0);
|
||||
ArgOut('Anzahl Rechnungen',steps,'',0);
|
||||
TextColor(Arg);
|
||||
Write('Genauigkeit: ');
|
||||
TextColor(Va);
|
||||
Write(IS:1);
|
||||
last:=Start;
|
||||
tim:=Start;
|
||||
if OUT then begin
|
||||
Assign(ofile,'GRAV.OUT');
|
||||
{$I-}
|
||||
Append(ofile);
|
||||
{$I+}
|
||||
if IOResult<>0 then Rewrite(ofile);
|
||||
WriteLn(ofile,'-=ðþ RoboCop''s Gravitation þð=-');
|
||||
WriteLn(ofile,'');
|
||||
GetDate(y,mm,d,dof);
|
||||
GetTime(h,m,s,hu);
|
||||
WriteLn(ofile,'Log vom: ',d,'.',mm,'.',y,' / ',h,':',m,'.',s,',',hu);
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'Initialh”he : ',Hoehe:0:5,' m');
|
||||
WriteLn(ofile,'Gravitationskonstante: ',Gravk:1,' m^3*kg^-1*s^-2');
|
||||
WriteLn(ofile,'Masse K”rper 1 : 1 kg');
|
||||
WriteLn(ofile,'Masse K”rper 2 : ',Erdm:1,' kg');
|
||||
WriteLn(ofile,'Radius K”rper 2 : ',Erdrad,' m');
|
||||
WriteLn(ofile,'Schrittweite : ',Schritt,' s');
|
||||
WriteLn(ofile,'Genauigkeit : ',IS:0:5,' s');
|
||||
WriteLn(ofile,'Anfang : ',Start,' s');
|
||||
WriteLn(ofile,'Ende : ',Ende,' s');
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,' Zeit --- H”he');
|
||||
WriteLn(ofile,'########.##### --- ########.#####');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
GotoXY(1,9);
|
||||
ArgOut('Endzeit',tim,'s',5);
|
||||
ArgOut('Endh”he',act,'m',5);
|
||||
if OUT then begin
|
||||
WriteLn(ofile,'Endzeit: ',tim:0:5,' s');
|
||||
WriteLn(ofile,'Endh”he: ',act:0:5,' m');
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'Mindestwert bei ',lowt:0:5,' s mit ',lowh:0:5,' m.');
|
||||
GetDate(y,mm,d,dof);
|
||||
GetTime(h,m,s,hu);
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'### Beendet: ',d,'.',mm,'.',y,' / ',h,':',m,'.',s,',',hu);
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'');
|
||||
Close(ofile);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
StartCalc;
|
||||
Outit;
|
||||
end.
|
||||
97
GRAV/GRAV.OUT
Normal file
97
GRAV/GRAV.OUT
Normal file
@ -0,0 +1,97 @@
|
||||
-=ðþ RoboCop's Gravitation þð=-
|
||||
|
||||
Log vom: 16.3.1998 / 9:43.9,90
|
||||
|
||||
Initialh”he : 1000000.00000 m
|
||||
Gravitationskonstante: 6.7E-0011 m^3*kg^-1*s^-2
|
||||
Masse K”rper 1 : 1 kg
|
||||
Masse K”rper 2 : 7.4E+0022 kg
|
||||
Radius K”rper 2 : 1738000 m
|
||||
Schrittweite : 20 s
|
||||
Genauigkeit : 0.00010 s
|
||||
Anfang : 0 s
|
||||
Ende : 1200 s
|
||||
|
||||
Zeit --- H”he
|
||||
########.##### --- ########.#####
|
||||
20.00010s --- 999869.14487m
|
||||
40.00020s --- 999476.42930m
|
||||
60.00030s --- 998821.40197m
|
||||
80.00030s --- 997903.31339m
|
||||
100.00030s --- 996721.09900m
|
||||
120.00030s --- 995273.38423m
|
||||
140.00030s --- 993558.47481m
|
||||
160.00030s --- 991574.34799m
|
||||
180.00030s --- 989318.64189m
|
||||
200.00030s --- 986788.64287m
|
||||
220.00030s --- 983981.27079m
|
||||
240.00030s --- 980893.06198m
|
||||
260.00030s --- 977520.14959m
|
||||
280.00040s --- 973858.22214m
|
||||
300.00050s --- 969902.55212m
|
||||
320.00060s --- 965647.91573m
|
||||
340.00070s --- 961088.57601m
|
||||
360.00080s --- 956218.24549m
|
||||
380.00090s --- 951030.04370m
|
||||
400.00100s --- 945516.44900m
|
||||
420.00110s --- 939669.24377m
|
||||
440.00120s --- 933479.45189m
|
||||
460.00130s --- 926937.26752m
|
||||
480.00140s --- 920031.97344m
|
||||
500.00150s --- 912751.84731m
|
||||
520.00160s --- 905084.05379m
|
||||
540.00170s --- 897014.51968m
|
||||
560.00180s --- 888527.78904m
|
||||
580.00190s --- 879606.85415m
|
||||
600.00200s --- 870232.95741m
|
||||
620.00210s --- 860385.35794m
|
||||
640.00220s --- 850041.05484m
|
||||
660.00230s --- 839174.45704m
|
||||
680.00240s --- 827756.98675m
|
||||
700.00250s --- 815756.59932m
|
||||
720.00260s --- 803137.19715m
|
||||
740.00270s --- 789857.90761m
|
||||
760.00280s --- 775872.18446m
|
||||
780.00290s --- 761126.67690m
|
||||
800.00300s --- 745559.78856m
|
||||
820.00310s --- 729099.81558m
|
||||
840.00320s --- 711662.50319m
|
||||
860.00330s --- 693147.78194m
|
||||
880.00340s --- 673435.31940m
|
||||
900.00350s --- 652378.31521m
|
||||
920.00360s --- 629794.60818m
|
||||
940.00370s --- 605453.51800m
|
||||
960.00380s --- 579055.61594m
|
||||
980.00390s --- 550200.13543m
|
||||
1000.00400s --- 518329.30345m
|
||||
1020.00410s --- 482625.76914m
|
||||
1040.00420s --- 441803.28351m
|
||||
1060.00430s --- 393611.94057m
|
||||
1080.00440s --- 333359.35994m
|
||||
1100.00450s --- 246824.13935m
|
||||
1120.00460s --- 61331.81844m
|
||||
1140.00470s --- -55209.82198m
|
||||
1160.00480s --- 535105.10044m
|
||||
1180.00490s --- -2440783.59073m
|
||||
1200.00500s --- -6272963.42890m
|
||||
Endzeit: 1201.00010 s
|
||||
Endh”he: 705716.27092 m
|
||||
|
||||
Mindestwert bei 1152.68540 s mit 0.96213 m.
|
||||
|
||||
### Beendet: 16.3.1998 / 9:44.17,40
|
||||
|
||||
|
||||
-=ðþ RoboCop's Gravitation þð=-
|
||||
|
||||
Log vom: 1.10.1998 / 14:51.49,89
|
||||
|
||||
Initialh”he : 1000000.00000 m
|
||||
Gravitationskonstante: 6.7E-0011 m^3*kg^-1*s^-2
|
||||
Masse K”rper 1 : 1 kg
|
||||
Masse K”rper 2 : 7.4E+0022 kg
|
||||
Radius K”rper 2 : 1738000 m
|
||||
Schrittweite : 20 s
|
||||
Genauigkeit : 0.00010 s
|
||||
Anfang : 0 s
|
||||
Ende : 1200 s
|
||||
175
GRAV/GRAV.PAS
Normal file
175
GRAV/GRAV.PAS
Normal file
@ -0,0 +1,175 @@
|
||||
{$N+}
|
||||
program Gravitation;
|
||||
|
||||
uses Crt,Dos;
|
||||
|
||||
var act,old,tim,last: extended;
|
||||
percges: extended;
|
||||
steps: extended;
|
||||
actstep,oldact: longint;
|
||||
proz,oldproz: real;
|
||||
lowt: extended;
|
||||
lowh: extended;
|
||||
perc: real;
|
||||
h,m,s,hu: word;
|
||||
d,mm,y,dof: word;
|
||||
ofile: text;
|
||||
|
||||
|
||||
const Hoehe=1E+06;
|
||||
Gravk=6.67259E-11;
|
||||
Erdm=7.35E+22; { Erde: 5.976E+24, Mond: 7.35E+22 }
|
||||
Erdrad=1738000; { Erde: 6371025 , Mond: 1738000 }
|
||||
Schritt=20;
|
||||
IS:extended=1E-4;
|
||||
Start=0;
|
||||
Ende=1200;
|
||||
Arg=9;
|
||||
Va=11;
|
||||
AnU:integer=10000;
|
||||
OUT:boolean=TRUE;
|
||||
|
||||
function GetHeight(tim,old: extended):extended;
|
||||
begin
|
||||
GetHeight:=Hoehe-((Gravk*Erdm)/(2*Sqr(Erdrad+old)))*Sqr(tim);
|
||||
end;
|
||||
|
||||
procedure ArgOut(desc:string;val:extended;un:string;x:integer);
|
||||
begin
|
||||
TextColor(Arg);
|
||||
Write(desc+': ');
|
||||
TextColor(Va);
|
||||
Write(val:0:x);
|
||||
TextColor(Arg);
|
||||
WriteLn(' '+un+' ');
|
||||
end;
|
||||
|
||||
function LTo14(num: extended): string;
|
||||
var temp: string;
|
||||
i: integer;
|
||||
begin
|
||||
Str(num:8:5,temp);
|
||||
for i:=1 to 14-Length(temp) do temp:=' '+temp;
|
||||
LTo14 := temp;
|
||||
end;
|
||||
|
||||
procedure ShowMeThat;
|
||||
var temp,temp2: string;
|
||||
i: integer;
|
||||
begin
|
||||
GotoXY(1,6);
|
||||
ArgOut('Zeit',tim,'s',5);
|
||||
ArgOut('H”he',act,'m',5);
|
||||
if OUT then WriteLn(ofile,LTo14(tim),'s --- ',LTo14(act),'m');
|
||||
end;
|
||||
|
||||
procedure IncStep;
|
||||
begin
|
||||
actstep:=actstep+1;
|
||||
if (actstep>0) then proz:=(actstep/steps)*100 else proz:=0;
|
||||
if proz>=oldproz+0.1 then begin
|
||||
oldproz:=proz;
|
||||
GotoXY(40,3);
|
||||
ArgOut('Rechnung',actstep,'',0);
|
||||
GotoXY(40,4);
|
||||
ArgOut('Prozent',proz,'',1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckOut;
|
||||
begin
|
||||
if tim>=last+Schritt then begin
|
||||
last:=tim;
|
||||
ShowMeThat;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure StartCalc;
|
||||
label 1;
|
||||
begin
|
||||
1:act:=GetHeight(tim,old);
|
||||
old:=act;
|
||||
IncStep;
|
||||
if ((act<lowh) AND (act>0)) then begin
|
||||
lowh:=act;
|
||||
lowt:=tim;
|
||||
end;
|
||||
CheckOut;
|
||||
if tim<Ende+1 then begin
|
||||
tim:=tim+IS;
|
||||
goto 1
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
ClrScr;
|
||||
actstep:=0;
|
||||
steps:=(Ende-Start)/IS;
|
||||
GotoXY(1,1);
|
||||
TextColor(Yellow);
|
||||
WriteLn('-=ðþ RoboCop''s Gravitation þð=-');
|
||||
old:=Hoehe;
|
||||
lowh:=Hoehe;
|
||||
TextColor(White);
|
||||
GotoXY(1,3);
|
||||
ArgOut('Initialh”he',Hoehe,'m',0);
|
||||
ArgOut('Anzahl Rechnungen',steps,'',0);
|
||||
TextColor(Arg);
|
||||
Write('Genauigkeit: ');
|
||||
TextColor(Va);
|
||||
Write(IS:1);
|
||||
last:=Start;
|
||||
tim:=Start;
|
||||
if OUT then begin
|
||||
Assign(ofile,'GRAV.OUT');
|
||||
{$I-}
|
||||
Append(ofile);
|
||||
{$I+}
|
||||
if IOResult<>0 then Rewrite(ofile);
|
||||
WriteLn(ofile,'-=ðþ RoboCop''s Gravitation þð=-');
|
||||
WriteLn(ofile,'');
|
||||
GetDate(y,mm,d,dof);
|
||||
GetTime(h,m,s,hu);
|
||||
WriteLn(ofile,'Log vom: ',d,'.',mm,'.',y,' / ',h,':',m,'.',s,',',hu);
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'Initialh”he : ',Hoehe:0:5,' m');
|
||||
WriteLn(ofile,'Gravitationskonstante: ',Gravk:1,' m^3*kg^-1*s^-2');
|
||||
WriteLn(ofile,'Masse K”rper 1 : 1 kg');
|
||||
WriteLn(ofile,'Masse K”rper 2 : ',Erdm:1,' kg');
|
||||
WriteLn(ofile,'Radius K”rper 2 : ',Erdrad,' m');
|
||||
WriteLn(ofile,'Schrittweite : ',Schritt,' s');
|
||||
WriteLn(ofile,'Genauigkeit : ',IS:0:5,' s');
|
||||
WriteLn(ofile,'Anfang : ',Start,' s');
|
||||
WriteLn(ofile,'Ende : ',Ende,' s');
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,' Zeit --- H”he');
|
||||
WriteLn(ofile,'########.##### --- ########.#####');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
GotoXY(1,9);
|
||||
ArgOut('Endzeit',tim,'s',5);
|
||||
ArgOut('Endh”he',act,'m',5);
|
||||
if OUT then begin
|
||||
WriteLn(ofile,'Endzeit: ',tim:0:5,' s');
|
||||
WriteLn(ofile,'Endh”he: ',act:0:5,' m');
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'Mindestwert bei ',lowt:0:5,' s mit ',lowh:0:5,' m.');
|
||||
GetDate(y,mm,d,dof);
|
||||
GetTime(h,m,s,hu);
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'### Beendet: ',d,'.',mm,'.',y,' / ',h,':',m,'.',s,',',hu);
|
||||
WriteLn(ofile,'');
|
||||
WriteLn(ofile,'');
|
||||
Close(ofile);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
StartCalc;
|
||||
Outit;
|
||||
end.
|
||||
23
GZPRO.PAS
Normal file
23
GZPRO.PAS
Normal file
@ -0,0 +1,23 @@
|
||||
program GZ_PRO_Reader; { Geb<65>hrenz„hler-Auslese-Software }
|
||||
uses Crt;
|
||||
var P: string;
|
||||
Po: file;
|
||||
TempVar: string;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
P := 'COM2';
|
||||
TextColor(Yellow);
|
||||
TextBackground(Blue);
|
||||
Write('GZ-PRO Lesesoftware');
|
||||
TextColor(White);
|
||||
WriteLn(' (C)1997 by RoboCop IND.');
|
||||
TextBackground(Black);
|
||||
TextColor(LightGray);
|
||||
WriteLn('Port: '+P);
|
||||
Assign(Po, P);
|
||||
Reset(Po);
|
||||
while not Eof(Po) do Read(P, TempVar);
|
||||
Close(Po);
|
||||
WriteLn(TempVar);
|
||||
end.
|
||||
130
HACKING/CC.PAS
Normal file
130
HACKING/CC.PAS
Normal file
@ -0,0 +1,130 @@
|
||||
program CCMast;
|
||||
|
||||
uses Crt, DOS;
|
||||
|
||||
var c: record
|
||||
len: integer;
|
||||
str: string;
|
||||
dig: array[1..16] of byte;
|
||||
chk: integer;
|
||||
typ: string;
|
||||
val: string;
|
||||
end;
|
||||
|
||||
procedure InputCC;
|
||||
begin
|
||||
Write('Enter CC#: ');
|
||||
ReadLn(c.str);
|
||||
end;
|
||||
|
||||
procedure CheckType(nam,pres,lens: string);
|
||||
var clen: string;
|
||||
i,oldidx: integer;
|
||||
prechk, lenchk: boolean;
|
||||
begin
|
||||
oldidx := 1;
|
||||
prechk := false;
|
||||
for i:=1 to Length(pres) do begin
|
||||
if pres[i]=',' then begin
|
||||
if Copy(pres,oldidx,i-oldidx)=Copy(c.str,1,i-oldidx) then prechk := true;
|
||||
oldidx := i+1;
|
||||
end;
|
||||
end;
|
||||
oldidx := 1;
|
||||
lenchk := false;
|
||||
Str(c.len,clen);
|
||||
for i:=1 to Length(lens) do begin
|
||||
if lens[i]=',' then begin
|
||||
if Copy(lens,oldidx,i-oldidx)=Copy(clen,1,i-oldidx) then lenchk := true;
|
||||
oldidx := i+1;
|
||||
end;
|
||||
end;
|
||||
{ WriteLn(nam:16,' -prechk: ',prechk:5,' -lenchk: ',lenchk:5); }
|
||||
if prechk AND lenchk then c.typ := nam;
|
||||
end;
|
||||
|
||||
procedure CheckCC;
|
||||
var i,a,co: integer;
|
||||
begin
|
||||
c.len := Length(c.str);
|
||||
for i:=1 to c.len do begin
|
||||
Val(c.str[i],c.dig[i],co);
|
||||
end;
|
||||
c.chk := 0;
|
||||
for i:=c.len downto 1 do begin
|
||||
if (c.len-i) MOD 2=0 then a:=c.dig[i] else a:=c.dig[i]*2;
|
||||
if a>9 then a := a-9;
|
||||
{ WriteLn(i:2,': [',c[i],']: ',a:2); }
|
||||
c.chk := c.chk + a;
|
||||
end;
|
||||
|
||||
c.typ := 'unknown';
|
||||
CheckType('MasterCard', '51,52,53,54,55,', '16,');
|
||||
CheckType('VISA', '4,', '13,16,');
|
||||
CheckType('American Express', '34,37,', '15,');
|
||||
CheckType('Diner''s Club', '30,36,38,', '14,');
|
||||
CheckType('Discover', '6011,', '16,');
|
||||
CheckType('enRoute', '2014,2149,', '15,');
|
||||
CheckType('JCB','3088,3096,3112,3158,3337,3528,','16,');
|
||||
|
||||
WriteLn('Type: ', c.typ);
|
||||
Write('Checksum: ', c.chk);
|
||||
if (c.chk MOD 10=0) AND (c.len>12) AND (c.len<17) then c.val:='VALID' else c.val:='INVALID';
|
||||
WriteLn(' ',c.val);
|
||||
end;
|
||||
|
||||
function Checksum(x: string): integer;
|
||||
var ch, i, co, j: integer;
|
||||
begin
|
||||
ch := 0;
|
||||
for i:=1 to Length(x) do begin
|
||||
val(x[i],j,co);
|
||||
if (Length(x)-i) MOD 2<>0 then j:=j*2;
|
||||
if j>9 then j := j - 9;
|
||||
ch := ch + j;
|
||||
end;
|
||||
Checksum := ch;
|
||||
end;
|
||||
|
||||
function Valid(x: string): boolean;
|
||||
begin
|
||||
if Checksum(x) MOD 10=0 then Valid := true else Valid := false;
|
||||
end;
|
||||
|
||||
procedure Interpolate;
|
||||
var f: text;
|
||||
i: integer;
|
||||
n,o: string;
|
||||
begin
|
||||
Assign(f,'CC.out');
|
||||
{$I-}
|
||||
Append(f);
|
||||
if IOResult<>0 then Rewrite(f);
|
||||
{$I+}
|
||||
WriteLn(f,'---- ---- ---- ----');
|
||||
Write(f,'New Interpolation from ',c.typ,' card ');
|
||||
for i:=1 to c.len do begin
|
||||
Write(f,c.dig[i]:1);
|
||||
if (i MOD 4 = 0) AND (i<>16) then Write(f,' ');
|
||||
end;
|
||||
WriteLn(f,' (Checksum: ',c.chk,' [',c.val,'])');
|
||||
WriteLn(f,'');
|
||||
for i:=0 to 9999 do begin
|
||||
n := Copy(c.str,1,c.len-4);
|
||||
if i<1000 then n := n + '0';
|
||||
if i<100 then n := n + '0';
|
||||
if i<10 then n := n + '0';
|
||||
Str(i:0,o);
|
||||
n := n + o;
|
||||
if (Valid(n)) AND (n<>c.str) then
|
||||
WriteLn(f, Copy(n,1,4),' ',Copy(n,5,4),' ',Copy(n,9,4),' ',Copy(n,13,Length(n)-12),' [',Checksum(n),']');
|
||||
end;
|
||||
Close(f);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
InputCC;
|
||||
CheckCC;
|
||||
Interpolate;
|
||||
end.
|
||||
124
HACKING/DECODE.PAS
Normal file
124
HACKING/DECODE.PAS
Normal file
@ -0,0 +1,124 @@
|
||||
program DecodeSubraum;
|
||||
|
||||
uses Logo, Crt, VFx, Numbers;
|
||||
|
||||
var KeyF,DecF: text;
|
||||
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
ClrScr;
|
||||
CursorOff;
|
||||
TextColor(14);
|
||||
WriteCLn('-=ðþ Subraum Decoder þð=-');
|
||||
WriteLn;
|
||||
TextColor(8);
|
||||
WriteLn('Decodiert KEYFILES vom Programm HRECORD.EXE.');
|
||||
WriteLn;
|
||||
TextColor(7);
|
||||
window(1,5,80,25);
|
||||
end;
|
||||
|
||||
procedure OpenInOut(InFile,OutFile: string);
|
||||
begin
|
||||
WStat('™ffne '+InFile+' f<>r Eingabeoperationen');
|
||||
Assign(KeyF,InFile);
|
||||
{$I-}
|
||||
Reset(KeyF);
|
||||
if IOResult<>0 then begin
|
||||
Wcheck('%%140#FAIL');
|
||||
CWriteLn('%%12#FEHLER!! Datei "'+InFile+'" konnte nicht ge”ffnet werden.');
|
||||
Halt;
|
||||
end;
|
||||
{$I+}
|
||||
Wcheck('%%10# OK ');
|
||||
|
||||
WStat('™ffne '+OutFile+' f<>r Ausgabeoperationen');
|
||||
Assign(DecF,OutFile);
|
||||
{$I-}
|
||||
Rewrite(DecF);
|
||||
if IOResult<>0 then begin
|
||||
Wcheck('%%140#FAIL');
|
||||
CWriteLn('%%10#FEHLER!! Datei "'+OutFile+'" konnte nicht ge”ffnet werden.');
|
||||
Halt;
|
||||
end;
|
||||
{$I+}
|
||||
Wcheck('%%10# OK ');
|
||||
end;
|
||||
|
||||
procedure Decode;
|
||||
var tmp: string;
|
||||
key: byte;
|
||||
dat: string;
|
||||
begin
|
||||
WStat('Decodierung');
|
||||
dat := '';
|
||||
while NOT Eof(KeyF) do begin
|
||||
ReadLn(KeyF,tmp);
|
||||
if Copy(tmp,1,3)='KEY' then begin
|
||||
key := Hex2Dec(Copy(tmp,9,2));
|
||||
case key of
|
||||
008: dat := Copy(dat,1,Length(dat)-1);
|
||||
013: begin WriteLn(DecF,dat); dat := ''; end;
|
||||
else
|
||||
dat:=dat+Chr(key);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Wcheck('%%10# OK ');
|
||||
end;
|
||||
|
||||
procedure CloseInOut;
|
||||
begin
|
||||
WStat('Schlieáe Eingabedatei');
|
||||
Close(KeyF);
|
||||
Wcheck('%%10# OK ');
|
||||
WStat('Schlieáe Ausgabedatei');
|
||||
Close(DecF);
|
||||
Wcheck('%%10# OK ');
|
||||
end;
|
||||
|
||||
procedure OutIt;
|
||||
begin
|
||||
WriteLn;
|
||||
window(1,1,80,25);
|
||||
GotoXY(1,24);
|
||||
WriteLn('Programm beendet.');
|
||||
CursorOn;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
if ((ParamStr(1)='/?') OR (ParamStr(1)='-?') OR (ParamStr(1)='?') OR ((ParamStr(1)='') AND (ParamStr(2)=''))) then begin
|
||||
WriteLogo;
|
||||
TextColor(14);
|
||||
WriteCLn('+ + + Taste dr<64>cken + + +');
|
||||
ReadKey;
|
||||
GotoXY(1,WhereY-1);
|
||||
Write(Space(80));
|
||||
GotoXY(1,WhereY-1);
|
||||
TextColor(7);
|
||||
WriteLn('Die DAT-Dateien sind nach folgendem Schema aufgebaut:');
|
||||
WriteLn('Die erste Zeile ist eine Leerzeile, in der 2. Zeile steht die Gesamtzahl der');
|
||||
WriteLn('enthaltenen Zeichen. Danach folgen die einzelnen Zeichen in folgender Form:');
|
||||
WriteLn;
|
||||
WriteLn('KEY: xx yy zz aa');
|
||||
WriteLn('(xx,yy,zz und aa sind Hexadezimalwerte)');
|
||||
WriteLn;
|
||||
WriteLn('xx ist dabei der SCANCODE des eingelesenen Zeichens, yy der „quivalente');
|
||||
WriteLn('ASCII-Code und zz ein STATUS-Code. aa hat scheinbar keine Bedeutung.');
|
||||
WriteLn;
|
||||
WriteLn('Dieses Programm wandelt die ASCII-Codes wieder in ASCII-Zeichen um und');
|
||||
WriteLn('erstellt eine Datei mit dem "dechiffrierten" Text.');
|
||||
WriteLn;
|
||||
WriteLn('Syntax: ',ParamStr(0),' <Eingabedatei> <Ausgabedatei>');
|
||||
WriteLn;
|
||||
OutIt;
|
||||
Halt;
|
||||
end;
|
||||
OpenInOut(ParamStr(1),ParamStr(2));
|
||||
Decode;
|
||||
CloseInOut;
|
||||
OutIt;
|
||||
end.
|
||||
13
HACKING/EXECTEST.PAS
Normal file
13
HACKING/EXECTEST.PAS
Normal file
@ -0,0 +1,13 @@
|
||||
{ $M $4000,0,0 }
|
||||
|
||||
program ExecTest;
|
||||
|
||||
uses Dos;
|
||||
|
||||
begin
|
||||
SwapVectors;
|
||||
Exec('c:\command.com','');
|
||||
SwapVectors;
|
||||
if DosError<>0 then WriteLn('Dos-Error: ',DosError);
|
||||
WriteLn('Exitcode: ',DosExitCode);
|
||||
end.
|
||||
BIN
HACKING/HACKING.OVL
Normal file
BIN
HACKING/HACKING.OVL
Normal file
Binary file not shown.
55
HACKING/HACKING.PAS
Normal file
55
HACKING/HACKING.PAS
Normal file
@ -0,0 +1,55 @@
|
||||
{ $M $4000,0,0 }
|
||||
|
||||
program Hacking_and_Phreaking;
|
||||
|
||||
uses Crt, Logo, Dos, RC_Disk;
|
||||
|
||||
var s: string;
|
||||
f: file;
|
||||
TempFile: string;
|
||||
|
||||
procedure Init;
|
||||
var f2c: string;
|
||||
begin
|
||||
GetDir(0,s);
|
||||
f2c:=s+'\HACKING.OVL';
|
||||
WriteLn(f2c);
|
||||
WriteLn(TempFile);
|
||||
FileCopy(f2c, TempFile);
|
||||
WriteLn('Temp-Datei angelegt!');
|
||||
Assign(f,TempFile);
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
{ Erase(f); }
|
||||
end;
|
||||
|
||||
procedure Extract(what: string);
|
||||
var Password, Params: string;
|
||||
i: integer;
|
||||
begin
|
||||
Password := '_r';
|
||||
Password := 'op' + Password + 'ul';
|
||||
Password := 'boC' + Password + 'ez';
|
||||
Password := 'Ro' + Password;
|
||||
Params := '-s'+Password+' '+what;
|
||||
SwapVectors;
|
||||
WriteLn('Vectors swapped out');
|
||||
Exec(TempFile, Params);
|
||||
WriteLn('EXEC command performed ('+tempfile+' '+Params+')');
|
||||
SwapVectors;
|
||||
WriteLn('Vectors swapped in');
|
||||
end;
|
||||
|
||||
begin
|
||||
TempFile := GetEnv('TEMP')+'\~1234567.EXE';
|
||||
ClrScr;
|
||||
Init;
|
||||
delay(100);
|
||||
Extract('MADMAN.TXT');
|
||||
SwapVectors;
|
||||
Exec('c:\termin.exe','');
|
||||
SwapVectors;
|
||||
Outit;
|
||||
end.
|
||||
32
HACKING/RC_DISK.PAS
Normal file
32
HACKING/RC_DISK.PAS
Normal file
@ -0,0 +1,32 @@
|
||||
unit RC_Disk; { BLEA01.PAS }
|
||||
|
||||
interface
|
||||
procedure FileCopy(src: string; tar: string);
|
||||
|
||||
implementation
|
||||
|
||||
procedure FileCopy(src: string; tar: string);
|
||||
const
|
||||
bytezahl=16384;
|
||||
|
||||
var
|
||||
Quelle, Ziel: file ;
|
||||
Puffer: array [1..bytezahl] of byte;
|
||||
Recordzahl, Rest: integer;
|
||||
|
||||
begin
|
||||
Assign(Quelle, src);
|
||||
Reset(Quelle,1);
|
||||
Assign(Ziel, tar);
|
||||
Rewrite(Ziel,1);
|
||||
Rest := FileSize(Quelle);
|
||||
while Rest>0 do begin
|
||||
if Bytezahl<=Rest then Recordzahl := Bytezahl else Recordzahl := Rest;
|
||||
BlockRead(Quelle, Puffer, Recordzahl);
|
||||
BlockWrite(Ziel, Puffer, Recordzahl);
|
||||
Rest := Rest-Recordzahl;
|
||||
end;
|
||||
Close(Quelle);
|
||||
Close(Ziel);
|
||||
end;
|
||||
end.
|
||||
54
HACKING/smsar.pas
Normal file
54
HACKING/smsar.pas
Normal file
@ -0,0 +1,54 @@
|
||||
program SMSArchiverDecode;
|
||||
|
||||
uses Crt, DOS;
|
||||
|
||||
const ifile='smsar.dat';
|
||||
|
||||
var data: array[1..10] of string;
|
||||
i,coe: integer;
|
||||
f: text;
|
||||
k: char;
|
||||
cx,cy: integer;
|
||||
|
||||
function Decode(x: string): string;
|
||||
var i,y: integer;
|
||||
tmp: string;
|
||||
begin
|
||||
tmp := '';
|
||||
for i:=1 to Length(x) do begin
|
||||
y := Ord(x[i]);
|
||||
tmp := tmp + Chr(y+coe);
|
||||
end;
|
||||
Decode := tmp;
|
||||
end;
|
||||
|
||||
procedure Get10Lines;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to 10 do ReadLn(f,data[i]);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
Write('Opening ',ifile,' ... ');
|
||||
Assign(f,ifile);
|
||||
Reset(f);
|
||||
WriteLn('OK.');
|
||||
Write('Getting 10 lines ... ');
|
||||
Get10Lines;
|
||||
WriteLn('OK.');
|
||||
cx := WhereX;
|
||||
cy := WhereY;
|
||||
repeat
|
||||
ClrScr;
|
||||
for i:=1 to 10 do WriteLn(Decode(data[i]));
|
||||
WriteLn('Coefficient: ',coe);
|
||||
k := ReadKey;
|
||||
if k='+' then coe:=coe+1;
|
||||
if k='-' then coe:=coe-1;
|
||||
until k=#27;
|
||||
Write('Closing file ... ');
|
||||
Close(f);
|
||||
WriteLn('OK.');
|
||||
end.
|
||||
12
HTMLVIEW.HTM
Normal file
12
HTMLVIEW.HTM
Normal file
@ -0,0 +1,12 @@
|
||||
<FONT FACE=...>Text blablabla...bla</FONT>
|
||||
Herzen: <3<3<3<3<3 :nezreH
|
||||
<DUMMY-TAG>
|
||||
<!-- Kommentar -->
|
||||
<B>BOLD TEXT</B>Normal<I>Italic text</I>
|
||||
Normal text
|
||||
<U>Underlined text</U>
|
||||
Normal text
|
||||
<A HREF="http://RoboCop.home.pages.de">Hyperlink</A>
|
||||
<FONT FACE="Comic Sans MS" COLOR="#FFFFFF">Font-Tag mit Color #FFFFFF und Face Comic Sans MS Ð Þ þ</FONT>
|
||||
<FONT FACE="..">font</FONT>Normal
|
||||
© 1997 by RoboCop of nOOb (dä Rächä mit dém Bächa)
|
||||
202
HTMLVIEW.PAS
Normal file
202
HTMLVIEW.PAS
Normal file
@ -0,0 +1,202 @@
|
||||
program HTML_Viewer; { geschrieben von RoboCop of nOOb a.k.a. Markus Birth }
|
||||
|
||||
uses Crt, Logo, BasicStrings, HTML, Statusbar, CursorOnOff, HTMLV_Unit;
|
||||
|
||||
var ViewTags: boolean; { Tags anzeigen - BOOLEAN }
|
||||
ShowCols: boolean; { Farben zeigen - BOOLEAN }
|
||||
WordWrap: boolean; { Wortumbruch - BOOLEAN }
|
||||
ConvEntit: boolean; { Entity-Konv. - BOOLEAN }
|
||||
IK: char; { gedr<64>ckte Taste }
|
||||
skipped: longint; { Zeilen, die vom Dokument <20>bersprungen wurden (alle, die schon weggescrollt wurden) }
|
||||
SwitchToNormal: boolean; { Soll ich nach dem n„chsten '>' in die Normalfarbe wechseln? }
|
||||
|
||||
procedure SetPrefs; { Voreinstellungen festlegen }
|
||||
begin
|
||||
ViewTags := false;
|
||||
ShowCols := true;
|
||||
WordWrap := false;
|
||||
ConvEntit:= true;
|
||||
Color_Normal := 11;
|
||||
Color_Comments := 7;
|
||||
Color_Bold := 14;
|
||||
Color_Italic := 15;
|
||||
Color_Underlined := 13;
|
||||
Color_Anchor := 12;
|
||||
Color_Font := 10;
|
||||
end;
|
||||
|
||||
procedure About; { Der Kommentar, der bei fehlendem Parameter ausgegeben wird }
|
||||
begin
|
||||
WriteLogo;
|
||||
TextColor(15);
|
||||
WriteLn('-=ðþ HTML Viewer þð=-');
|
||||
WriteLn;
|
||||
TextColor(7);
|
||||
WriteLn('Entfernt HTML-Tags aus Dateien und zeigt sie an.');
|
||||
WriteLn('Geschrieben von RoboCop of nOOb');
|
||||
WriteLn;
|
||||
WriteLn('Dies ist noch die ''dumme'' Version. Sie entfernt alles, was zwischen');
|
||||
WriteLn('< und > steht. Eine intelligente Version wird auch noch folgen!');
|
||||
WriteLn;
|
||||
WriteLn('Syntax: '+ParamStr(0)+' <HTML-Datei>');
|
||||
Halt
|
||||
end;
|
||||
|
||||
procedure UpdateStatus; { Schreibt Statusleiste }
|
||||
begin
|
||||
WriteStatusItem( 1,'Hilfe');
|
||||
if ViewTags then WriteStatusItem(2,'k.Tags') else WriteStatusItem(2,'Tags');
|
||||
if ShowCols then WriteStatusItem(3,'k.Farb') else WriteStatusItem(3,'Farben');
|
||||
if WordWrap then WriteStatusItem(4,'k.Wrap') else WriteStatusItem(4,'Wrap');
|
||||
if ConvEntit then WriteStatusItem(5,'Entity') else WriteStatusItem(5,'Umlaut');
|
||||
WriteStatusItem( 6,'');
|
||||
WriteStatusItem( 7,'');
|
||||
WriteStatusItem( 8,'');
|
||||
WriteStatusItem( 9,'');
|
||||
WriteStatusItem(10,'Ende'); { Hier nur 5 Zeichen verwutzen, da sonst die Statusleiste eins h”her rutscht }
|
||||
end;
|
||||
|
||||
function IsCloseTag(T: string): boolean; { Pr<50>ft, ob T ein Schlieá-Tag ist und gibt je nachdem TRUE oder FALSE zur<75>ck }
|
||||
var C3: string[3];
|
||||
C4: string[4];
|
||||
C5: string[5];
|
||||
begin
|
||||
C3 := Left(T,3);
|
||||
C4 := Left(T,4);
|
||||
C5 := Left(T,5);
|
||||
if ( (C3='-->')
|
||||
or (C4='</B>')
|
||||
or (C4='</I>')
|
||||
or (C4='</A>')
|
||||
or (C4='</U>')
|
||||
or (C5='</FON')) then IsCloseTag := true else IsCloseTag := false;
|
||||
end;
|
||||
|
||||
function MakeColor(Temp: string; i: integer): integer; { Setzt je nach Tag neue Textfarbe }
|
||||
var PART: string[5];
|
||||
C3: string[3];
|
||||
C4: string[4];
|
||||
begin
|
||||
if i>4 then PART := Mid(Temp,i,5);
|
||||
C3 := Mid(Temp,i,3);
|
||||
C4 := Mid(Temp,i,4);
|
||||
if IsCloseTag(PART) then SwitchToNormal:=true;
|
||||
if C3='<B>' then MakeColor:=Color_Bold
|
||||
else if C3='<I>' then MakeColor:=Color_Italic
|
||||
else if C3='<U>' then MakeColor:=Color_Underlined
|
||||
else if C3='<A ' then MakeColor:=Color_Anchor
|
||||
else if C4='<FON' then MakeColor:=Color_Font
|
||||
else if C4='<!--' then MakeColor:=Color_Comments
|
||||
else MakeColor:=Color_Normal;
|
||||
end;
|
||||
|
||||
procedure WriteLine(var Temp: string); { Schreibt eine Zeile auf den Bildschirm }
|
||||
var si: string[1];
|
||||
i,j: integer;
|
||||
lc: integer;
|
||||
t: boolean;
|
||||
nc: integer;
|
||||
begin
|
||||
lc := 1;
|
||||
if ConvEntit then ConvEntities(Temp);
|
||||
for i:=1 to length(Temp) do begin { F<>r den ganzen String }
|
||||
si:=Mid(Temp,i,1); { si ist das momentane Zeichen bei i }
|
||||
if ((si='<') or (Mid(Temp,i,3)='-->')) then begin { Wenn Zeichen == '<' oder die n„chsten 3 == '-->' }
|
||||
t:=true; { Ja, es ist ein Tag }
|
||||
if ShowCols then nc:=MakeColor(Temp,i) else nc:=0; { Wenn Farben AN, dann Tag-Farbe --> nc }
|
||||
end;
|
||||
if ((not t) and ((lc<=80) or (WordWrap))) then begin { Wenn kein Tag und Ausgegebene Zeichen noch nicht 80 }
|
||||
Write(si); { mom. Zeichen ausgeben }
|
||||
Inc(lc); { Ausgegebene Zeichen += 1 }
|
||||
end else if ((ViewTags) and ((lc<=80) or (WordWrap))) then begin { sonst, wenn Tags AN und Ausg. Z. noch nicht 80 }
|
||||
if ((not SwitchToNormal) and (nc<>0)) then TextColor(nc); { Wenn nicht SwitchToNormal und new color != 0, dann TC=nc }
|
||||
Write(si); { mom. Zeichen ausgeben }
|
||||
Inc(lc); { Ausgegebene Zeichen += 1 }
|
||||
end;
|
||||
if ((si='>') or (Mid(Temp,i-3,3)='!--')) then begin { Wenn Zeichen == '>' oder die letzten 3 == '!--' }
|
||||
t := false; { Nein, es ist kein Tag mehr }
|
||||
if nc<>0 then TextColor(nc); { Wenn new color != 0, dann TC=nc }
|
||||
if SwitchToNormal then begin { Wenn SwitchToNormal }
|
||||
SwitchToNormal := false; { Nee, kein SwitchToNormal mehr, einmal reicht }
|
||||
TextColor(Color_Normal); { Textfarbe auf Normal }
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if WhereX<>1 then for i:=WhereX to 80 do Write(' '); { Rest der Zeile mit Leerzeichen auff<66>llen }
|
||||
end;
|
||||
|
||||
procedure RebuildScreen; { Schreibt den Bildschirm neu - OHNE CLRSCR }
|
||||
var i,j: integer;
|
||||
begin
|
||||
window(1,2,80,25);
|
||||
TextBackground(1);
|
||||
TextColor(11);
|
||||
GotoXY(1,1);
|
||||
for i:=1 to 23 do begin
|
||||
if Screen[i]<>'' then WriteLine(Screen[i]);
|
||||
end;
|
||||
for i:=WhereY to 23 do for j:=1 to 80 do Write(' ');
|
||||
window(1,1,80,25);
|
||||
end;
|
||||
|
||||
procedure ShowData; { Liest Datei ein }
|
||||
var Temp: string;
|
||||
i: integer;
|
||||
begin
|
||||
window(1,2,80,24);
|
||||
TextColor(11);
|
||||
TextBackground(1);
|
||||
while not Eof(HTMLFile) do begin
|
||||
ReadLn(HTMLFile,Temp);
|
||||
Inc(i);
|
||||
if i>23 then begin
|
||||
ShiftScreen;
|
||||
Screen[23]:=Temp;
|
||||
end;
|
||||
WriteLine(Temp);
|
||||
end;
|
||||
window(1,1,80,25);
|
||||
end;
|
||||
|
||||
procedure WaitForInput; { Wartet auf Eingabe und f<>hrt je nach Taste verschiedene Operationen aus }
|
||||
label ExitWFI, Again;
|
||||
begin
|
||||
Again:
|
||||
IK := ReadKey;
|
||||
case IK of
|
||||
#000: begin { Funktionstaste oder Sondertaste erwischt! }
|
||||
IK := ReadKey;
|
||||
case IK of
|
||||
#059: ShowAbout; { F1 }
|
||||
#060: if ViewTags then ViewTags := false else ViewTags := true; { F2 }
|
||||
#061: if ShowCols then ShowCols := false else ShowCols := true; { F3 }
|
||||
#062: if WordWrap then WordWrap := false else WordWrap := true; { F4 }
|
||||
#063: if ConvEntit then ConvEntit := false else ConvEntit := true; { F5 }
|
||||
#068: goto ExitWFI; { F10 }
|
||||
end;
|
||||
end;
|
||||
#027: goto ExitWFI; { ESC }
|
||||
else Sound(1200); Delay(100); NoSound; { andere Taste }
|
||||
end;
|
||||
UpdateStatus;
|
||||
RebuildScreen;
|
||||
goto Again;
|
||||
ExitWFI:
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount=0 then About;
|
||||
OpenHTML; { Datei ”ffnen }
|
||||
SetPrefs; { Voreinstellungen setzen }
|
||||
MakeScreen; { Bildschirm aufbauen }
|
||||
UpdateStatus; { Statuszeile aufbauen }
|
||||
CursorOff; { Weg mit dem Blinker }
|
||||
ShowData; { Daten anzeigen }
|
||||
WaitForInput; { Auf Taste warten }
|
||||
Close(HTMLFile); { Datei schlieáen }
|
||||
window(1,1,80,25); { WINDOW wieder setzen }
|
||||
TextColor(7); { Alte DOS-Farben }
|
||||
TextBackground(0); { wiederherstellen }
|
||||
ClrScr; { Bildschirm nochmal l”schen - LETZTE ™LUNG }
|
||||
CursorOn; { Und Cursor wieder rumblinken lassen - Elektro Schocks}
|
||||
end.
|
||||
120
INIFILET.PAS
Normal file
120
INIFILET.PAS
Normal file
@ -0,0 +1,120 @@
|
||||
program INIFile_Test;
|
||||
|
||||
uses Crt, INIFile;
|
||||
|
||||
const Heading=15;
|
||||
Struct =9;
|
||||
Files =11+blink;
|
||||
Descr =10;
|
||||
Values =14;
|
||||
Quest =10;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
INIFileDebug := False;
|
||||
OpenINI('C:\WINNT\SYSTEM.INI');
|
||||
TextColor(Struct); Write('þ ');
|
||||
TextColor(Heading);
|
||||
WriteLn('Einige Informationen <20>ber Ihre FENSTER ....');
|
||||
TextColor(Struct); WriteLn('³'); Write('ÃÄþ ');
|
||||
TextColor(Files);
|
||||
WriteLn('SYSTEM.INI');
|
||||
|
||||
{ Computer-Typ }
|
||||
TextColor(Struct); Write('³ ÃÄÄ ');
|
||||
TextColor(Descr); Write('Computer-Typ: ');
|
||||
TextColor(Values); WriteLn(INIGet('boot.description','system.drv'));
|
||||
|
||||
{ Maus }
|
||||
TextColor(Struct); Write('³ ÃÄÄ ');
|
||||
TextColor(Descr); Write('Maus : ');
|
||||
TextColor(Values); WriteLn(INIGet('boot.description','mouse.drv'));
|
||||
|
||||
{ Grafikkarte }
|
||||
TextColor(Struct); Write('³ ÃÄÄ ');
|
||||
TextColor(Descr); Write('Grafikkarte : ');
|
||||
TextColor(Values); WriteLn(INIGet('boot.description','display.drv'));
|
||||
|
||||
{ Tastatur }
|
||||
TextColor(Struct); Write('³ ÀÄÄ ');
|
||||
TextColor(Descr); Write('Tastatur : ');
|
||||
TextColor(Values); WriteLn(INIGet('boot.description','keyboard.typ'));
|
||||
|
||||
CloseINI;
|
||||
OpenINI('C:\WINNT\WIN.INI');
|
||||
TextColor(Struct); Write('ÃÄþ ');
|
||||
TextColor(Files);
|
||||
WriteLn('WIN.INI');
|
||||
|
||||
{ Land }
|
||||
TextColor(Struct); Write('³ ÃÄÄ ');
|
||||
TextColor(Descr); Write('Land : ');
|
||||
TextColor(Values); WriteLn(INIGet('intl','sCountry'));
|
||||
|
||||
{ W„hrung }
|
||||
TextColor(Struct); Write('³ ÃÄÄ ');
|
||||
TextColor(Descr); Write('W„hrung : ');
|
||||
TextColor(Values); WriteLn(INIGet('intl','sCurrency'));
|
||||
|
||||
{ Standard-Drucker }
|
||||
TextColor(Struct); Write('³ ÃÄÄ ');
|
||||
TextColor(Descr); Write('Std.-Drucker: ');
|
||||
TextColor(Values); WriteLn(INIGet('windows','device'));
|
||||
|
||||
{ Hintergrund-Bild }
|
||||
TextColor(Struct); Write('³ ÀÄÄ ');
|
||||
TextColor(Descr); Write('HG-Bild : ');
|
||||
TextColor(Values); WriteLn(INIGet('Desktop','Wallpaper'));
|
||||
|
||||
CloseINI;
|
||||
OpenINI('C:\WINDOWS\SYSTEM\OEMINFO.INI');
|
||||
TextColor(Struct); Write('ÀÄþ ');
|
||||
TextColor(Files);
|
||||
WriteLn('OEMINFO.INI');
|
||||
|
||||
{ Computer-Modell }
|
||||
TextColor(Struct); Write(' ÃÄÄ ');
|
||||
TextColor(Descr); Write('Computer-Typ: ');
|
||||
TextColor(Values); WriteLn(INIGet('general','Model'));
|
||||
|
||||
{ Hersteller }
|
||||
TextColor(Struct); Write(' ÃÄÄ ');
|
||||
TextColor(Descr); Write('Hersteller : ');
|
||||
TextColor(Values); WriteLn(INIGet('general','Manufacturer'));
|
||||
|
||||
{ Support Informationen }
|
||||
TextColor(Struct); Write(' ÀÄþ ');
|
||||
TextColor(Files); WriteLn('Support Informationen');
|
||||
|
||||
TextColor(Struct); Write(' ÃÄÄ ');
|
||||
TextColor(Descr); Write('Zeile1: ');
|
||||
TextColor(Values); WriteLn(Copy(INIGet('Support Information','Line1'),1,63));
|
||||
|
||||
TextColor(Struct); Write(' ÃÄÄ ');
|
||||
TextColor(Descr); Write('Zeile2: ');
|
||||
TextColor(Values); WriteLn(Copy(INIGet('Support Information','Line2'),1,63));
|
||||
|
||||
TextColor(Struct); Write(' ÃÄÄ ');
|
||||
TextColor(Descr); Write('Zeile3: ');
|
||||
TextColor(Values); WriteLn(Copy(INIGet('Support Information','Line3'),1,63));
|
||||
|
||||
TextColor(Struct); Write(' ÃÄÄ ');
|
||||
TextColor(Descr); Write('Zeile4: ');
|
||||
TextColor(Values); WriteLn(Copy(INIGet('Support Information','Line4'),1,63));
|
||||
|
||||
TextColor(Struct); Write(' ÃÄÄ ');
|
||||
TextColor(Descr); Write('Zeile5: ');
|
||||
TextColor(Values); WriteLn(Copy(INIGet('Support Information','Line5'),1,63));
|
||||
|
||||
TextColor(Struct); Write(' ÀÄÄ ');
|
||||
TextColor(Descr); Write('Zeile6: ');
|
||||
TextColor(Values); WriteLn(Copy(INIGet('Support Information','Line6'),1,63));
|
||||
|
||||
CloseINI;
|
||||
WriteLn;
|
||||
TextColor(Quest);
|
||||
Write('Bitte Taste dr<64>cken .... ');
|
||||
ReadKey;
|
||||
WriteLn('danke!');
|
||||
TextColor(7);
|
||||
end.
|
||||
53
ITG/AUGENZ.PAS
Normal file
53
ITG/AUGENZ.PAS
Normal file
@ -0,0 +1,53 @@
|
||||
program Augensumme;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const p: char='|';
|
||||
|
||||
var A: array[1..12] of longint;
|
||||
n: longint;
|
||||
|
||||
procedure Progress;
|
||||
begin
|
||||
case p of
|
||||
'|': p:='/';
|
||||
'/': p:='-';
|
||||
'-': p:='\';
|
||||
'\': p:='|';
|
||||
end;
|
||||
GotoXY(WhereX-1,WhereY);
|
||||
Write(p);
|
||||
end;
|
||||
|
||||
procedure Calc;
|
||||
var x: byte;
|
||||
begin
|
||||
x := Random(6)+Random(6)+2;
|
||||
Inc(A[x]);
|
||||
Inc(A[1]);
|
||||
end;
|
||||
|
||||
procedure Auswertung;
|
||||
var x: byte;
|
||||
begin
|
||||
for x:=2 to 12 do begin
|
||||
WriteLn(x:2,' Augen: ',A[x]:7,' Treffer = ',(A[x]/A[1])*100:6:2,'%');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
WriteLn('<====*====>');
|
||||
Write('Dr<44>cken Sie eine Taste, um den Versuch zu beenden. ');
|
||||
repeat
|
||||
Calc;
|
||||
if A[1]/50000=A[1] DIV 50000 then Progress;
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
GotoXY(WhereX-1,WhereY); WriteLn(' ');
|
||||
WriteLn;
|
||||
Auswertung;
|
||||
WriteLn;
|
||||
WriteLn('Bitte eine Taste dr<64>cken');
|
||||
ReadKey;
|
||||
end.
|
||||
76
ITG/AUSFLUG.PAS
Normal file
76
ITG/AUSFLUG.PAS
Normal file
@ -0,0 +1,76 @@
|
||||
program Bahnausflug;
|
||||
|
||||
{ Ein Club plant einen Ausflug mit einer Privatbahn. Dort kostet ein
|
||||
Tarifkilometer 20 Pf und bei Gruppenreisen hat jeder 6. Reisende eine
|
||||
Freifahrt. Es ist ein Programm zu schreiben, daá die Fahrtkosten pro
|
||||
Person f<>r eine beliebige Anzahl von Reisenden und Kilometern ermittelt,
|
||||
wobei die Gesamtkosten auf alle Teilnehmer gleichm„áig umgelegt werden. }
|
||||
|
||||
uses Crt,VFx;
|
||||
|
||||
const money=0.20;
|
||||
|
||||
var people,km: longint;
|
||||
|
||||
|
||||
procedure Init;
|
||||
var mon: string;
|
||||
begin
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
DrawBorder(40,12,15,1,5);
|
||||
FXWriteC('-=ð+ Bahnkostenberechnung +ð=-',14);
|
||||
WriteLn;
|
||||
TextColor(10);
|
||||
Str(money:0:2,mon);
|
||||
WriteCLn('Der Preis pro Tarifkilometer betr„gt '+mon+' DM.');
|
||||
TextColor(11);
|
||||
WriteLn;
|
||||
ReadyBeep;
|
||||
end;
|
||||
|
||||
procedure GetData;
|
||||
begin
|
||||
Write('Okay, wieviel Leutchens sollen''s denn werden? ');
|
||||
ReadLn(people);
|
||||
AckBeep;
|
||||
if people=1 then Write('Und wieviel Kilometer will diese Person fahren? ')
|
||||
else Write('Und wieviel Kilometer wollen diese ',people,' Personen fahren? ');
|
||||
ReadLn(km);
|
||||
WriteLn;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure PrintData;
|
||||
var freepeople,restpeople: longint;
|
||||
geldges,geldpro: extended;
|
||||
begin
|
||||
TextColor(15);
|
||||
freepeople := people div 6;
|
||||
case freepeople of
|
||||
0: CWriteLn('Es f„hrt niemand kostenlos! %%12#(NICHTS IST UMSONST!!)%%15#');
|
||||
1: WriteLn('Es f„hrt eine Person kostenlos.');
|
||||
else
|
||||
WriteLn('Es fahren ',freepeople:0,' Personen kostenlos.');
|
||||
end;
|
||||
restpeople := people - freepeople;
|
||||
if restpeople=1 then Write('Und diese eine Person muá ')
|
||||
else Write('Und ',restpeople,' der ',people,' Personen m<>ssen insgesamt ');
|
||||
geldges := restpeople * km * money;
|
||||
WriteLn(geldges:0:2,' DM hinbl„ttern.');
|
||||
geldpro := km * money;
|
||||
if restpeople>1 then WriteLn('Das heiát, jeder muá ',geldpro:0:2,' DM hinlegen.');
|
||||
WriteLn;
|
||||
TextColor(7);
|
||||
WriteLn('Vielen Dank, daá Sie dieses Program benutzt haben.');
|
||||
WaitBeep;
|
||||
WriteLn;
|
||||
CWriteLn('%%142#=== Dr<44>cken Sie eine Taste! ===%%7#');
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
GetData;
|
||||
PrintData;
|
||||
end.
|
||||
24
ITG/BINSRCH.PAS
Normal file
24
ITG/BINSRCH.PAS
Normal file
@ -0,0 +1,24 @@
|
||||
function bin_searchrekursiv(left, right, key: word): word;
|
||||
var x: word;
|
||||
begin
|
||||
if left>right then bin_searchrekursiv:=0
|
||||
else begin
|
||||
x := (left+right) DIV 2;
|
||||
if key < F[x] then bin_searchrekursiv(left, x-1, key)
|
||||
else if key > F[x] then bin_searchrekursiv(x+1,right, key)
|
||||
else bin_searchrekursiv := x;
|
||||
end;
|
||||
end;
|
||||
|
||||
function bin_searchiterativ(key: word): word;
|
||||
var left, right, x: word;
|
||||
begin
|
||||
left := 1;
|
||||
right := max;
|
||||
repeat
|
||||
x := (left + right) DIV 2;
|
||||
if key<F[x] then right := x-1 else left := x+1;
|
||||
until (key=F[x]) OR (left>right);
|
||||
if key=F[x] then bin_searchiterativ := x;
|
||||
else bin_searchiterativ := 0;
|
||||
end;
|
||||
66
ITG/CODING.PAS
Normal file
66
ITG/CODING.PAS
Normal file
@ -0,0 +1,66 @@
|
||||
program Coding;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const satz='ICH BIN HIER UND DU BIST DA! NUN BIN ICH DA UND DU BIST HIER. BLI BLA BLO BL™™ ';
|
||||
|
||||
var A: array[1..40,1..40] of char;
|
||||
|
||||
|
||||
procedure Init;
|
||||
var i,j: byte;
|
||||
begin
|
||||
TextMode(co80+Font8x8);
|
||||
for i:=1 to 40 do begin
|
||||
for j:=1 to 40 do begin
|
||||
A[i,j] := ' ';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Ausgabe;
|
||||
var i,j: byte;
|
||||
begin
|
||||
for i:=1 to 40 do begin
|
||||
for j:=1 to 40 do begin
|
||||
GotoXY(j,i);
|
||||
Write(A[j,i]);
|
||||
end;
|
||||
end;
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
procedure Code(x: string);
|
||||
var i,j: byte;
|
||||
begin
|
||||
Randomize;
|
||||
for j:=1 to 40 do begin
|
||||
A[j,j] := x[j];
|
||||
A[41-j,j] := x[40+j];
|
||||
end;
|
||||
for i:=1 to 40 do begin
|
||||
for j:=1 to 40 do begin
|
||||
if A[i,j]=' ' then A[i,j]:=Chr(65+Random(26));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Decode;
|
||||
var i: byte;
|
||||
begin
|
||||
ClrScr;
|
||||
for i:=1 to 40 do begin
|
||||
GotoXY(i,1);
|
||||
Write(A[i,i]);
|
||||
GotoXY(40+i,1);
|
||||
Write(A[41-i,i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
Ausgabe;
|
||||
Code(satz);
|
||||
Ausgabe;
|
||||
Decode;
|
||||
end.
|
||||
402
ITG/DISTANCE.PAS
Normal file
402
ITG/DISTANCE.PAS
Normal file
@ -0,0 +1,402 @@
|
||||
program Distances; { Autor: Markus Birth <mbirth@webwriters.de> }
|
||||
|
||||
uses Crt, Graph, GUI;
|
||||
|
||||
type ttabelle = array[1..10,1..10] of word;
|
||||
cityrec = record
|
||||
x: integer;
|
||||
y: integer;
|
||||
n: string[20];
|
||||
end;
|
||||
xyrec = record
|
||||
x: integer;
|
||||
y: integer;
|
||||
end;
|
||||
|
||||
const tabelle: ttabelle=(( 0,530,555,289,378,370,569,584,616,596),
|
||||
(530, 0,249,385,207,478, 68,638,700,513),
|
||||
(555,249, 0,495,193,588,189,395,457,294),
|
||||
(289,385,495, 0,307, 93,422,782,844,777),
|
||||
(378,207,193,307, 0,400,249,482,544,475),
|
||||
(370,478,588, 93,400, 0,515,875,937,870),
|
||||
(569, 68,189,422,249,515, 0,578,640,453),
|
||||
(584,638,395,782,482,875,578, 0,179,139),
|
||||
(616,700,457,844,544,937,640,179, 0,310),
|
||||
(596,513,294,777,475,870,453,139,310, 0));
|
||||
|
||||
map: array[1..52] of xyrec=((x:33;y: 4),(x:36;y: 5),(x:37;y: 5),
|
||||
(x:38;y: 7),(x:40;y: 7),(x:41;y: 8),
|
||||
(x:37;y:13),(x:41;y:14),(x:41;y:22),
|
||||
(x:42;y:23),(x:41;y:24),(x:40;y:24),
|
||||
(x:30;y:29),(x:33;y:33),(x:38;y:37),
|
||||
(x:38;y:40),(x:35;y:42),(x:37;y:46),
|
||||
(x:32;y:45),(x:27;y:46),(x:22;y:46),
|
||||
(x:21;y:47),(x:16;y:45),(x:10;y:47),
|
||||
(x: 8;y:46),(x: 9;y:40),(x:12;y:38),
|
||||
(x: 3;y:33),(x: 2;y:30),(x: 4;y:28),
|
||||
(x: 1;y:25),(x: 3;y:21),(x: 2;y:19),
|
||||
(x: 4;y:18),(x: 7;y:15),(x: 5;y:14),
|
||||
(x: 7;y:11),(x: 6;y: 9),(x: 8;y: 8),
|
||||
(x: 9;y: 7),(x:12;y: 7),(x:14;y: 8),
|
||||
(x:15;y: 6),(x:17;y: 6),(x:18;y: 1),
|
||||
(x:22;y: 2),(x:23;y: 7),(x:28;y: 6),
|
||||
(x:27;y: 8),(x:28;y:10),(x:31;y: 6),
|
||||
(x:33;y: 4));
|
||||
mapfact: xyrec = (x:7;y:7);
|
||||
citycount: byte=10;
|
||||
city: array[1..10] of cityrec=((x:36;y:16;n:'Berlin'),
|
||||
(x: 7;y:23;n:'Essen'),
|
||||
(x:15;y:31;n:'Frankfurt am Main'),
|
||||
(x:23;y:12;n:'Hamburg'),
|
||||
(x:18;y:22;n:'Kassel'),
|
||||
(x:24;y: 9;n:'Kiel'),
|
||||
(x: 8;y:27;n:'K”ln'),
|
||||
(x:27;y:43;n:'M<>nchen'),
|
||||
(x:36;y:40;n:'Passau'),
|
||||
(x:20;y:41;n:'Ulm'));
|
||||
desktopcolor=3;
|
||||
|
||||
var xmax, ymax, xmed, ymed: word;
|
||||
cityrp: array[1..10] of xyrec;
|
||||
WP: array[1..50] of byte;
|
||||
WPuptodate: boolean;
|
||||
buttondown: boolean;
|
||||
|
||||
{ V2S(x) - Liefert angegebenen Word-Wert als String mit 3 Stellen
|
||||
Input: word
|
||||
Output: string }
|
||||
function V2S(x: word): string;
|
||||
var tmp: string;
|
||||
begin
|
||||
Str(x:3,tmp);
|
||||
V2S := tmp;
|
||||
end;
|
||||
|
||||
{ Dist(c1,c2) - Liefert Entfernung zwischen St„dteindizes c1 und c2
|
||||
Input: byte, byte
|
||||
Output: integer }
|
||||
function Dist(wp1,wp2: byte): integer;
|
||||
begin
|
||||
Dist := tabelle[wp1,wp2];
|
||||
end;
|
||||
|
||||
{ WPmax - Liefert Index des letzten Wegpunktes im WP-Array
|
||||
Input: none
|
||||
Output: byte }
|
||||
function WPmax: byte;
|
||||
var i: byte;
|
||||
begin
|
||||
for i:=1 to 50 do if (WP[i]=255) then WPmax := i-1;
|
||||
end;
|
||||
|
||||
{ UpdateDist - Refreshed die Entfernungsanzeige
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure UpdateDist;
|
||||
var i: byte;
|
||||
dst: integer;
|
||||
dis: string;
|
||||
begin
|
||||
dst := 0;
|
||||
if (WPmax>1) then for i:=1 to WPmax-1 do begin
|
||||
dst := dst + Dist(WP[i],WP[i+1]);
|
||||
end;
|
||||
SetFillStyle(SolidFill,7);
|
||||
SetColor(0);
|
||||
Bar(53,398,247,457);
|
||||
SetViewPort(53,398,247,457,ClipOn);
|
||||
SetTextStyle(TripleXFont,HorizDir,4);
|
||||
SetTextJustify(RightText,CenterText);
|
||||
Str(dst:4,dis);
|
||||
dis := dis + ' km';
|
||||
OutTextXY(187,17,dis);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
{ ShowGermany - Zeichnet/refreshed die Deutschlandkarte
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure ShowGermany;
|
||||
const xd=7;
|
||||
yd=22;
|
||||
var k,x,y: integer;
|
||||
begin
|
||||
Frame(8,26,312,362,0,0,7,1,false);
|
||||
SetColor(15);
|
||||
for k:=1 to 51 do line((map[k].x*mapfact.x)+xd,(map[k].y*mapfact.y)+yd,(map[k+1].x*mapfact.x)+xd,(map[k+1].y*mapfact.y)+yd);
|
||||
SetTextJustify(CenterText,TopText);
|
||||
SetTextStyle(SmallFont,HorizDir,4);
|
||||
for k:=1 to 10 do begin
|
||||
x:=city[k].x*mapfact.x+xd;
|
||||
y:=city[k].y*mapfact.y+yd;
|
||||
cityrp[k].x:=x;
|
||||
cityrp[k].y:=y;
|
||||
PutPixel(x,y,15);
|
||||
PutPixel(x+1,y,7);
|
||||
PutPixel(x-1,y,7);
|
||||
PutPixel(x,y-1,7);
|
||||
PutPixel(x,y+1,7);
|
||||
PutPixel(x-1,y-1,8);
|
||||
PutPixel(x-1,y+1,8);
|
||||
PutPixel(x+1,y-1,8);
|
||||
PutPixel(x+1,y+1,8);
|
||||
if (WP[1]=k) then SetColor(10)
|
||||
else if (WP[WPmax]=k) then SetColor(12)
|
||||
else SetColor(11);
|
||||
OutTextXY(x+2,y+2,city[k].n);
|
||||
if (WP[WPmax]=k) OR (WP[1]=k) then OutTextXY(x+3,y+2,city[k].n);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ UpdatePath - Refreshed die Weglinien
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure UpdatePath;
|
||||
var i: byte;
|
||||
begin
|
||||
ShowGermany;
|
||||
MoveTo(cityrp[WP[1]].x,cityrp[WP[1]].y);
|
||||
SetColor(9);
|
||||
for i:=2 to WPmax do begin
|
||||
if (i=WPmax) then SetColor(12);
|
||||
LineTo(cityrp[WP[i]].x,cityrp[WP[i]].y);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ UpdateWP - Refreshed die Wegpunkte-Liste
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure UpdateWP;
|
||||
var i: byte;
|
||||
begin
|
||||
if (NOT WPuptodate) then begin
|
||||
SetFillStyle(SolidFill,7);
|
||||
Bar(328,30,527,397);
|
||||
SetViewPort(328,30,527,397,ClipOn);
|
||||
SetColor(0);
|
||||
for i:=1 to WPmax do begin
|
||||
SetTextJustify(RightText,CenterText);
|
||||
SetTextStyle(SmallFont,HorizDir,4);
|
||||
OutTextXY(19,i*9-5,V2S(i)+'.');
|
||||
SetTextJustify(LeftText,CenterText);
|
||||
OutTextXY(20,i*9-5,city[WP[i]].n);
|
||||
OutTextXY(21,i*9-5,city[WP[i]].n);
|
||||
SetTextJustify(RightText,CenterText);
|
||||
SetTextStyle(SmallFont,HorizDir,4);
|
||||
if i>1 then begin
|
||||
OutTextXY(160,i*9-5,V2S(Dist(WP[i],WP[i-1])));
|
||||
end else begin
|
||||
OutTextXY(160,i*9-5,'---');
|
||||
end;
|
||||
Rectangle(167,i*9-8,192,i*9);
|
||||
SetTextStyle(SmallFont,HorizDir,2);
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
OutTextXY(179,i*9-5,'CLEAR');
|
||||
end;
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
UpdateDist;
|
||||
UpdatePath;
|
||||
WPuptodate := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ AddWP(x) - H„ngt Wegpunkt bei Stadt x an das WP-Array an
|
||||
Input: byte
|
||||
Output: none }
|
||||
procedure AddWP(what: byte);
|
||||
var wpm: byte;
|
||||
begin
|
||||
wpm := WPmax;
|
||||
if (wpm+1>1) then begin
|
||||
if (WP[wpm]<>what) then begin
|
||||
if (wpm<49) then begin
|
||||
WP[wpm+1] := what;
|
||||
WP[wpm+2] := 255;
|
||||
WPuptodate:=false;
|
||||
end else begin
|
||||
Sound(1200);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
end;
|
||||
end;
|
||||
end else begin
|
||||
WP[1] := what;
|
||||
WP[2] := 255;
|
||||
WPuptodate:=false;
|
||||
end;
|
||||
UpdateWP;
|
||||
end;
|
||||
|
||||
{ RemoveWP(x) - Entfernt den Wegpunkt mit Index x aus WP
|
||||
Input: byte
|
||||
Output: none }
|
||||
procedure RemoveWP(which: byte);
|
||||
var i: byte;
|
||||
begin
|
||||
for i:=which to 49 do WP[i] := WP[i+1];
|
||||
WPuptodate:=false;
|
||||
UpdateWP;
|
||||
end;
|
||||
|
||||
{ Init - Alles, was initialisiert werden muá, grundlegende Vardefs
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure Init;
|
||||
var grDriver, grMode: integer;
|
||||
BGIPath: string;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAHi;
|
||||
initp_del := 30;
|
||||
BGIPath := 'D:\BP\BGI\';
|
||||
InitGraph(grDriver, grMode, BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xmax DIV 2;
|
||||
ymed := ymax DIV 2;
|
||||
WP[1] := 255;
|
||||
WPuptodate := false;
|
||||
buttondown := false;
|
||||
om := 0;
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
SetTextJustify(LeftText,TopText);
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(0,0,xmax-1,ymax-1);
|
||||
ClearStatus;
|
||||
end;
|
||||
|
||||
{ Outit - Alles, um wieder auf Normalwerte zu kommen ...
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure Outit;
|
||||
var i,ad,wpm: integer;
|
||||
begin
|
||||
wpm := WPmax;
|
||||
TextMode(CO80);
|
||||
WriteLn('VMode : ',xmax,'x',ymax);
|
||||
WriteLn('Center: ',xmed,'x',ymed);
|
||||
WriteLn;
|
||||
if wpm>1 then begin
|
||||
ad := 0;
|
||||
Write('Strecke: ');
|
||||
for i:=1 to wpm do begin
|
||||
if (i>1) then Write(', ',city[WP[i]].n) else Write(city[WP[i]].n);
|
||||
if (i<wpm) then ad := ad + Dist(WP[i],WP[i+1]);
|
||||
end;
|
||||
WriteLn;
|
||||
WriteLn('Entfernung: ',ad,' km');
|
||||
WriteLn;
|
||||
end;
|
||||
Write('Programm beendet.');
|
||||
if (wpm>1) then WriteLn(' Viel Vergn<67>gen in ',city[WP[wpm]].n,'!') else WriteLn;
|
||||
end;
|
||||
|
||||
{ StartScreen - Zeichnet Anfangs-Logo und nach Tastendruck den Mainscreen
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure StartScreen;
|
||||
begin
|
||||
MakeWindow(120,140,520,340,'Entfernungstabelle');
|
||||
SetViewPort(123,161,517,337,ClipOn);
|
||||
SetColor(9);
|
||||
SetTextStyle(TripleXFont,HorizDir,10);
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
OutTextXY(200,24,'GUI');
|
||||
OutTextXY(200,26,'GUI');
|
||||
OutTextXY(199,25,'GUI');
|
||||
OutTextXY(201,25,'GUI');
|
||||
SetTextStyle(SansSerifFont,HorizDir,2);
|
||||
OutTextXY(200,100,'GRAPHICAL USER INTERFACE');
|
||||
SetColor(0);
|
||||
SetTextStyle(SmallFont,HorizDir,5);
|
||||
OutTextXY(200,165,'geschrieben von Markus Birth <mbirth@webwriters.de>');
|
||||
SetTextStyle(SmallFont,VertDir,4);
|
||||
SetTextJustify(CenterText,TopText);
|
||||
SetColor(8);
|
||||
OutTextXY(385,2,'(c)1999 Web - Writers');
|
||||
SetColor(0);
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
OutTextXY(200,140,'Initialisiere Farbpalette ...');
|
||||
Delay(1000);
|
||||
InitPalette;
|
||||
SetFillStyle(SolidFill,7);
|
||||
Bar(0,130,400,150);
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
Status('Bitte dr<64>cken Sie irgendeine Taste (Maus oder Tastatur)');
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
StatusTime(false);
|
||||
until (keypressed) OR (mb<>0);
|
||||
if keypressed then ReadKey;
|
||||
ShowMouse(false);
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(120,140,520,340);
|
||||
ClearStatus;
|
||||
SetTextStyle(SmallFont,HorizDir,4);
|
||||
SetColor(15);
|
||||
OutTextXY(570,440,'Beenden durch Dr<44>cken');
|
||||
OutTextXY(570,448,'einer Taste oder beider');
|
||||
OutTextXY(570,456,'Maustasten gleichzeitig.');
|
||||
MakeWindow(325,5,530,400,'Wegpunkte');
|
||||
MakeWindow(50,370,250,460,'Entfernung');
|
||||
MakeWindow(5,5,315,365,'Deutschlandkarte');
|
||||
end;
|
||||
|
||||
{ CheckMouse - šberpr<70>fung der Mausposition und evtl. Subroutinen-Ausf<73>hrung
|
||||
Input: none
|
||||
Output: none }
|
||||
procedure CheckMouse;
|
||||
var i: byte;
|
||||
over: boolean;
|
||||
nst: string;
|
||||
begin
|
||||
if (mb<>0) then begin
|
||||
if (NOT buttondown) then ShowMouse(false);
|
||||
end else buttondown:=false;
|
||||
over := false;
|
||||
(* if (mb=0) then Status('X:'+V2S(mx)+' Y:'+V2S(my)); *)
|
||||
for i:=1 to 10 do begin
|
||||
if MouseOver(cityrp[i].x-5,cityrp[i].y-5,cityrp[i].x+5,cityrp[i].y+5) then begin
|
||||
nst:=city[i].n+' (Klicken, um in Wegliste einzuf<75>gen)';
|
||||
if (oldstat<>nst) then Status(nst);
|
||||
over := true;
|
||||
if (mb=1) AND (NOT buttondown) then begin
|
||||
AddWP(i);
|
||||
buttondown:=true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
for i:=1 to WPmax do begin
|
||||
if MouseOver(495,22+i*9,520,30+i*9) then begin
|
||||
nst:='Klicken, um '+city[WP[i]].n+' aus der Wegliste zu entfernen';
|
||||
if (oldstat<>nst) then Status(nst);
|
||||
over := true;
|
||||
if (mb=1) AND (NOT buttondown) then begin
|
||||
RemoveWP(i);
|
||||
buttondown:=true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (NOT over) AND (oldstat<>'') then begin
|
||||
ClearStatus;
|
||||
oldstat:='';
|
||||
end;
|
||||
if (mb<>0) then ShowMouse(true);
|
||||
end;
|
||||
|
||||
begin
|
||||
Mousereset;
|
||||
Init;
|
||||
StartScreen;
|
||||
ShowGermany;
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
CheckMouse;
|
||||
until (keypressed) OR (mb=3);
|
||||
if (keypressed) then ReadKey;
|
||||
FadeOut;
|
||||
Outit;
|
||||
end.
|
||||
64
ITG/DREIECK.PAS
Normal file
64
ITG/DREIECK.PAS
Normal file
@ -0,0 +1,64 @@
|
||||
program Dreiecke;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var a,b,c: real;
|
||||
|
||||
procedure GetData;
|
||||
begin
|
||||
Write('Geben Sie die L„nge der Seite a ein: '); ReadLn(a);
|
||||
Write('Und nun Seite b: '); ReadLn(b);
|
||||
Write('Und jetzt noch c: '); ReadLn(c);
|
||||
WriteLn('Danke!');
|
||||
end;
|
||||
|
||||
function ProoveANG(x,y,z: real): boolean;
|
||||
var j,k: real;
|
||||
begin
|
||||
j := Sqr(x);
|
||||
k := Sqr(y);
|
||||
if j+k>Sqr(z) then ProoveANG:=true else ProoveANG:=false;
|
||||
end;
|
||||
|
||||
function ProovePYT(x,y,z: real): boolean;
|
||||
var j,k: real;
|
||||
begin
|
||||
j := Sqr(x);
|
||||
k := Sqr(y);
|
||||
if j+k=Sqr(z) then ProovePYT:=true else ProovePYT:=false;
|
||||
end;
|
||||
|
||||
function Gleichseitig: boolean;
|
||||
begin
|
||||
if ((a=b) AND (b=c)) then Gleichseitig:=true else Gleichseitig:=false;
|
||||
end;
|
||||
|
||||
function Gleichschenklig: boolean;
|
||||
begin
|
||||
if ((a=b) OR (b=c) OR (a=c)) then Gleichschenklig:=true else Gleichschenklig:=false;
|
||||
end;
|
||||
|
||||
function Rechtwinklig: boolean;
|
||||
begin
|
||||
if ((ProovePYT(a,b,c)) OR (ProovePYT(b,c,a)) OR (ProovePYT(a,c,b))) then Rechtwinklig:=true
|
||||
else Rechtwinklig:=false;
|
||||
end;
|
||||
|
||||
function Spitzwinklig: boolean;
|
||||
begin
|
||||
if ((ProoveANG(a,b,c)) AND (ProoveANG(b,c,a)) AND (ProoveANG(a,c,b))) then Spitzwinklig:=true
|
||||
else Spitzwinklig:=false;
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
GetData;
|
||||
WriteLn;
|
||||
if Gleichseitig then WriteLn('Das Teil ist gleichseitig!');
|
||||
if Gleichschenklig then WriteLn('Das Ding ist gleichschenklich!!');
|
||||
if Rechtwinklig then WriteLn('Und rechtwinklig ist es auch noch!');
|
||||
if Spitzwinklig then WriteLn('Spitzwinklig ist es! Ja, Spitzwinklig!');
|
||||
WriteLn;
|
||||
WriteLn('Ich habe dem nix hinzuzuf<75>gen!');
|
||||
WriteLn('Fertich, Meister!');
|
||||
end.
|
||||
175
ITG/EXPLODER.PAS
Normal file
175
ITG/EXPLODER.PAS
Normal file
@ -0,0 +1,175 @@
|
||||
program Exploder;
|
||||
|
||||
{
|
||||
#016 > filled
|
||||
#017 < filled
|
||||
|
||||
}
|
||||
|
||||
uses Crt, DOS, Numbers, VFx;
|
||||
|
||||
const StartPath='.\';
|
||||
|
||||
var cur: SearchRec;
|
||||
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
TextMode(co80 + Font8x8);
|
||||
TextBackground(0);
|
||||
TextColor(7);
|
||||
end;
|
||||
|
||||
procedure SWindow(x1,y1,x2,y2: integer; fg, bg: byte; BType: byte);
|
||||
var i,j: integer;
|
||||
Border: string[8];
|
||||
begin
|
||||
if BType=1 then Border := 'Ú¿ÀÙ³³ÄÄ';
|
||||
if BType=2 then Border := 'ɻȼººÍÍ';
|
||||
if BType=3 then Border := 'Õ¸Ô¾³³ÍÍ';
|
||||
if BType=4 then Border := 'Ö·Ó½ººÄÄ';
|
||||
if BType=5 then Border := 'ÛÛÛÛÛÛßÜ';
|
||||
if BType=6 then Border := 'Ú·Ô¼³ºÄÍ';
|
||||
DWrite(x1,y1,fg,bg,Border[1]);
|
||||
DWrite(x2,y1,fg,bg,Border[2]);
|
||||
DWrite(x1,y2,fg,bg,Border[3]);
|
||||
DWrite(x2,y2,fg,bg,Border[4]);
|
||||
for i:=y1+1 to y2-1 do begin
|
||||
DWrite(x1,i,fg,bg,Border[5]);
|
||||
DWrite(x2,i,fg,bg,Border[6]);
|
||||
end;
|
||||
for i:=x1+1 to x2-1 do begin
|
||||
DWrite(i,y1,fg,bg,Border[7]);
|
||||
DWrite(i,y2,fg,bg,Border[8]);
|
||||
end;
|
||||
for i:=x1+1 to x2-1 do
|
||||
for j:=y1+1 to y2-1 do begin
|
||||
DWrite(i,j,fg,bg,' ');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TurnAround(var x: string);
|
||||
var i: integer;
|
||||
tmp: string;
|
||||
begin
|
||||
tmp := '';
|
||||
for i:=Length(x) downto 1 do begin
|
||||
tmp := tmp + x[i];
|
||||
end;
|
||||
x := tmp;
|
||||
end;
|
||||
|
||||
function GetName(x: string): string;
|
||||
var i: byte;
|
||||
it: boolean;
|
||||
begin
|
||||
it := false;
|
||||
if (x[1]='.') then begin
|
||||
GetName:=x;
|
||||
Exit;
|
||||
end;
|
||||
for i:=1 to Length(x) do
|
||||
if x[i]='.' then begin
|
||||
GetName := Copy(x,1,i-1);
|
||||
it := true;
|
||||
end;
|
||||
if NOT it then GetName := x;
|
||||
end;
|
||||
|
||||
function GetExt(x: string): string;
|
||||
var i: byte;
|
||||
it: boolean;
|
||||
begin
|
||||
it := false;
|
||||
for i:=1 to Length(x) do
|
||||
if x[i]='.' then begin
|
||||
GetExt := Copy(x,i+1,Length(x)-i);
|
||||
it := true;
|
||||
end;
|
||||
if NOT it then GetExt := '';
|
||||
end;
|
||||
|
||||
|
||||
function Fill(x: string): string;
|
||||
var i: byte;
|
||||
tmp: string;
|
||||
begin
|
||||
tmp := '';
|
||||
for i:=Length(GetName(x))+1 to 8 do tmp := tmp + ' ';
|
||||
Fill := tmp;
|
||||
end;
|
||||
|
||||
function Fill2(x: string): string;
|
||||
var i: byte;
|
||||
tmp: string;
|
||||
begin
|
||||
tmp := '';
|
||||
for i:=Length(GetExt(x))+1 to 3 do tmp := tmp + ' ';
|
||||
Fill2 := tmp;
|
||||
end;
|
||||
|
||||
|
||||
{ Attribute list in binary
|
||||
|
||||
1st ReadOnly
|
||||
2nd Hidden
|
||||
3rd System
|
||||
4th VolumeID
|
||||
5th Directory
|
||||
6th Archive
|
||||
7th AnyFile }
|
||||
|
||||
procedure Add(var x: string; y: string);
|
||||
begin
|
||||
x := x + y;
|
||||
end;
|
||||
|
||||
procedure WriteFile(f: SearchRec); forward;
|
||||
|
||||
procedure List;
|
||||
var binattr: string;
|
||||
strattr: string;
|
||||
begin
|
||||
{ ChDir(StartPath); }
|
||||
FindFirst('*.*',AnyFile,cur);
|
||||
while DosError<>18 do begin
|
||||
binattr := Dec2Bin(cur.attr);
|
||||
TurnAround(binattr);
|
||||
if (binattr[5]='1') then TextColor(15)
|
||||
else if (binattr[2]='1') then TextColor(8)
|
||||
else if (binattr[3]='1') then TextColor(12)
|
||||
else if (binattr[1]='1') then TextColor(10)
|
||||
else if (binattr[4]='1') then TextColor(11)
|
||||
else TextColor(7);
|
||||
WriteFile(cur);
|
||||
WriteLn;
|
||||
FindNext(cur);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteFile(f: SearchRec);
|
||||
var binattr: string;
|
||||
strattr: string;
|
||||
begin
|
||||
binattr := Dec2Bin(cur.attr);
|
||||
TurnAround(binattr);
|
||||
strattr := '';
|
||||
if (binattr[5]='1') then Add(strattr,'D') else
|
||||
if (binattr[4]='1') then Add(strattr,'V') else Add(strattr,'-');
|
||||
if (binattr[6]='1') then Add(strattr,'A') else Add(strattr,'-');
|
||||
if (binattr[1]='1') then Add(strattr,'R') else Add(strattr,'-');
|
||||
if (binattr[2]='1') then Add(strattr,'H') else Add(strattr,'-');
|
||||
if (binattr[3]='1') then Add(strattr,'S') else Add(strattr,'-');
|
||||
|
||||
Write(GetName(cur.name),Fill(cur.name),' ',GetExt(cur.name),Fill2(cur.name),'³');
|
||||
if (binattr[5]='1') then Write(#017,' DIR ',#016) else
|
||||
if (binattr[4]='1') then Write(#017,' VOL ',#016) else Write(cur.size:7);
|
||||
Write('³',strattr);
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
SWindow(1,1,80,50,15,1,2);
|
||||
Window(3,2,78,49);
|
||||
List;
|
||||
end.
|
||||
27
ITG/FAKULT.PAS
Normal file
27
ITG/FAKULT.PAS
Normal file
@ -0,0 +1,27 @@
|
||||
program Fuck_ultaet;
|
||||
|
||||
var which: integer;
|
||||
|
||||
function Fak_Ite(m: integer): longint;
|
||||
var i: integer;
|
||||
tmp: longint;
|
||||
begin
|
||||
tmp := 1;
|
||||
for i:=1 to m do begin
|
||||
tmp := tmp * i;
|
||||
end;
|
||||
Fak_Ite := tmp;
|
||||
end;
|
||||
|
||||
function Fak_Rek(m: integer): longint;
|
||||
begin
|
||||
if m=1 then Fak_Rek := 1 else Fak_Rek := m * Fak_Rek(m-1);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
WriteLn('======================');
|
||||
Write('Enter n: '); ReadLn(which);
|
||||
WriteLn('Iterative: ',Fak_Ite(which));
|
||||
WriteLn('Recursive: ',Fak_Rek(which));
|
||||
end.
|
||||
20
ITG/FENSTER1.PAS
Normal file
20
ITG/FENSTER1.PAS
Normal file
@ -0,0 +1,20 @@
|
||||
program Fenster1;
|
||||
|
||||
uses crt;
|
||||
|
||||
procedure Ueberschrift(Text:string; VF,HF: byte);
|
||||
begin
|
||||
window(1,1,80,1);
|
||||
TextColor(VF);
|
||||
TextBackground(HF);
|
||||
ClrScr;
|
||||
GotoXY(40-(length(Text) DIV 2),1);
|
||||
Write(Text);
|
||||
end;
|
||||
|
||||
begin
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
Ueberschrift('Mal sehen was passiert, wenn die šberschrift die Zeilenl„nge sprengt Test Test',10,1);
|
||||
ReadKey;
|
||||
end.
|
||||
35
ITG/FIBONACC.PAS
Normal file
35
ITG/FIBONACC.PAS
Normal file
@ -0,0 +1,35 @@
|
||||
program Fibonacci;
|
||||
|
||||
{ Die Fibonacci-Folge ist wie folgt aufgebaut: Jeder Wert wird aus der Summe
|
||||
der zwei vorhergehenden Werte errechnet. Gegeben sind die ersten beiden
|
||||
Zahlen: 0 und 1.
|
||||
Der Anfang der Folge sieht so aus: 0,1,1,2,3,5,8,13,21,34,55,89,144,233,
|
||||
377,610,987,1597,2584,4181,6765,.... }
|
||||
|
||||
uses crt;
|
||||
|
||||
var i: integer;
|
||||
|
||||
function Fibonacci_Loop(n: integer): longint;
|
||||
var tmp,last1,last2,i: longint;
|
||||
begin
|
||||
last1:=0; last2:=0; tmp:=1;
|
||||
if n>=2 then begin
|
||||
for i:=1 to n do begin
|
||||
tmp:=tmp+last2; last2:=last1; last1:=tmp;
|
||||
end;
|
||||
Fibonacci_Loop:=tmp;
|
||||
end else Fibonacci_Loop:=n;
|
||||
end;
|
||||
|
||||
begin
|
||||
TextMode(C80 + Font8x8);
|
||||
Window(1,1,40,50);
|
||||
for i:=0 to 48 do begin
|
||||
WriteLn(Fibonacci_Loop(i));
|
||||
end;
|
||||
Window(40,1,80,50);
|
||||
for i:=49 to 97 do begin
|
||||
WriteLn(Fibonacci_Loop(i));
|
||||
end;
|
||||
end.
|
||||
35
ITG/FIBONA_F.PAS
Normal file
35
ITG/FIBONA_F.PAS
Normal file
@ -0,0 +1,35 @@
|
||||
program Fibonacci_FOR;
|
||||
|
||||
{ Die Fibonacci-Folge ist wie folgt aufgebaut: Jeder Wert wird aus der Summe
|
||||
der zwei vorhergehenden Werte errechnet. Gegeben sind die ersten beiden
|
||||
Zahlen: 0 und 1.
|
||||
Der Anfang der Folge sieht so aus: 0,1,1,2,3,5,8,13,21,34,55,89,144,233,
|
||||
377,610,987,1597,2584,4181,6765,.... }
|
||||
|
||||
uses crt;
|
||||
|
||||
var i: integer;
|
||||
|
||||
function Fibonacci_Loop(n: integer): longint;
|
||||
var tmp,last1,last2,i: longint;
|
||||
begin
|
||||
last1:=0; last2:=0; tmp:=1;
|
||||
if n>=2 then begin
|
||||
for i:=1 to n do begin
|
||||
tmp:=tmp+last2; last2:=last1; last1:=tmp;
|
||||
end;
|
||||
Fibonacci_Loop:=tmp;
|
||||
end else Fibonacci_Loop:=n;
|
||||
end;
|
||||
|
||||
begin
|
||||
TextMode(C80 + Font8x8);
|
||||
Window(1,1,40,50);
|
||||
for i:=0 to 48 do begin
|
||||
WriteLn(Fibonacci_Loop(i));
|
||||
end;
|
||||
Window(40,1,80,50);
|
||||
for i:=49 to 97 do begin
|
||||
WriteLn(Fibonacci_Loop(i));
|
||||
end;
|
||||
end.
|
||||
33
ITG/FIBONA_R.PAS
Normal file
33
ITG/FIBONA_R.PAS
Normal file
@ -0,0 +1,33 @@
|
||||
program Fibonacci_rekursiv;
|
||||
|
||||
{ Die Fibonacci-Folge ist wie folgt aufgebaut: Jeder Wert wird aus der Summe
|
||||
der zwei vorhergehenden Werte errechnet. Gegeben sind die ersten beiden
|
||||
Zahlen: 0 und 1.
|
||||
Der Anfang der Folge sieht so aus: 0,1,1,2,3,5,8,13,21,34,55,89,144,233,
|
||||
377,610,987,1597,2584,4181,6765,.... }
|
||||
|
||||
uses crt;
|
||||
|
||||
var take: integer;
|
||||
|
||||
procedure Fibonacci_Recursive(a,b: longint);
|
||||
begin
|
||||
Inc(take);
|
||||
WriteLn(a:10);
|
||||
if take<47 then Fibonacci_Recursive(b,a+b);
|
||||
end;
|
||||
|
||||
function Fibo(a: integer): longint;
|
||||
begin
|
||||
if (a=1) OR (a=2) then Fibo := 1
|
||||
else if a=0 then Fibo := 0
|
||||
else Fibo := Fibo(a-1)+Fibo(a-2);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
TextMode(C80 + Font8x8);
|
||||
take := 0;
|
||||
Fibonacci_Recursive(0,1);
|
||||
WriteLn(Fibo(20));
|
||||
end.
|
||||
66
ITG/GAUSS.PAS
Normal file
66
ITG/GAUSS.PAS
Normal file
@ -0,0 +1,66 @@
|
||||
program GAUSS;
|
||||
|
||||
uses Crt;
|
||||
|
||||
type GaRec=record
|
||||
x: integer;
|
||||
y: integer;
|
||||
end;
|
||||
|
||||
var n: integer;
|
||||
P: array[1..500] of GaRec;
|
||||
A: real;
|
||||
|
||||
procedure Init;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to 500 do begin
|
||||
P[i].x:=0;
|
||||
P[i].y:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Input;
|
||||
var i: integer;
|
||||
tmp,t2: string;
|
||||
begin
|
||||
i:=1;
|
||||
repeat
|
||||
Str(i:0,t2);
|
||||
tmp := 'P'+t2+'(';
|
||||
Write(tmp);
|
||||
ReadLn(P[i].x);
|
||||
Str(P[i].x:0,t2);
|
||||
tmp := tmp+t2+'|';
|
||||
GotoXY(1,WhereY-1);
|
||||
Write(tmp);
|
||||
ReadLn(P[i].y);
|
||||
Str(P[i].y:0,t2);
|
||||
tmp := tmp+t2+')';
|
||||
GotoXY(1,WhereY-1);
|
||||
WriteLn(tmp);
|
||||
Inc(i);
|
||||
until (P[i-1].x=P[1].x) AND (P[i-1].y=P[1].y) AND (i>2);
|
||||
n := i-2;
|
||||
end;
|
||||
|
||||
procedure Calc;
|
||||
var i: integer;
|
||||
begin
|
||||
A := 0;
|
||||
for i:=1 to n do A := A + (P[i].x*P[i+1].y - P[i+1].x*P[i].y);
|
||||
A := A / 2;
|
||||
end;
|
||||
|
||||
procedure Output;
|
||||
begin
|
||||
WriteLn;
|
||||
WriteLn('Fl„cheninhalt: ',A:0:5,' quadratsonstwas');
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
Input;
|
||||
Calc;
|
||||
Output;
|
||||
end.
|
||||
39
ITG/GEWICHT.PAS
Normal file
39
ITG/GEWICHT.PAS
Normal file
@ -0,0 +1,39 @@
|
||||
{ Var Geschl:Char;
|
||||
'GrӇe, Gewicht, Geschlecht angeben'
|
||||
VAR Gr,Gew,Geschl eingeben
|
||||
Geschl='m' ?
|
||||
nein: Ideal := (gr-100)*0.9
|
||||
|
||||
ja: Ideal=(Gr-100)*0.95
|
||||
Gew <= Ideal*0.98
|
||||
Ja: 'Fliegengew'
|
||||
Var Ideal ausgeben
|
||||
Nein: Gew >= Ideal*1.02
|
||||
Ja: 'Alter Sack-zu schwer!'
|
||||
VAR Ideal ausgeben
|
||||
Nein: 'Gratulation' }
|
||||
|
||||
program Gewicht;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var Gr, Gew, Ideal: real;
|
||||
Geschl: char;
|
||||
|
||||
begin
|
||||
Write('GrӇe: ');
|
||||
ReadLn(Gr);
|
||||
Write('Gewicht: ');
|
||||
ReadLn(Gew);
|
||||
Write('Geschlecht (m/w): ');
|
||||
Geschl := ReadKey;
|
||||
WriteLn(Geschl);
|
||||
WriteLn;
|
||||
if Geschl='m' then Ideal := (Gr-100)*0.95 else Ideal := (Gr-100)*0.9;
|
||||
if Gew <= Ideal*0.98 then WriteLn('Fliegengewicht! Idealgewicht: ', Ideal:3:5)
|
||||
else if Gew >= Ideal*1.02 then WriteLn('Alter Sack-zu schwer! Idealgewicht: ', Ideal:3:5)
|
||||
else WriteLn('Gratulation!');
|
||||
WriteLn;
|
||||
WriteLn('Bitte Taste dr<64>cken...');
|
||||
ReadKey;
|
||||
end.
|
||||
335
ITG/G_U_I.PAS
Normal file
335
ITG/G_U_I.PAS
Normal file
@ -0,0 +1,335 @@
|
||||
program RekGUI;
|
||||
|
||||
uses Crt, Graph, DOS, GUI, RekGraph;
|
||||
|
||||
const desktopcolor=3;
|
||||
skier_len: integer=120;
|
||||
skier_edge: integer=10;
|
||||
skier_globangle: integer=0;
|
||||
skier_fixedinit: boolean=true;
|
||||
haken_len: integer=150;
|
||||
haken_angle: integer=45;
|
||||
haken_globangle: integer=0;
|
||||
haken_fixedinit: boolean=true;
|
||||
quadrat_len: integer=150;
|
||||
quadrat_angle: integer=90;
|
||||
quadrat_globangle: integer=0;
|
||||
quadrat_fixedinit: boolean=true;
|
||||
spirale_len: integer=10;
|
||||
spirale_angle: integer=25;
|
||||
spirale_globangle: integer=0;
|
||||
spirale_fixedinit: boolean=true;
|
||||
|
||||
var xmax, ymax, xmed, ymed: word;
|
||||
ExitAll, ExitSetupAll: boolean;
|
||||
|
||||
procedure Init;
|
||||
var grDriver, grMode: integer;
|
||||
BGIPath: string;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAHi;
|
||||
initp_del := 30;
|
||||
BGIPath := '..\..\BGI\';
|
||||
InitGraph(grDriver, grMode, BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xmax DIV 2;
|
||||
ymed := ymax DIV 2;
|
||||
om := 0;
|
||||
ExitAll := false;
|
||||
ExitSetupAll := false;
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
SetTextJustify(LeftText,TopText);
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(0,0,xmax-1,ymax-1);
|
||||
ClearStatus;
|
||||
end;
|
||||
|
||||
procedure InitGraphs;
|
||||
begin
|
||||
skier_del := 50;
|
||||
haken_del := 50;
|
||||
quadrat_del := 100;
|
||||
spirale_del := 50;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
TextMode(CO80);
|
||||
WriteLn('VMode : ',xmax,'x',ymax);
|
||||
WriteLn('Center: ',xmed,'x',ymed);
|
||||
WriteLn;
|
||||
WriteLn('Programm beendet.');
|
||||
end;
|
||||
|
||||
function V2S(x: byte): string;
|
||||
var tmp: string;
|
||||
begin
|
||||
Str(x:3,tmp);
|
||||
V2S := tmp;
|
||||
end;
|
||||
|
||||
procedure ShowSkier;
|
||||
begin
|
||||
globangle := skier_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(180,370);
|
||||
Skier(skier_len,skier_edge);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
procedure ShowHaken;
|
||||
begin
|
||||
globangle := haken_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(240,180);
|
||||
Haken(haken_len,haken_angle);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
procedure ShowQuadrat;
|
||||
begin
|
||||
globangle := haken_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(240,180);
|
||||
Quadrat(quadrat_len,quadrat_angle);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
|
||||
procedure ShowSpirale;
|
||||
begin
|
||||
globangle := spirale_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(240,180);
|
||||
Spirale(spirale_len,spirale_angle);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
procedure Palette;
|
||||
const tx=50;
|
||||
ty=31;
|
||||
var i,j: integer;
|
||||
begin
|
||||
for j:=1 to 16 do begin
|
||||
SetTextJustify(RightText,CenterText);
|
||||
SetColor(0);
|
||||
OutTextXY(tx,ty+(j-1)*10+5,V2S((j-1)*16));
|
||||
for i:=0 to 15 do begin
|
||||
SetFillStyle(SolidFill,(j-1)*16+i);
|
||||
SetColor((j-1)*15+i);
|
||||
Bar(tx+i*10,ty+(j-1)*10,tx+i*10+10,ty+(j-1)*10+10);
|
||||
end;
|
||||
SetTextJustify(LeftText,CenterText);
|
||||
SetColor(0);
|
||||
OutTextXY(tx+162,ty+(j-1)*10+5,V2S((j-1)*16+15));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckSetupStat;
|
||||
begin
|
||||
if (mb<>0) then ShowMouse(false);
|
||||
if MouseOver(15,405,525,425) then begin
|
||||
Status('Hiermit wird die Konfiguration so gespeichert');
|
||||
case mb of
|
||||
1: begin
|
||||
ExitSetupAll := true;
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(527,405,625,425) then begin
|
||||
Status('Hier geht''s nach Hause!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(527,405,625,425,'EXIT');
|
||||
ExitSetupAll:=true;
|
||||
ExitAll:=true;
|
||||
Delay(buttondelay);
|
||||
MakeButton(527,405,625,425,'EXIT');
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end else if (oldstat<>'') then begin
|
||||
ClearStatus;
|
||||
oldstat:='';
|
||||
end;
|
||||
if (mb<>0) then ShowMouse(true);
|
||||
end;
|
||||
|
||||
procedure SetupData;
|
||||
var sx,sy,sb: integer;
|
||||
begin
|
||||
MakeWindow(10,10,630,430,'Konfiguration');
|
||||
MakeButton(15,405,525,425,'Einstellungen so <20>bernehmen');
|
||||
MakeButton(527,405,625,425,'EXIT');
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
CheckSetupStat;
|
||||
StatusTime(false);
|
||||
until (mb=3) OR (ExitSetupAll);
|
||||
if (mb=3) then ExitAll := true;
|
||||
ShowMouse(false);
|
||||
end;
|
||||
|
||||
procedure BuildWindows;
|
||||
begin
|
||||
MakeWindow(10,10,500,400,'Hauptfenster');
|
||||
MakeWindow(505,10,600,400,'Optionen');
|
||||
MakeButton(510,385,595,395,'EXIT');
|
||||
MakeButton(510,373,595,383,'CLEAR');
|
||||
MakeButton(510,34,595,54,'Skierp.');
|
||||
MakeButton(510,56,595,76,'Haken');
|
||||
MakeButton(510,78,595,98,'Quadrat');
|
||||
MakeButton(510,100,595,120,'Spirale');
|
||||
MakeButton(510,350,595,371,'SETUP');
|
||||
end;
|
||||
|
||||
procedure CheckStat;
|
||||
begin
|
||||
if (mb<>0) then ShowMouse(false);
|
||||
if MouseOver(510,385,595,395) then begin
|
||||
Status('Hier geht''s nach Hause!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,385,595,395,'EXIT');
|
||||
ExitAll:=true;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,385,595,395,'EXIT');
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,373,595,383) then begin
|
||||
Status('Damit wird das Hauptfenster gel”scht!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,373,595,383,'CLEAR');
|
||||
SetFillStyle(SolidFill,7);
|
||||
Bar(13,31,497,397);
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,373,595,383,'CLEAR');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,350,595,371) then begin
|
||||
Status('Hier kann man die Einstellungen „ndern!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,350,595,371,'SETUP');
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(10,10,500,400);
|
||||
Delay(buttondelay DIV 2);
|
||||
Bar(505,10,600,400);
|
||||
Delay(buttondelay DIV 2);
|
||||
ExitSetupAll := false;
|
||||
SetupData;
|
||||
if NOT ExitAll then begin
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(10,10,630,430);
|
||||
BuildWindows;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,34,595,54) then begin
|
||||
Status('F<>r unsere Wintersportler!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,34,595,54,'Skierp.');
|
||||
ShowSkier;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,34,595,54,'Skierp.');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,56,595,76) then begin
|
||||
Status('Und das ist f<>r die Angler!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,56,595,76,'Haken');
|
||||
ShowHaken;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,56,595,76,'Haken');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,78,595,98) then begin
|
||||
Status('Sehen Sie schon viereckig?');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,78,595,98,'Quadrat');
|
||||
ShowQuadrat;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,78,595,98,'Quadrat');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,100,595,120) then begin
|
||||
Status('Ist was verstopft?');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,100,595,120,'Spirale');
|
||||
ShowSpirale;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,100,595,120,'Spirale');
|
||||
end;
|
||||
end;
|
||||
end else if (oldstat<>'') then begin
|
||||
ClearStatus;
|
||||
oldstat:='';
|
||||
end;
|
||||
if (mb<>0) then ShowMouse(true);
|
||||
end;
|
||||
|
||||
procedure StartScreen;
|
||||
begin
|
||||
MakeWindow(120,140,520,340,'Rekursive Grafikfunktionen');
|
||||
SetViewPort(123,161,517,337,ClipOn);
|
||||
SetColor(9);
|
||||
SetTextStyle(TripleXFont,HorizDir,10);
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
OutTextXY(200,24,'GUI');
|
||||
OutTextXY(200,26,'GUI');
|
||||
OutTextXY(199,25,'GUI');
|
||||
OutTextXY(201,25,'GUI');
|
||||
SetTextStyle(SansSerifFont,HorizDir,2);
|
||||
OutTextXY(200,100,'GRAPHICAL USER INTERFACE');
|
||||
SetColor(0);
|
||||
SetTextStyle(SmallFont,HorizDir,5);
|
||||
OutTextXY(200,165,'geschrieben von Markus Birth <mbirth@webwriters.de>');
|
||||
SetTextStyle(SmallFont,VertDir,4);
|
||||
SetTextJustify(CenterText,TopText);
|
||||
SetColor(8);
|
||||
OutTextXY(385,2,'(c)1999 Web - Writers');
|
||||
SetColor(0);
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
OutTextXY(200,140,'Initialisiere Farbpalette ...');
|
||||
Delay(1000);
|
||||
InitPalette;
|
||||
SetFillStyle(SolidFill,7);
|
||||
Bar(0,130,400,150);
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
Status('Bitte dr<64>cken Sie irgendeine Taste (Maus oder Tastatur)');
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
StatusTime(false);
|
||||
until (keypressed) OR (mb<>0);
|
||||
if keypressed then ReadKey;
|
||||
ShowMouse(false);
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(120,140,520,340);
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
InitGraphs;
|
||||
StartScreen;
|
||||
BuildWindows;
|
||||
MouseReset;
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
CheckStat;
|
||||
StatusTime(false);
|
||||
until (mb=3) OR (ExitAll);
|
||||
ShowMouse(false);
|
||||
FadeOut;
|
||||
Outit;
|
||||
end.
|
||||
21
ITG/HANOI.INI
Normal file
21
ITG/HANOI.INI
Normal file
@ -0,0 +1,21 @@
|
||||
[Hanoi_Main]
|
||||
Items=5
|
||||
|
||||
[Hanoi_Board]
|
||||
Board_X=600
|
||||
Board_Middle=400
|
||||
Board_Y=10
|
||||
Board_Color=10
|
||||
|
||||
[Hanoi_Poles]
|
||||
Tower_X=10
|
||||
Tower_Color=12
|
||||
|
||||
[Hanoi_Coins]
|
||||
Item_MaxX=130
|
||||
Item_MinX=35
|
||||
Item_Y=20
|
||||
Item_Color=14
|
||||
|
||||
[Hanoi_Texts]
|
||||
Text_Color=15
|
||||
290
ITG/HANOI.PAS
Normal file
290
ITG/HANOI.PAS
Normal file
@ -0,0 +1,290 @@
|
||||
program Towers_of_Hanoi;
|
||||
|
||||
uses Crt, Graph, INIFile, BGIP;
|
||||
|
||||
const { Hmax=5; }
|
||||
Gray50: FillPatternType=($AA, $55, $AA, $55, $AA, $55, $AA, $55);
|
||||
Sound_ON=false;
|
||||
|
||||
var xmax, ymax, xmed, ymed: word;
|
||||
Code: integer;
|
||||
Hanoi: array[1..3,1..100] of byte;
|
||||
Item_X: array[1..100] of word;
|
||||
Board_Up, Board_Down: word;
|
||||
Tower_Y: word;
|
||||
Input: char;
|
||||
Mv_From, Mv_To: byte;
|
||||
Step: longint;
|
||||
tmp1,tmp2: string;
|
||||
T_Center: array[1..3] of word;
|
||||
Hmax: byte;
|
||||
Board_X,Board_Middle,Board_Y: word;
|
||||
Board_Color: byte;
|
||||
Tower_X: word;
|
||||
Tower_Color: byte;
|
||||
Item_MaxX, Item_MinX, Item_Y: word;
|
||||
Item_Color, Text_Color: byte;
|
||||
|
||||
function V2S(x: longint): string;
|
||||
var tmp: string;
|
||||
begin
|
||||
Str(x:0,tmp);
|
||||
V2S := tmp;
|
||||
end;
|
||||
|
||||
function S2V(x: string): integer;
|
||||
var tmp,code: integer;
|
||||
begin
|
||||
Val(x,tmp,code);
|
||||
if (code<>0) then begin
|
||||
WriteLn('Error while VAL ''',x,''': ',code);
|
||||
Halt;
|
||||
end else S2V:=tmp;
|
||||
end;
|
||||
|
||||
procedure Init;
|
||||
var grDriver, grMode: integer;
|
||||
i,j: byte;
|
||||
begin
|
||||
INIFileDebug := false;
|
||||
OpenINI('D:\LANG\src\bp\itg\hanoi.ini');
|
||||
Hmax := S2V(INIGet('Hanoi_Main','Items'));
|
||||
Board_X := S2V(INIGet('Hanoi_Board','Board_X'));
|
||||
Board_Middle := S2V(INIGet('Hanoi_Board','Board_Middle'));
|
||||
Board_Y := S2V(INIGet('Hanoi_Board','Board_Y'));
|
||||
Board_Color := S2V(INIGet('Hanoi_Board','Board_Color'));
|
||||
Tower_X := S2V(INIGet('Hanoi_Poles','Tower_X'));
|
||||
Tower_Color := S2V(INIGet('Hanoi_Poles','Tower_Color'));
|
||||
Item_MaxX := S2V(INIGet('Hanoi_Coins','Item_MaxX'));
|
||||
Item_MinX := S2V(INIGet('Hanoi_Coins','Item_MinX'));
|
||||
Item_Y := S2V(INIGet('Hanoi_Coins','Item_Y'));
|
||||
Item_Color := S2V(INIGet('Hanoi_Coins','Item_Color'));
|
||||
Text_Color := S2V(INIGet('Hanoi_Texts','Text_Color'));
|
||||
CloseINI;
|
||||
grDriver := VGA;
|
||||
grMode := VGAHi;
|
||||
InitGraph(grDriver, grMode, BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xmax DIV 2;
|
||||
ymed := ymax DIV 2;
|
||||
T_Center[1] := xmed-(Board_X DIV 4);
|
||||
T_Center[2] := xmed;
|
||||
T_Center[3] := xmed+(Board_X DIV 4);
|
||||
Board_Up := Board_Middle-(Board_Y DIV 2);
|
||||
Board_Down := Board_Middle+(Board_Y DIV 2);
|
||||
Tower_Y := (Hmax+1)*Item_Y;
|
||||
Step := 0;
|
||||
for i:=1 to 3 do begin
|
||||
for j:=1 to Hmax do begin
|
||||
Hanoi[i,j] := 0;
|
||||
Hanoi[1,j] := Hmax-j+1;
|
||||
Item_X[Hmax-j+1] := Trunc(((Hmax-j)/(Hmax-1))*(Item_MaxX-Item_MinX))+Item_MinX;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DrawBoard;
|
||||
var i,j: byte;
|
||||
begin
|
||||
ClearDevice;
|
||||
for i:=1 to 3 do begin
|
||||
SetColor(Tower_Color);
|
||||
SetFillPattern(Gray50,Tower_Color);
|
||||
Rectangle(T_Center[i]-(Tower_X DIV 2),Board_Up-Tower_Y,T_Center[i]+(Tower_X DIV 2),Board_Up);
|
||||
FloodFill(T_Center[i],Board_Middle-(Board_Y DIV 2)-(Tower_Y DIV 2),Tower_Color);
|
||||
SetColor(Text_Color);
|
||||
SetTextJustify(CenterText, CenterText);
|
||||
OutTextXY(T_Center[i],Board_Down+10,V2S(i));
|
||||
SetTextJustify(LeftText, TopText);
|
||||
end;
|
||||
SetColor(Board_Color);
|
||||
Rectangle(xmed-(Board_X DIV 2),Board_Up,xmed+(Board_X DIV 2),Board_Down);
|
||||
SetFillPattern(Gray50,Board_Color);
|
||||
FloodFill(xmed,Board_Middle,Board_Color);
|
||||
|
||||
for i:=1 to 3 do begin
|
||||
for j:=1 to Hmax do begin
|
||||
if Hanoi[i,j]<>0 then begin
|
||||
SetColor(Item_Color);
|
||||
SetFillPattern(Gray50,Item_Color);
|
||||
Rectangle(T_Center[i]-(Item_X[Hanoi[i,j]] DIV 2),Board_Up-(Item_Y*(j-1)),T_Center[i]+(Item_X[Hanoi[i,j]] DIV 2),
|
||||
Board_Up-(Item_Y*j));
|
||||
FloodFill(T_Center[i],Board_Up-(Item_Y*j)+(Item_Y DIV 2),Item_Color);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function WhatsLast(Tower: byte): byte;
|
||||
var i: integer;
|
||||
tmp: byte;
|
||||
begin
|
||||
tmp := 0;
|
||||
for i:=Hmax downto 1 do begin
|
||||
if Hanoi[Tower,i]<>0 then begin
|
||||
tmp := Hanoi[Tower,i];
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
if (tmp=0) then tmp:=255;
|
||||
SetTextJustify(CenterText, CenterText);
|
||||
OutTextXY(T_Center[Tower],Board_Down+20,V2S(tmp));
|
||||
SetTextJustify(LeftText, TopText);
|
||||
WhatsLast := tmp;
|
||||
end;
|
||||
|
||||
function TakeLast(Tower: byte): byte;
|
||||
var i: integer;
|
||||
tmp: byte;
|
||||
begin
|
||||
for i:=Hmax downto 1 do begin
|
||||
if Hanoi[Tower,i]<>0 then begin
|
||||
tmp := Hanoi[Tower,i];
|
||||
Hanoi[Tower,i] := 0;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
TakeLast := tmp;
|
||||
end;
|
||||
|
||||
procedure PutOnto(Which,Tower: byte);
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to Hmax do begin
|
||||
if Hanoi[Tower,i]=0 then begin
|
||||
Hanoi[Tower,i]:=which;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MoveFromTo(Mv_From, Mv_To: byte);
|
||||
var temp: byte;
|
||||
begin
|
||||
if (WhatsLast(Mv_To)>WhatsLast(Mv_From)) then begin
|
||||
PutOnto(TakeLast(Mv_From),Mv_To);
|
||||
Inc(Step);
|
||||
if (Sound_ON) then begin
|
||||
Sound(1200);
|
||||
Delay(75);
|
||||
NoSound;
|
||||
end;
|
||||
end else begin
|
||||
if (Sound_ON) then begin
|
||||
Sound(800);
|
||||
Delay(150);
|
||||
NoSound;
|
||||
end;
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
SetColor(LightRed);
|
||||
OutTextXY(xmed,40,'Can''t move Item on Tower '+V2S(Mv_From)+' to Tower '+V2S(Mv_To)+'.');
|
||||
Delay(1000);
|
||||
end;
|
||||
end;
|
||||
|
||||
function All(what: byte): word;
|
||||
var tmp: word;
|
||||
begin
|
||||
if what=1 then All:=1 else All:=what+All(what-1);
|
||||
end;
|
||||
|
||||
function CheckWon: boolean;
|
||||
var i,j: byte;
|
||||
sum: word;
|
||||
tmp: boolean;
|
||||
begin
|
||||
for i:=2 to 3 do begin
|
||||
if (WhatsLast(i)=1) then begin
|
||||
sum := 0;
|
||||
for j:=1 to Hmax do begin
|
||||
sum := sum + Hanoi[i,j];
|
||||
end;
|
||||
if (sum=All(Hmax)) then begin
|
||||
tmp:=true;
|
||||
Break;
|
||||
end;
|
||||
end else tmp:=false;
|
||||
end;
|
||||
CheckWon := tmp;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
var i: byte;
|
||||
begin
|
||||
TextMode(CO80);
|
||||
WriteLn('VMode : ',xmax,'x',ymax);
|
||||
WriteLn('Center: ',xmed,'x',ymed);
|
||||
for i:=1 to Hmax do begin
|
||||
WriteLn('Tower_X ',i,': ',Item_X[i]);
|
||||
end;
|
||||
WriteLn('Steps needed: ',Step:0);
|
||||
WriteLn;
|
||||
if (CheckWon) then WriteLn('Programm siegreich beendet.') else WriteLn('Programm grundlos beendet.');
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
repeat
|
||||
DrawBoard;
|
||||
if (CheckWon) then begin
|
||||
if (Sound_ON) then begin
|
||||
Sound(1000);
|
||||
Delay(100);
|
||||
NoSound;
|
||||
Delay(200);
|
||||
Sound(1000);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
Delay(100);
|
||||
Sound(1000);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
Delay(100);
|
||||
Sound(1400);
|
||||
Delay(750);
|
||||
NoSound;
|
||||
end;
|
||||
Break;
|
||||
end;
|
||||
SetColor(LightGreen);
|
||||
SetTextJustify(CenterText,BottomText);
|
||||
OutTextXY(xmed,ymax,'Press X to exit');
|
||||
SetTextJustify(LeftText,TopText);
|
||||
SetColor(Text_Color);
|
||||
Str(Step:3,tmp1);
|
||||
OutTextXY(550,10,'Step: '+tmp1);
|
||||
tmp1 := 'Move Item from Tower ';
|
||||
OutTextXY(10,10,'Press 1, 2 or 3 to select a tower.');
|
||||
OutTextXY(10,20,tmp1);
|
||||
Input := ReadKey;
|
||||
if (Input='1') OR (Input='2') OR (Input='3') then begin
|
||||
Val(Input,Mv_From,Code);
|
||||
Str(Mv_From:0,tmp2);
|
||||
tmp1 := tmp1 + tmp2 + ' to Tower ';
|
||||
OutTextXY(10,20,tmp1);
|
||||
Input := ReadKey;
|
||||
if (Input='1') OR (Input='2') OR (Input='3') then begin
|
||||
Val(Input,Mv_To,Code);
|
||||
Str(Mv_To:0,tmp2);
|
||||
tmp1 := tmp1 + tmp2 + ' ...';
|
||||
OutTextXY(10,20,tmp1);
|
||||
MoveFromTo(Mv_From,Mv_To);
|
||||
end else if (Input<>'x') AND (Input<>'X') then begin
|
||||
if (Sound_ON) then begin
|
||||
Sound(800);
|
||||
Delay(150);
|
||||
NoSound;
|
||||
end;
|
||||
end else Break;
|
||||
end else if (Input<>'x') AND (Input<>'X') then begin
|
||||
if (Sound_ON) then begin
|
||||
Sound(800);
|
||||
Delay(150);
|
||||
NoSound;
|
||||
end;
|
||||
end;
|
||||
until (Input='x') OR (Input='X');
|
||||
Outit;
|
||||
end.
|
||||
29
ITG/HANOIT.PAS
Normal file
29
ITG/HANOIT.PAS
Normal file
@ -0,0 +1,29 @@
|
||||
program Bewege_Test;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var howmuchcanyoutake: integer;
|
||||
step: integer;
|
||||
|
||||
procedure Bewege(n: integer; p1,p2,p3: char);
|
||||
begin
|
||||
if n=1 then begin
|
||||
WriteLn(p1,' --> ',p2);
|
||||
Inc(step);
|
||||
end else begin
|
||||
Bewege(n-1,p1,p3,p2);
|
||||
Bewege(1,p1,p2,p3);
|
||||
Bewege(n-1,p3,p2,p1);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
Step := 0;
|
||||
TextMode(CO80+Font8x8);
|
||||
Write('Wieviel M<>nzen? ');
|
||||
ReadLn(howmuchcanyoutake);
|
||||
Bewege(howmuchcanyoutake,'1','2','3');
|
||||
WriteLn('Schritte: ',step);
|
||||
ReadKey;
|
||||
end.
|
||||
66
ITG/HASHING.PAS
Normal file
66
ITG/HASHING.PAS
Normal file
@ -0,0 +1,66 @@
|
||||
program Hashing;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const max=25;
|
||||
|
||||
var mem: array[0..max] of integer;
|
||||
x,pos: integer;
|
||||
|
||||
procedure Init;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=0 to max do mem[i] := 255;
|
||||
end;
|
||||
|
||||
procedure OutArray;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=0 to max do begin
|
||||
if (i/2)=(I DIV 2) then TextColor(10) else TextColor(12);
|
||||
GotoXY(i*3+1,3); Write(i:3);
|
||||
GotoXY(i*3+1,4); if (mem[i]<>255) then Write(mem[i]:3);
|
||||
end;
|
||||
end;
|
||||
|
||||
function Hash(v: integer): integer;
|
||||
begin
|
||||
Hash := v MOD 13;
|
||||
end;
|
||||
|
||||
procedure MakeFree(var v: integer);
|
||||
begin
|
||||
if (mem[v]<>255) then begin
|
||||
repeat
|
||||
Inc(v);
|
||||
until (mem[v]=255) OR (v>max);
|
||||
end;
|
||||
if (v>max) then begin
|
||||
ClrScr;
|
||||
TextColor(12);
|
||||
WriteLn('Array <20>berschritten! Das Feld ist VOLL!');
|
||||
Halt;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ReadAndSort;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to 15 do begin
|
||||
GotoXY(5,5);
|
||||
ReadLn(x);
|
||||
pos := Hash(x);
|
||||
MakeFree(pos);
|
||||
mem[pos] := x;
|
||||
OutArray;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
TextBackground(0);
|
||||
TextColor(15);
|
||||
ClrScr;
|
||||
Init;
|
||||
OutArray;
|
||||
ReadAndSort;
|
||||
end.
|
||||
39
ITG/ISBN.PAS
Normal file
39
ITG/ISBN.PAS
Normal file
@ -0,0 +1,39 @@
|
||||
program ISBNGrab;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var UrISBN: string;
|
||||
i,j,co: integer;
|
||||
|
||||
function BNS(ISBN: string;which: integer): string;
|
||||
var NR: array[1..10] of string;
|
||||
x,lastx,i: integer;
|
||||
j: string;
|
||||
begin
|
||||
i := 1;
|
||||
lastx := 0;
|
||||
for x:=0 to Length(ISBN) do begin
|
||||
if ISBN[x]='-' then begin
|
||||
NR[i] := Copy(ISBN,lastx+1,x-lastx-1);
|
||||
Inc(i);
|
||||
lastx := x;
|
||||
end;
|
||||
end;
|
||||
NR[i] := Copy(ISBN,lastx+1,Length(ISBN));
|
||||
if which<>0 then BNS := NR[which] else begin
|
||||
Str(i:0,j);
|
||||
BNS := j;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
Write('ISBN eintippen: ');
|
||||
ReadLn(UrISBN);
|
||||
Write('ISBN: ',BNS(UrISBN,1));
|
||||
Val(BNS(UrISBN,0),j,co);
|
||||
for i:=2 to j do Write('-',BNS(UrISBN,i));
|
||||
WriteLn(' (',BNS(UrISBN,0),' Gruppen)');
|
||||
WriteLn('Buchnr.: ',BNS(UrISBN,3));
|
||||
ReadKey;
|
||||
end.
|
||||
12
ITG/KLAU1_02.PAS
Normal file
12
ITG/KLAU1_02.PAS
Normal file
@ -0,0 +1,12 @@
|
||||
var a,b,cs,max: integer;
|
||||
|
||||
begin
|
||||
Write('max: ');
|
||||
ReadLn(max);
|
||||
for a:=1 to max do begin
|
||||
for b:=a to max do begin
|
||||
cs := Sqr(a)+Sqr(b);
|
||||
if Sqrt(cs)=Int(Sqrt(cs)) then WriteLn(a,'ý+',b,'ý=',Sqrt(cs):0:0,'ý');
|
||||
end;
|
||||
end;
|
||||
end.
|
||||
114
ITG/LOTTO.PAS
Normal file
114
ITG/LOTTO.PAS
Normal file
@ -0,0 +1,114 @@
|
||||
program Lotto_Ziehung;
|
||||
|
||||
uses Crt, CursorOnOff, Dos;
|
||||
|
||||
const prog:char='/';
|
||||
freq=30;
|
||||
pfreq=10;
|
||||
|
||||
var lotto: array[1..49] of longint;
|
||||
fulr: array[1..freq] of real;
|
||||
fuls: byte;
|
||||
pers: byte;
|
||||
full: real;
|
||||
isec: longint;
|
||||
h,m,s,ss: word;
|
||||
|
||||
procedure StartClock;
|
||||
begin
|
||||
GetTime(h,m,s,ss);
|
||||
isec := h*3600+m*60+s;
|
||||
end;
|
||||
|
||||
function RunSec: longint;
|
||||
var nh,nm,ns,nss: word;
|
||||
nsec: longint;
|
||||
begin
|
||||
GetTime(nh,nm,ns,nss);
|
||||
nsec := nh*3600+nm*60+ns;
|
||||
RunSec := nsec-isec;
|
||||
end;
|
||||
|
||||
procedure Progress(how,much: real);
|
||||
var wx,wy: word;
|
||||
secs,tfull,rest: real;
|
||||
i: byte;
|
||||
fsum: real;
|
||||
begin
|
||||
secs := RunSec;
|
||||
if (fuls<freq) then begin
|
||||
tfull := secs / (how/much);
|
||||
Inc(fuls);
|
||||
fulr[fuls] := tfull;
|
||||
if (full<>0) then rest := full - secs else rest := 0;
|
||||
end else begin
|
||||
fsum := 0;
|
||||
for i:=1 to freq do fsum := fsum + fulr[i];
|
||||
full := fsum / freq;
|
||||
rest := full - secs;
|
||||
fuls := 0;
|
||||
end;
|
||||
if (pers>pfreq) then begin
|
||||
Write(prog,' [',(how/much)*100:6:2,'%] (',secs:4:0,'/',full:4:0,' ',rest:4:0,' left)');
|
||||
pers := 0;
|
||||
end else begin
|
||||
Write(prog);
|
||||
GotoXY(WhereX+11,WhereY);
|
||||
Write('(',secs:4:0);
|
||||
end;
|
||||
Inc(pers);
|
||||
GotoXY(14,WhereY);
|
||||
case prog of
|
||||
'/': prog:= '-';
|
||||
'-': prog:= '\';
|
||||
'\': prog:= '|';
|
||||
'|': prog:= '/';
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure init;
|
||||
var i:byte;
|
||||
begin
|
||||
{ clrscr; }
|
||||
fuls := 0;
|
||||
full := 0;
|
||||
pers := 0;
|
||||
writeLn;
|
||||
Randomize;
|
||||
{ RandSeed := 123; }
|
||||
for i:=1 to 49 do Lotto[i]:=0;
|
||||
end;
|
||||
|
||||
procedure Ziehung;
|
||||
var i,n: longint;
|
||||
begin
|
||||
write('Wieviel Ziehungen? '); ReadLn(n);
|
||||
StartClock;
|
||||
CursorOff;
|
||||
write('Berechne ... ');
|
||||
for i:=1 to n do begin
|
||||
if i MOD 100000=0 then Progress(i,n);
|
||||
inc(Lotto[Random(49)+1]);
|
||||
end;
|
||||
GotoXY(wherex-1,wherey); WriteLn(' fertig! ');
|
||||
CursorOn;
|
||||
end;
|
||||
|
||||
procedure Auswertung;
|
||||
var z,i,max: byte;
|
||||
begin
|
||||
WriteLn('Die 6 h„ufigsten Ziehungen:');
|
||||
for z:=1 to 6 do begin
|
||||
max:=1;
|
||||
for i:=2 to 49 do if Lotto[i]>Lotto[max] then max:=i;
|
||||
WriteLn(z:1,': ',max:2,' [',Lotto[max],']');
|
||||
Lotto[max]:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
init;
|
||||
Ziehung;
|
||||
auswertung;
|
||||
end.
|
||||
46
ITG/MENGELOT.PAS
Normal file
46
ITG/MENGELOT.PAS
Normal file
@ -0,0 +1,46 @@
|
||||
uses crt;
|
||||
|
||||
type TMenge = SET of 1..49;
|
||||
var Tip1, Tip2, Tip3: TMenge;
|
||||
|
||||
procedure Init(var Menge: TMenge);
|
||||
begin
|
||||
(**) Menge := []; (**)
|
||||
end;
|
||||
|
||||
procedure LottoZiehung(var Zahlen: TMenge);
|
||||
var anzahl, ZufZahl: byte;
|
||||
begin
|
||||
anzahl := 0;
|
||||
repeat
|
||||
repeat
|
||||
ZufZahl := random(49)+1;
|
||||
until NOT (**) (ZufZahl IN Zahlen) (**) ;
|
||||
(**) Zahlen := Zahlen + [ZufZahl] (**) ;
|
||||
(**) Inc(anzahl) (**) ;
|
||||
until anzahl = 6;
|
||||
end;
|
||||
|
||||
procedure Ausgabe(Zahlen: TMenge);
|
||||
var i: byte;
|
||||
begin
|
||||
for i:= (**) 1 to 49 (**) do
|
||||
(**) if i IN Zahlen then write(i, ' ') (**) ;
|
||||
(**) writeln (**) ;
|
||||
end;
|
||||
|
||||
begin
|
||||
clrscr; Randomize;
|
||||
|
||||
Init( (**) Tip1 (**) );
|
||||
LottoZiehung( (**) Tip1 (**) );
|
||||
Ausgabe( (**) Tip1 (**) );
|
||||
|
||||
Init( (**) Tip2 (**) );
|
||||
LottoZiehung( (**) Tip2 (**) );
|
||||
Ausgabe( (**) Tip2 (**) );
|
||||
|
||||
Init( (**) Tip3 (**) );
|
||||
LottoZiehung( (**) Tip3 (**) );
|
||||
Ausgabe( (**) Tip3 (**) );
|
||||
end.
|
||||
95
ITG/MIRROR.PAS
Normal file
95
ITG/MIRROR.PAS
Normal file
@ -0,0 +1,95 @@
|
||||
program Mirroring;
|
||||
|
||||
uses Crt, Graph, GUI, BGIP;
|
||||
|
||||
var xmax,ymax: integer;
|
||||
omx, omy, omb: integer;
|
||||
lx,ly,rx,ry: integer;
|
||||
orx,ory: integer;
|
||||
ls,rs: boolean;
|
||||
|
||||
procedure GraphInit;
|
||||
var grDriver, grMode : integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
{ VGAlo 640x200x16
|
||||
VGAmed 640x350x16
|
||||
VGAhi 640x480x16 }
|
||||
grMode := VGAhi;
|
||||
InitGraph(grDriver,grMode,BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
end;
|
||||
|
||||
procedure GraphOutit;
|
||||
begin
|
||||
TextMode(co80 + Font8x8);
|
||||
end;
|
||||
|
||||
function Num2Str(x: longint): string;
|
||||
var tmp: string;
|
||||
begin
|
||||
Str(x:3,tmp);
|
||||
Num2Str := tmp;
|
||||
end;
|
||||
|
||||
procedure SetRect;
|
||||
begin
|
||||
omx := 0;
|
||||
omy := 0;
|
||||
omb := 0;
|
||||
lx := 0; ly := 0;
|
||||
ls := false;
|
||||
rs := false;
|
||||
repeat
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
until (mx<>omx) OR (my<>omy) OR (mb<>omb);
|
||||
if (mb=1) AND NOT (ls) then begin
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
until (mb=0);
|
||||
lx := mx;
|
||||
ly := my;
|
||||
ls := true;
|
||||
end;
|
||||
rx := mx;
|
||||
ry := my;
|
||||
if (lx<>0) AND (ly<>0) AND ((rx<>orx) OR (ry<>ory)) AND NOT (rs) then begin
|
||||
ShowMouse(false);
|
||||
SetColor(0);
|
||||
Rectangle(lx,ly,orx,ory);
|
||||
SetColor(15);
|
||||
Rectangle(lx,ly,rx,ry);
|
||||
ShowMouse(true);
|
||||
orx := rx;
|
||||
ory := ry;
|
||||
end;
|
||||
if (lx<>0) AND (ly<>0) AND (rx<>0) AND (ry<>0) AND (mb=1) then begin
|
||||
rs := true;
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
until (mb=0);
|
||||
end;
|
||||
omx := mx;
|
||||
omy := my;
|
||||
omb := mb;
|
||||
Bar(1,1,150,30);
|
||||
OutTextXY(1,1,'X:'+Num2Str(mx)+' Y:'+Num2Str(my)+' Buttons:'+Num2Str(mb));
|
||||
until (ls) AND (rs);
|
||||
end;
|
||||
|
||||
begin
|
||||
GraphInit;
|
||||
fo_del := 0;
|
||||
InitPalette;
|
||||
MouseReset;
|
||||
ShowMouse(true);
|
||||
SetFillStyle(SolidFill,0);
|
||||
SetTextStyle(SmallFont,HorizDir,4);
|
||||
SetColor(15);
|
||||
SetRect;
|
||||
Alert('Fertich!!');
|
||||
FadeOut;
|
||||
GraphOutit;
|
||||
end.
|
||||
86
ITG/MITARB.PAS
Normal file
86
ITG/MITARB.PAS
Normal file
@ -0,0 +1,86 @@
|
||||
program Mitarbeiter;
|
||||
|
||||
uses Crt;
|
||||
|
||||
{ 1..8 = Abteilung
|
||||
1..6 = Altersgruppe:
|
||||
1 - 16-19
|
||||
2 - 20-24
|
||||
3 - 25-35
|
||||
4 - 36-49
|
||||
5 - 50-60
|
||||
6 - >60
|
||||
1..2 = Geschlecht:
|
||||
1 - m„nnlich
|
||||
2 - weiblich }
|
||||
|
||||
var Arbeiter: array[1..8,1..6,1..2] of byte;
|
||||
|
||||
procedure InitArray;
|
||||
var i,j: byte;
|
||||
begin
|
||||
Randomize;
|
||||
for i:=1 to 8 do
|
||||
for j:=1 to 6 do begin
|
||||
Arbeiter[i,j,1] := Random(250);
|
||||
Arbeiter[i,j,2] := Random(250);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetMalesFromAbt(abt: byte): integer;
|
||||
var i: byte;
|
||||
m: integer;
|
||||
begin
|
||||
m := 0;
|
||||
for i:=1 to 6 do begin
|
||||
m := m + Arbeiter[abt,i,1];
|
||||
end;
|
||||
GetMalesFromAbt := m;
|
||||
end;
|
||||
|
||||
function GetFemsFromAbt(abt: byte): integer;
|
||||
var i: byte;
|
||||
f: integer;
|
||||
begin
|
||||
f := 0;
|
||||
for i:=1 to 6 do begin
|
||||
f := f + Arbeiter[abt,i,2];
|
||||
end;
|
||||
GetFemsFromAbt := f;
|
||||
end;
|
||||
|
||||
function GetPeopleInAbt(abt: byte): integer;
|
||||
var i: byte;
|
||||
a: integer;
|
||||
begin
|
||||
a := 0;
|
||||
for i:=1 to 6 do a := a + Arbeiter[abt,i,1] + Arbeiter[abt,i,2];
|
||||
GetPeopleInAbt := a;
|
||||
end;
|
||||
|
||||
procedure GetInfo;
|
||||
var i,j: byte;
|
||||
m,w: integer;
|
||||
begin
|
||||
m := 0;
|
||||
w := 0;
|
||||
for i:=1 to 8 do
|
||||
for j:=1 to 6 do begin
|
||||
m:=m+Arbeiter[i,j,1];
|
||||
w:=w+Arbeiter[i,j,2];
|
||||
end;
|
||||
WriteLn('Anzahl m„nnlicher Mitarbeiter firmenweit: ',m);
|
||||
WriteLn('Anzahl weiblicher Mitarbeiter firmenweit: ',w);
|
||||
for i:=1 to 8 do WriteLn('Mitarbeiter in Abteilung ',i:1,': ',GetPeopleInAbt(i):4,
|
||||
' (',GetMalesFromAbt(i):4,' M„nner/',GetFemsFromAbt(i):4,' Frauen)');
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
InitArray;
|
||||
ClrScr;
|
||||
GetInfo;
|
||||
ReadKey;
|
||||
|
||||
|
||||
end.
|
||||
19
ITG/NUMLOOSE.PAS
Normal file
19
ITG/NUMLOOSE.PAS
Normal file
@ -0,0 +1,19 @@
|
||||
program NumberLoose;
|
||||
|
||||
var input: string;
|
||||
|
||||
function Zahl(S: string): longint;
|
||||
var i: integer;
|
||||
tmp: longint;
|
||||
begin
|
||||
tmp := 0;
|
||||
for i:=1 to Length(s) do
|
||||
if Ord(s[i]) IN [48..57] then tmp:=tmp*10+Ord(s[i])-48;
|
||||
Zahl := tmp;
|
||||
end;
|
||||
|
||||
begin
|
||||
Write('blabla eingeben: ');
|
||||
ReadLn(input);
|
||||
WriteLn('Ord vom blabla: ',Zahl(input));
|
||||
end.
|
||||
36
ITG/PACKEN.PAS
Normal file
36
ITG/PACKEN.PAS
Normal file
@ -0,0 +1,36 @@
|
||||
uses Crt;
|
||||
|
||||
const personen: array[1..10] of string=('Bert','','Ernie','Wilma','','Fred','Barney','','Ger”llheimer','Horst');
|
||||
|
||||
procedure Zaehle;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure Ausgabe;
|
||||
var i: byte;
|
||||
begin
|
||||
WriteLn('<==*==>');
|
||||
for i:=1 to 10 do WriteLn(personen[i]);
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
procedure Packe;
|
||||
var i,a: integer;
|
||||
begin
|
||||
for i:=1 to 10 do begin
|
||||
if (personen[i]='') then begin
|
||||
for a:=i to 10 do begin
|
||||
personen[a]:=personen[a+1];
|
||||
end;
|
||||
end;
|
||||
Write(i,': '); Ausgabe;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
Zaehle;
|
||||
Packe;
|
||||
Ausgabe;
|
||||
end.
|
||||
201
ITG/PUMPE.PAS
Normal file
201
ITG/PUMPE.PAS
Normal file
@ -0,0 +1,201 @@
|
||||
program Pumpensteuerung;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const Full='ÛÛÛÛÛÛÛÛÛ';
|
||||
Half='ÜÜÜÜÜÜÜÜÜ';
|
||||
Empt=' ';
|
||||
timemult: integer=10;
|
||||
B1E: boolean=true;
|
||||
B2E: boolean=true;
|
||||
B1D: integer=4;
|
||||
B2D: integer=4;
|
||||
B1: real=2950;
|
||||
B2: real=2750;
|
||||
|
||||
var Y1,Y2,Y3,A,B,C,D: boolean;
|
||||
x: char;
|
||||
|
||||
{ 1 Beh„lter = 5700 l = in 2 Minuten voll }
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
ClrScr;
|
||||
TextColor(7);
|
||||
GotoXY(20,18); Write('1 - B1',#127,' an/aus');
|
||||
GotoXY(20,19); Write('Q - B1',#127,'max +600');
|
||||
GotoXY(20,20); Write('A - B1',#127,'max -600');
|
||||
GotoXY(50,18); Write('2 - B2',#127,' an/aus');
|
||||
GotoXY(50,19); Write('W - B2',#127,'max +600');
|
||||
GotoXY(50,20); Write('S - B2',#127,'max -600');
|
||||
GotoXY(35,22); Write('^ - Ventil umschalten');
|
||||
GotoXY(35,23); Write('E - Zeitraffer +1');
|
||||
GotoXY(35,24); Write('D - Zeitraffer -1');
|
||||
GotoXY(33,25); Write('ESC - Simulation beenden');
|
||||
Randomize;
|
||||
Y1 := false;
|
||||
Y2 := false;
|
||||
Y3 := false;
|
||||
end;
|
||||
|
||||
procedure SetLEDs;
|
||||
var a: byte absolute 0:1047;
|
||||
begin
|
||||
a := 0;
|
||||
if Y1 then Inc(a,32);
|
||||
if Y2 then Inc(a,64);
|
||||
if Y3 then Inc(a,16);
|
||||
end;
|
||||
|
||||
procedure ResetLEDs;
|
||||
var a: byte absolute 0:1047;
|
||||
begin
|
||||
a := 32;
|
||||
end;
|
||||
|
||||
procedure DrawPumpe;
|
||||
var i: integer;
|
||||
begin
|
||||
GotoXY(1,1); if Y1 then TextColor(14) else TextColor(8); Write('Y1 (NUM)');
|
||||
GotoXY(1,2); if Y2 then TextColor(14) else TextColor(8); Write('Y2 (CAPS)');
|
||||
GotoXY(1,3); if Y3 then TextColor(14) else TextColor(8); Write('Y3 (SCROLL)');
|
||||
GotoXY(1,5); if (B1E) then TextColor(15) else TextColor(8);
|
||||
Write('B1',#127,'max: ',B1D*600:5,' l/min');
|
||||
GotoXY(1,6); if (B2E) then TextColor(15) else TextColor(8);
|
||||
Write('B2',#127,'max: ',B2D*600:5,' l/min');
|
||||
TextColor(15);
|
||||
GotoXY(1,8); Write('Zeitraffung: ',timemult:2,'x');
|
||||
|
||||
if (Y1) OR (Y2) then TextColor(11) else TextColor(7);
|
||||
GotoXY(40, 5); Write('ÚÄÄÄÄÄÄÄ');
|
||||
if (Y1) OR (Y2) then TextColor(10+blink); Write('(P)');
|
||||
TextColor(15);
|
||||
if NOT (Y1) AND NOT (Y2) then Write(' [0 l/min] ');
|
||||
if NOT (Y1) AND (Y2) then Write(' [750 l/min] ');
|
||||
if (Y1) AND NOT (Y2) then Write(' [1450 l/min] ');
|
||||
if (Y1) AND (Y2) then Write(' [2850 l/min] ');
|
||||
if (Y1) OR (Y2) then TextColor(11) else TextColor(7);
|
||||
GotoXY(40, 6); Write('³');
|
||||
GotoXY(39,7); if Y3 then Write(' ÀÄ') else Write('ÄÙ ');
|
||||
|
||||
GotoXY(25,7);
|
||||
if NOT (Y3) AND ((Y2) OR (Y1)) then TextColor(11) else TextColor(7);
|
||||
Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄ');
|
||||
GotoXY(42,7);
|
||||
if (Y3) AND ((Y2) OR (Y1)) then TextColor(11) else TextColor(7);
|
||||
Write('ÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
|
||||
|
||||
for i:=1 to 7 do begin
|
||||
if (B1E) then TextColor(15) else TextColor(8);
|
||||
GotoXY(20,7+i); Write('³');
|
||||
if (B1>=950*(8-i)) then Write(Full)
|
||||
else if (B1>=950*(8-i)-475) then Write(Half)
|
||||
else Write(Empt);
|
||||
Write('³');
|
||||
if (B2E) then TextColor(15) else TextColor(8);
|
||||
GotoXY(50,7+i); Write('³');
|
||||
if (B2>=950*(8-i)) then Write(Full)
|
||||
else if (B2>=950*(8-i)-475) then Write(Half)
|
||||
else Write(Empt);
|
||||
Write('³');
|
||||
end;
|
||||
|
||||
if (B1E) then TextColor(15) else TextColor(8);
|
||||
GotoXY(19,15); Write('ÚÁÄ[',B1:4:0,'l]ÄÙ');
|
||||
GotoXY(19,16); Write('³');
|
||||
if (B2E) then TextColor(15) else TextColor(8);
|
||||
GotoXY(50,15); Write('ÀÄ[',B2:4:0,'l]ÄÁ¿');
|
||||
GotoXY(61,16); Write('³');
|
||||
|
||||
GotoXY(31,9); if (A) then TextColor(14) else TextColor(8); Write('ß A');
|
||||
GotoXY(31,12); if (C) then TextColor(14) else TextColor(8); Write('ß C');
|
||||
GotoXY(47,9); if (B) then TextColor(14) else TextColor(8); Write('B ß');
|
||||
GotoXY(47,12); if (D) then TextColor(14) else TextColor(8); Write('D ß');
|
||||
end;
|
||||
|
||||
procedure CalcSensors;
|
||||
begin
|
||||
if (B1>=5700) then A := true else A := false;
|
||||
if (B1>=2850) then C := true else C := false;
|
||||
if (B2>=5700) then B := true else B := false;
|
||||
if (B2>=2850) then D := true else D := false;
|
||||
end;
|
||||
|
||||
procedure CalcSteering;
|
||||
begin
|
||||
if (A) AND (B) AND (C) AND (D) then begin
|
||||
Y1 := false;
|
||||
Y2 := false;
|
||||
end;
|
||||
if NOT (A) AND NOT (B) AND NOT (C) AND NOT (D) then begin
|
||||
Y1 := true;
|
||||
Y2 := true;
|
||||
end;
|
||||
if ((A) AND NOT (B)) OR (NOT (A) AND (B)) AND (C) AND (D) then begin
|
||||
Y1 := false;
|
||||
Y2 := true;
|
||||
end;
|
||||
if (NOT (A) AND NOT (B) AND (C) AND (D))
|
||||
OR ((A) AND NOT (B) AND (C) AND NOT (D))
|
||||
OR (NOT (A) AND (B) AND NOT (C) AND (D)) then begin
|
||||
Y1 := true;
|
||||
Y2 := false;
|
||||
end;
|
||||
|
||||
if (A) AND NOT (B) then Y3 := true;
|
||||
if (B) AND NOT (A) then Y3 := false;
|
||||
if (C) AND NOT (D) then Y3 := true;
|
||||
if (D) AND NOT (C) then Y3 := false;
|
||||
end;
|
||||
|
||||
procedure NimmWas;
|
||||
var x: integer;
|
||||
begin
|
||||
if (B1E) then begin
|
||||
x := Round(Random(B1D*2)/2)*timemult;
|
||||
if (B1-x<0) then B1 := 0 else B1 := B1 - x;
|
||||
end;
|
||||
if (B2E) then begin
|
||||
x := Round(Random(B2D*2)/2)*timemult;
|
||||
if (B2-x<0) then B2 := 0 else B2 := B2 - x;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Pump;
|
||||
var sp: real;
|
||||
begin
|
||||
if NOT (Y1) AND NOT (Y2) then sp := 0;
|
||||
if NOT (Y1) AND (Y2) then sp := 750 / (600/timemult);
|
||||
if (Y1) AND NOT (Y2) then sp := 1450 / (600/timemult);
|
||||
if (Y1) AND (Y2) then sp := 2850 / (600/timemult);
|
||||
|
||||
if (Y3) then B2 := B2 + sp else B1 := B1 + sp;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
repeat
|
||||
CalcSensors;
|
||||
CalcSteering;
|
||||
SetLEDs;
|
||||
NimmWas;
|
||||
DrawPumpe;
|
||||
Pump;
|
||||
Delay(100);
|
||||
if (keypressed) then x := ReadKey else x := #000;
|
||||
if (x<>#000) then begin
|
||||
case x of
|
||||
'1','!': if (B1E) then B1E := false else B1E := true;
|
||||
'2','"': if (B2E) then B2E := false else B2E := true;
|
||||
'q','Q': if B1D<20 then Inc(B1D);
|
||||
'a','A': if B1D>0 then Dec(B1D);
|
||||
'w','W': if B2D<20 then Inc(B2D);
|
||||
's','S': if B2D>0 then Dec(B2D);
|
||||
'^','ø': if (Y3) then Y3 := false else Y3 := true;
|
||||
'e','E': if timemult<50 then Inc(timemult);
|
||||
'd','D': if timemult>1 then Dec(timemult);
|
||||
end;
|
||||
end;
|
||||
until x=#027;
|
||||
ResetLEDs;
|
||||
end.
|
||||
23
ITG/QUERSUM.PAS
Normal file
23
ITG/QUERSUM.PAS
Normal file
@ -0,0 +1,23 @@
|
||||
program Quersumme;
|
||||
|
||||
var Zahl: longint;
|
||||
|
||||
function Quer(zahl: longint): integer;
|
||||
var conv: string;
|
||||
i,q,tmp,ec: integer;
|
||||
|
||||
begin
|
||||
Str(zahl,conv);
|
||||
q := 0;
|
||||
for i:=1 to Length(conv) do begin
|
||||
Val(conv[i],tmp, ec);
|
||||
if ec=0 then q:=q + tmp;
|
||||
end;
|
||||
Quer := q;
|
||||
end;
|
||||
|
||||
begin
|
||||
Write('Tipp ''ne Ganzzahl ein: ');
|
||||
ReadLn(Zahl);
|
||||
WriteLn('Quersumme von ',Zahl:0,' ist ',Quer(Zahl),'.');
|
||||
end.
|
||||
23
ITG/QUICKSOR.PAS
Normal file
23
ITG/QUICKSOR.PAS
Normal file
@ -0,0 +1,23 @@
|
||||
procedure quicksort(anfang,ende : integer; var f : feldtyp);
|
||||
var links, rechts : integer;
|
||||
h, vgl : elementtyp;
|
||||
begin
|
||||
links := anfang; rechts := ende; vgl := f[(links+rechts) div 2];
|
||||
|
||||
if links < rechts then
|
||||
begin
|
||||
repeat
|
||||
while f[links]< vgl do inc(links);
|
||||
while f[rechts]> vgl do dec(rechts);
|
||||
if links <= rechts then
|
||||
begin
|
||||
h:=f[links];
|
||||
f[links]:= f[rechts];
|
||||
f[rechts]:=h;
|
||||
inc(links); dec(rechts);
|
||||
end;
|
||||
until links > rechts;
|
||||
quicksort(anfang,rechts,f);
|
||||
quicksort(links,ende,f);
|
||||
end;
|
||||
end;
|
||||
12
ITG/RECORDS.PAS
Normal file
12
ITG/RECORDS.PAS
Normal file
@ -0,0 +1,12 @@
|
||||
program Records;
|
||||
|
||||
uses Crt;
|
||||
|
||||
type TAdr=record
|
||||
N,V: string;
|
||||
A: byte;
|
||||
end;
|
||||
|
||||
var Adr1, Adr2: TAdr;
|
||||
|
||||
begin
|
||||
93
ITG/REKGRAF1.PAS
Normal file
93
ITG/REKGRAF1.PAS
Normal file
@ -0,0 +1,93 @@
|
||||
Uses CRT,Graph;
|
||||
var globalwinkel:integer;
|
||||
graphdriver,graphmode:integer;
|
||||
|
||||
Procedure GrafikAn;
|
||||
begin
|
||||
graphdriver:=detect;
|
||||
initgraph(graphdriver,graphmode,'F:\SPRACHEN\BP\BGI');
|
||||
setgraphmode(graphmode);
|
||||
end;
|
||||
Procedure GrafikAus;
|
||||
begin
|
||||
clearviewport;
|
||||
restorecrtmode;
|
||||
closegraph;
|
||||
end;
|
||||
Procedure Init;
|
||||
begin
|
||||
clearviewport;
|
||||
setcolor(14);
|
||||
moveto (230,400);
|
||||
globalwinkel:=0;
|
||||
end;
|
||||
|
||||
Procedure turnleft (var winkel:integer);
|
||||
begin
|
||||
globalwinkel:=(globalwinkel-winkel) mod 360
|
||||
end;
|
||||
Procedure turnright (var winkel:integer);
|
||||
begin
|
||||
globalwinkel:=(globalwinkel+winkel) mod 360
|
||||
end;
|
||||
Procedure forwd (strecke:integer);
|
||||
var hilf:real;
|
||||
begin
|
||||
hilf:=globalwinkel*pi/180;
|
||||
linerel(round(strecke*cos(hilf)),
|
||||
round(strecke*sin(hilf)))
|
||||
end;
|
||||
|
||||
Procedure Haken(Laenge,Winkel : integer);
|
||||
begin
|
||||
if Laenge > 1 then
|
||||
begin
|
||||
Haken(Laenge - 1, Winkel);
|
||||
Forwd(Laenge);
|
||||
TurnLeft(Winkel);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure Quadrat(Laenge,Winkel:integer);
|
||||
Var seite:integer;
|
||||
begin
|
||||
if laenge >1 then
|
||||
begin
|
||||
for Seite := 1 to 4 do
|
||||
begin
|
||||
forwd(laenge);
|
||||
Turnleft(winkel);
|
||||
end;
|
||||
quadrat((Laenge*3) div 4,Winkel);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure spirale(laenge,winkel:integer);
|
||||
begin
|
||||
Forwd(Laenge div 2);
|
||||
Turnright(Winkel);
|
||||
if laenge < 80 then Spirale(laenge+1,winkel);
|
||||
end;
|
||||
|
||||
procedure skier(laenge,ecke:integer);
|
||||
var n : byte;
|
||||
w : integer;
|
||||
begin
|
||||
w := 360 div ecke;
|
||||
if laenge > 30 then
|
||||
for n := 1 to ecke do
|
||||
begin
|
||||
forwd(laenge);
|
||||
turnleft(w );
|
||||
skier(laenge div 2,ecke);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
GrafikAn;
|
||||
init; skier(120,10); readkey;
|
||||
init; Haken(150,45); readkey;
|
||||
init; Quadrat(150,90); readkey;
|
||||
init; Spirale(10,25); readkey;
|
||||
GrafikAus;
|
||||
end.
|
||||
33
ITG/REPSTRNG.PAS
Normal file
33
ITG/REPSTRNG.PAS
Normal file
@ -0,0 +1,33 @@
|
||||
program ConvUmlaut;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var mystr: string;
|
||||
|
||||
procedure ChangeAll(var text: string; what, targ: string);
|
||||
var x: byte;
|
||||
begin
|
||||
while Pos(what,text) > 0 do begin
|
||||
x := Pos(what,text);
|
||||
Delete(text,x,1);
|
||||
Insert(targ,text,x);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
mystr := 'x';
|
||||
while mystr<>'' do begin
|
||||
Write('Dein Text mit Umlauten: ');
|
||||
ReadLn(mystr);
|
||||
ChangeAll(mystr,'„','ae');
|
||||
ChangeAll(mystr,'”','oe');
|
||||
ChangeAll(mystr,'<27>','ue');
|
||||
ChangeAll(mystr,'Ž','AE');
|
||||
ChangeAll(mystr,'™','OE');
|
||||
ChangeAll(mystr,'š','UE');
|
||||
ChangeAll(mystr,'á','ss');
|
||||
Write('Dein Text ohne Umlaute: ');
|
||||
WriteLn(mystr);
|
||||
end;
|
||||
end.
|
||||
91
ITG/ROBOCARD.PAS
Normal file
91
ITG/ROBOCARD.PAS
Normal file
@ -0,0 +1,91 @@
|
||||
program RoboCarder;
|
||||
|
||||
{ MOD-10 algorithm
|
||||
|
||||
first digit: kind of credit card ( 3-AMEX, 4-VISA, 5-MC )
|
||||
|
||||
length
|
||||
------
|
||||
AMEX - 15 digits
|
||||
VISA - 16 digits, sometimes 13
|
||||
all other - 16 digits
|
||||
|
||||
validation
|
||||
----------
|
||||
begin at the rightmost digit and go to the left.
|
||||
the odd digits are all sum'd up. the even (every 2nd) digits are
|
||||
multiplied by 2. if the result is greater than 9, 9 is substracted.
|
||||
this resulting value is added to the sum.
|
||||
|
||||
sum MOD 10 must be 0.
|
||||
|
||||
}
|
||||
|
||||
|
||||
uses Crt;
|
||||
|
||||
const bigdigit: array[0..9,1..3] of string[5] = ( ('23332','10001','03330'),
|
||||
{ 1 } ('02100','00100','00300'),
|
||||
{ 2 } ('33332','23330','33333'),
|
||||
{ 3 } ('33332','03332','33330'),
|
||||
{ 4 } ('10010','33313','00030'),
|
||||
{ 5 } ('13333','33332','33330'),
|
||||
{ 6 } ('23333','13332','03330'),
|
||||
{ 7 } ('33313','02300','30000'),
|
||||
{ 8 } ('23332','23332','03330'),
|
||||
{ 9 } ('23332','03331','33330'));
|
||||
|
||||
var inp: string[16];
|
||||
|
||||
procedure CheckValidity(x: string);
|
||||
var i,sum,tmp,ec: integer;
|
||||
begin
|
||||
WriteLn('Number length: ',Length(x));
|
||||
Val(x[1],tmp,ec);
|
||||
case tmp of
|
||||
3: WriteLn('Type: American Express');
|
||||
4: WriteLn('Type: VISA');
|
||||
5: WriteLn('Type: MasterCard');
|
||||
end;
|
||||
sum := 0;
|
||||
for i:=1 to Length(x) do begin
|
||||
Val(x[Length(x)-i+1],tmp,ec);
|
||||
if i MOD 2=0 then tmp := tmp*2;
|
||||
if tmp>9 then tmp := tmp-9;
|
||||
sum := sum + tmp;
|
||||
end;
|
||||
WriteLn('Quersumme: ',sum);
|
||||
if sum MOD 10=0 then WriteLn('VALID') else WriteLn('INVALID!!!');
|
||||
end;
|
||||
|
||||
procedure BigWrite(w: string;x,y: word);
|
||||
var i,j,k,ec: integer;
|
||||
tmp: byte;
|
||||
begin
|
||||
for k:=1 to Length(w) do begin
|
||||
for j:=1 to 3 do begin
|
||||
GotoXY(x+(k-1)*6,y+j-1);
|
||||
for i:=1 to 5 do begin
|
||||
Val(w[k],tmp,ec);
|
||||
case bigdigit[tmp,j][i] of
|
||||
'0': Write(' ');
|
||||
'1': Write('Û');
|
||||
'2': Write('Ü');
|
||||
'3': Write('ß');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
GotoXY(1,7);
|
||||
Write('Enter Credit Card number: ');
|
||||
ReadLn(inp);
|
||||
BigWrite(Copy(inp,1,8),1,1);
|
||||
BigWrite(Copy(inp,9,8),1,4);
|
||||
GotoXY(1,8);
|
||||
CheckValidity(inp);
|
||||
ReadKey;
|
||||
end.
|
||||
87
ITG/SATZANAL.PAS
Normal file
87
ITG/SATZANAL.PAS
Normal file
@ -0,0 +1,87 @@
|
||||
program Sentencizer;
|
||||
|
||||
uses Crt, VFx;
|
||||
|
||||
type TZeichenMenge = Set of Char;
|
||||
|
||||
var Ziffern, Buchstaben, Sonstige,
|
||||
Vokale, Konsonanten, Urmenge, Umlaute: TZeichenMenge;
|
||||
Zi, Bu, So, Vo, Um, Leer, i : byte;
|
||||
Satz : String[80];
|
||||
|
||||
|
||||
procedure Input;
|
||||
begin
|
||||
Write('Bitte den Satz eingeben: ');
|
||||
ReadLn(Satz);
|
||||
WriteLn(' ==> Dankesch”n!');
|
||||
Zi := 0;
|
||||
Bu := 0;
|
||||
So := 0;
|
||||
Vo := 0;
|
||||
Um := 0;
|
||||
Leer := 0;
|
||||
Ziffern := ['0'..'9'];
|
||||
Buchstaben := ['a'..'z','A'..'Z'];
|
||||
Sonstige := ['!'..'}']-(Ziffern + Buchstaben);
|
||||
Vokale := ['a','e','i','o','u','A','E','I','O','U'];
|
||||
Umlaute := ['„','”','<27>','Ž','™','š'];
|
||||
Konsonanten := Buchstaben - Vokale;
|
||||
Urmenge := [];
|
||||
end;
|
||||
|
||||
procedure Analyze;
|
||||
begin
|
||||
Write(MultiChar('-',80));
|
||||
Write('Analyse l„uft: Durchz„hlen ... ');
|
||||
for i:=1 to Length(Satz) do begin
|
||||
if Satz[i] IN Buchstaben then Inc(Bu)
|
||||
else if Satz[i] IN Ziffern then Inc(Zi)
|
||||
else if Satz[i] IN Umlaute then Inc(Um)
|
||||
else if Satz[i]=' ' then Inc(Leer)
|
||||
else Inc(So);
|
||||
if Satz[i] IN Vokale then Inc(Vo);
|
||||
Urmenge := Urmenge + [Satz[i]];
|
||||
end;
|
||||
Write('Ausstreichen ... ');
|
||||
Vokale := Vokale * Urmenge;
|
||||
Konsonanten := Konsonanten * Urmenge;
|
||||
Ziffern := Ziffern * Urmenge;
|
||||
Umlaute := Umlaute * Urmenge;
|
||||
Sonstige := Sonstige * Urmenge;
|
||||
WriteLn('fertig!');
|
||||
end;
|
||||
|
||||
procedure OutputSet(which: TZeichenMenge);
|
||||
var Ch: char;
|
||||
begin
|
||||
for Ch:=' ' to 'ÿ' do
|
||||
if Ch IN which then Write(Ch);
|
||||
WriteLn;
|
||||
end;
|
||||
|
||||
procedure Output;
|
||||
begin
|
||||
Write(MultiChar('-',80));
|
||||
WriteLn('Originalsatz: ',Satz);
|
||||
WriteLn('Anzahl Buchstaben: ',Bu);
|
||||
WriteLn('Anzahl Vokale : ',Vo,' -- Konsonanten: ',Bu-Vo);
|
||||
WriteLn('Anzahl Umlaute : ',Um);
|
||||
WriteLn('Anzahl Ziffern : ',Zi);
|
||||
WriteLn('Anzahl Leerzeichn: ',Leer);
|
||||
WriteLn('Anzahl sonstiges : ',So);
|
||||
WriteLn;
|
||||
Write('Vokale : '); OutputSet(Vokale);
|
||||
Write('Konsonanten: '); OutputSet(Konsonanten);
|
||||
Write('Umlaute : '); OutputSet(Umlaute);
|
||||
Write('Ziffern : '); OutputSet(Ziffern);
|
||||
Write('sonstiges : '); OutputSet(Sonstige);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
Input;
|
||||
Analyze;
|
||||
Output;
|
||||
end.
|
||||
75
ITG/SEARCH.PAS
Normal file
75
ITG/SEARCH.PAS
Normal file
@ -0,0 +1,75 @@
|
||||
program Searches;
|
||||
|
||||
const max=30000;
|
||||
|
||||
var F: array[1..max] of word;
|
||||
S4: word;
|
||||
sp: integer;
|
||||
comp: integer;
|
||||
|
||||
procedure Init;
|
||||
var x: word;
|
||||
i: word;
|
||||
begin
|
||||
comp := 0;
|
||||
x := 0;
|
||||
for i:=1 to max do begin
|
||||
x := x + Random(3) + 1;
|
||||
F[i] := x;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SearchFor;
|
||||
var x: integer;
|
||||
begin
|
||||
WriteLn('Geben Sie die Arrayposition des zu suchenden Elements ein!');
|
||||
Write('(Zahl zwischen 1 und ',max:0,'): ');
|
||||
ReadLn(x);
|
||||
S4 := F[x];
|
||||
Write('Suche jetzt nach ',S4,' ');
|
||||
end;
|
||||
|
||||
function bin_searchrekursiv(left, right, key: word): word;
|
||||
var x,n: word;
|
||||
begin
|
||||
Inc(comp);
|
||||
Write('.');
|
||||
if left>right then bin_searchrekursiv:=0
|
||||
else begin
|
||||
x := (left+right) DIV 2;
|
||||
if key < F[x] then bin_searchrekursiv:=bin_searchrekursiv(left, x-1, key)
|
||||
else if key > F[x] then bin_searchrekursiv:=bin_searchrekursiv(x+1,right, key) else bin_searchrekursiv := x;
|
||||
end;
|
||||
end;
|
||||
|
||||
function bin_searchiterativ(key: word): word;
|
||||
var left, right, x: word;
|
||||
begin
|
||||
left := 1;
|
||||
right := max;
|
||||
repeat
|
||||
x := (left + right) DIV 2;
|
||||
if key<F[x] then right := x-1 else left := x+1;
|
||||
Inc(comp);
|
||||
Write('.');
|
||||
until (key=F[x]) OR (left>right);
|
||||
if key=F[x] then bin_searchiterativ := x
|
||||
else bin_searchiterativ := 0;
|
||||
end;
|
||||
|
||||
procedure Stats;
|
||||
begin
|
||||
WriteLn(' gefunden an Stelle ',sp:0);
|
||||
Write(comp:0,' Vergleichsoperation');
|
||||
if (comp>1) then WriteLn('en') else WriteLn;
|
||||
end;
|
||||
|
||||
begin
|
||||
Randomize;
|
||||
Init;
|
||||
SearchFor;
|
||||
{ sp := bin_searchiterativ(S4); }
|
||||
sp := bin_searchrekursiv(1,max,S4);
|
||||
Stats;
|
||||
WriteLn('<=======****=======>');
|
||||
end.
|
||||
50
ITG/SECHSER.PAS
Normal file
50
ITG/SECHSER.PAS
Normal file
@ -0,0 +1,50 @@
|
||||
program Sechsen;
|
||||
|
||||
|
||||
var take: longint;
|
||||
sixs: longint;
|
||||
thrw: longint;
|
||||
succ: boolean;
|
||||
|
||||
function Throw: byte;
|
||||
begin
|
||||
Throw := Random(6)+1;
|
||||
end;
|
||||
|
||||
procedure TripleThrowUntilSix;
|
||||
var i,t: byte;
|
||||
begin
|
||||
Write(take:5,'#',sixs:5,'#',thrw:8,' : ');
|
||||
succ := false;
|
||||
for i:=1 to 3 do begin
|
||||
t:=Throw;
|
||||
Write(t,' ');
|
||||
Inc(thrw);
|
||||
if t=6 then begin
|
||||
WriteLn;
|
||||
Inc(sixs);
|
||||
Inc(take);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Inc(take);
|
||||
WriteLn;
|
||||
end;
|
||||
|
||||
begin
|
||||
sixs := 0;
|
||||
thrw := 0;
|
||||
take := 0;
|
||||
Randomize;
|
||||
repeat
|
||||
TripleThrowUntilSix;
|
||||
until take=1000;
|
||||
WriteLn(' TAKE sixes throws : # # #');
|
||||
WriteLn('<===========>');
|
||||
WriteLn('Takes: ',take);
|
||||
WriteLn('Sixes: ',sixs);
|
||||
WriteLn('Fails: ',thrw-sixs);
|
||||
WriteLn('Thrws: ',thrw);
|
||||
WriteLn('Quota of throws: ',(sixs/thrw)*100:3:2,' per cent');
|
||||
WriteLn('Quota of takes : ',(sixs/take)*100:3:2,' per cent');
|
||||
end.
|
||||
202
ITG/SORT.PAS
Normal file
202
ITG/SORT.PAS
Normal file
@ -0,0 +1,202 @@
|
||||
program Sorts;
|
||||
|
||||
uses Crt, VFx;
|
||||
|
||||
const max = 200;
|
||||
|
||||
type elementtype = integer;
|
||||
Arraytype = array[0..max] of elementtype;
|
||||
|
||||
var count: integer;
|
||||
xarr: arraytype;
|
||||
oarr: arraytype;
|
||||
|
||||
procedure Banner(what: string);
|
||||
begin
|
||||
drwdmax:=0;
|
||||
DrawBorder(Length(what) DIV 2+5,3,15,1,6);
|
||||
Write(' ',what);
|
||||
ReadKey;
|
||||
Window(1,1,80,50);
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
end;
|
||||
|
||||
procedure Check(var f:arraytype);
|
||||
var i,cnt: integer;
|
||||
begin
|
||||
i:=0;
|
||||
cnt:=0;
|
||||
repeat
|
||||
Inc(i);
|
||||
Inc(cnt);
|
||||
until (F[i]=0) AND (F[i-1]=0);
|
||||
F[0] := cnt;
|
||||
end;
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
TextMode(co80 + Font8x8);
|
||||
Randomize;
|
||||
end;
|
||||
|
||||
(***************************************************************************
|
||||
************ Array-Initialisierungen **************************************
|
||||
***************************************************************************)
|
||||
|
||||
procedure Init_clear(var f:arraytype);
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to max do F[i]:=0;
|
||||
end;
|
||||
|
||||
procedure Init_Random(var f:arraytype);
|
||||
var i: integer;
|
||||
begin
|
||||
{ for i:=1 to max do f[i]:=(Random(65535)-32767); }
|
||||
for i:=1 to max do f[i]:=Random(32768);
|
||||
F[0]:=max;
|
||||
end;
|
||||
|
||||
procedure Init_Inc(var f:arraytype);
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to max do F[i]:=i;
|
||||
F[0]:=max;
|
||||
end;
|
||||
|
||||
procedure Init_Dec(var f:arraytype);
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to max do F[i]:=max-i+1;
|
||||
F[0]:=max;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure OutArray(f: arraytype; var fo: arraytype);
|
||||
const maxlines=50;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to F[0] do begin
|
||||
if i<=maxlines then GotoXY(1,i)
|
||||
else if i<=maxlines*2 then GotoXY(20,i-maxlines)
|
||||
else if i<=maxlines*3 then GotoXY(40,i-maxlines*2)
|
||||
else if i<=maxlines*4 then GotoXY(60,i-maxlines*3);
|
||||
TextColor(7);
|
||||
Write(i:3,': ');
|
||||
if (F[i]<>Fo[i]) then TextColor(14) else TextColor(7);
|
||||
Write(F[i]:10);
|
||||
{ Delay(5); }
|
||||
end;
|
||||
fo := f;
|
||||
{ ReadKey; }
|
||||
Delay(100);
|
||||
end;
|
||||
|
||||
procedure Swap(var x1,x2: elementtype);
|
||||
var tmp: elementtype;
|
||||
begin
|
||||
tmp := x1;
|
||||
x1 := x2;
|
||||
x2 := tmp;
|
||||
end;
|
||||
|
||||
|
||||
procedure Sort_Bubblesort(var f:arraytype);
|
||||
var i: integer;
|
||||
canswap: boolean;
|
||||
tmp: elementtype;
|
||||
begin
|
||||
repeat
|
||||
canswap:=false;
|
||||
for i:=1 to F[0]-1 do begin
|
||||
if F[i]>F[i+1] then begin
|
||||
Swap(F[i],F[i+1]);
|
||||
canswap := true;
|
||||
end;
|
||||
end;
|
||||
until (NOT canswap);
|
||||
end;
|
||||
|
||||
procedure Sort_Simple(var f:arraytype);
|
||||
var i,j: integer;
|
||||
tmp: elementtype;
|
||||
begin
|
||||
for i:=1 to F[0]-1 do
|
||||
for j:=i+1 to F[0] do
|
||||
if F[j]<F[i] then begin
|
||||
Swap(F[i],F[j]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Sort_Selectionsort(var f:arraytype);
|
||||
var i,j,minpos: integer;
|
||||
tmp: elementtype;
|
||||
begin
|
||||
for i:=1 to F[0]-1 do begin
|
||||
minpos := i;
|
||||
for j:=i+1 to F[0] do if F[j]<F[minpos] then minpos:=j;
|
||||
Swap(F[i],F[minpos]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Sort_Insertionsort(n: integer; var f:arraytype);
|
||||
var h,i,j: integer;
|
||||
begin
|
||||
for i:=2 to n do begin
|
||||
h := f[i];
|
||||
f[1] := h;
|
||||
j := i-1;
|
||||
while h<f[j] do begin
|
||||
f[j+1] := f[j];
|
||||
if (i>2) then Dec(j) else exit;
|
||||
end;
|
||||
f[j+1] := h;
|
||||
OutArray(xarr,oarr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Sort_Shellsort(n: integer; var f:arraytype);
|
||||
var i,j,k,m: integer;
|
||||
goon: boolean;
|
||||
hilf: elementtype;
|
||||
begin
|
||||
m := n DIV 2;
|
||||
repeat
|
||||
for i:=1 to n-m do begin
|
||||
while f[i+m] < f[i] do begin
|
||||
hilf := f[i+m];
|
||||
j := i;
|
||||
goon := true;
|
||||
while (j>0) AND goon do begin
|
||||
if hilf<f[j] then begin
|
||||
f[j+m] := f[j];
|
||||
j := j-m;
|
||||
end else goon := false;
|
||||
end;
|
||||
f[j+m] := hilf;
|
||||
end;
|
||||
end;
|
||||
m := m DIV 2;
|
||||
OutArray(xarr,oarr);
|
||||
until m=0;
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
Banner('Init_Random');
|
||||
Init_Random(xarr);
|
||||
{ Banner('Init_Inc');
|
||||
Init_Inc(xarr); }
|
||||
{ Banner('Init_Dec');
|
||||
Init_Dec(xarr); }
|
||||
oarr := xarr;
|
||||
OutArray(xarr,oarr);
|
||||
{ Sort_Bubblesort(xarr); }
|
||||
{ Sort_Selectionsort(xarr); }
|
||||
{ Sort_Simple(xarr); }
|
||||
{ Sort_Insertionsort(xarr[0], xarr); }
|
||||
Sort_Shellsort(xarr[0], xarr);
|
||||
{ OutArray(xarr,oarr); }
|
||||
end.
|
||||
149
ITG/SORTCOMB.PAS
Normal file
149
ITG/SORTCOMB.PAS
Normal file
@ -0,0 +1,149 @@
|
||||
PROGRAM Combsorttest;
|
||||
USES crt,graph,dos;
|
||||
TYPE feld_ = array[0..3000] of word;
|
||||
VAR x : feld_;
|
||||
|
||||
{Grafik initialisieren}
|
||||
PROCEDURE graf;
|
||||
VAR gd,gm : integer;
|
||||
BEGIN
|
||||
gd:=detect;
|
||||
{evtl. Grafikpfad „ndern}
|
||||
initgraph(gd,gm,'c:\schuls~1\tp\bgi');
|
||||
if graphresult<>0 then halt(1);
|
||||
END;
|
||||
|
||||
{Zufallszahlen erzeugen}
|
||||
PROCEDURE zufall(n : integer;var a : feld_);
|
||||
VAR i : integer;
|
||||
BEGIN
|
||||
randomize;
|
||||
for i:=1 to n do
|
||||
a[i]:=random(n)+1;
|
||||
END;
|
||||
|
||||
|
||||
{ "Je nachdem, wie tief die Spalte geht!" (Zitat: Fr”bel) }
|
||||
PROCEDURE combsortdar;
|
||||
VAR x : feld_;
|
||||
s,s1,s2 : string;
|
||||
sorted : boolean;
|
||||
i,j,top,gap,h,n,z,z1,z2 : integer;
|
||||
|
||||
BEGIN
|
||||
n:=25;z:=0;z1:=0;z2:=0;
|
||||
setfillstyle(1,0);setcolor(15);
|
||||
bar(0,0,getmaxx,getmaxy);
|
||||
zufall(n,x);
|
||||
for i:=1 to n do begin
|
||||
str(x[i],s);
|
||||
if x[i]<10 then s:='0'+s;
|
||||
outtextxy(50+i*20,100,s);
|
||||
end;
|
||||
outtextxy(70,320,'Vergleichsabstand : 25');
|
||||
outtextxy(70,300,'Durchgang : 00');
|
||||
outtextxy(70,350,'Vertauschungen : 00');
|
||||
outtextxy(70,360,'Vergleiche : 00');
|
||||
gap:=n;
|
||||
repeat
|
||||
inc(z);
|
||||
gap:=trunc(gap/1.3); { Neue Schrittweite }
|
||||
if gap=0 then gap:=1
|
||||
else
|
||||
if (gap=9) or (gap=10) then gap:=11;
|
||||
setcolor(red);
|
||||
str(gap,s);if gap<10 then s:='0'+s;
|
||||
bar(230,320,250,330);outtextxy(230,320,s);
|
||||
setcolor(15);
|
||||
str(z,s);if z<10 then s:='0'+s;
|
||||
bar(230,300,250,310);outtextxy(230,300,s);
|
||||
sorted:=true; { Variable auf "sortiert" setzen }
|
||||
top:=n-gap; { Obergrenze f<>r Sortieren festlegen }
|
||||
for i:=1 to top do begin
|
||||
inc(z1);
|
||||
setcolor(15);
|
||||
str(z1,s);if z1<10 then s:='0'+s;
|
||||
bar(230,360,250,370);outtextxy(230,360,s);
|
||||
setcolor(blue);
|
||||
str(x[i],s1);if x[i]<10 then s1:='0'+s1;
|
||||
outtextxy(50+i*20,100,s1);
|
||||
str(x[i+gap],s2);if x[i+gap]<10 then s2:='0'+s2;
|
||||
outtextxy(50+(i+gap)*20,100,s2);
|
||||
setcolor(green);
|
||||
line(60+i*20,95,60+i*20,80);
|
||||
line(60+(i+gap)*20,95,60+(i+gap)*20,80);
|
||||
line(60+i*20,80,60+(i+gap)*20,80);
|
||||
bar(20,65,600,75);
|
||||
outtextxy(16+round((i+gap/2)*20),65,'VERGLEICHEN');
|
||||
delay(100);
|
||||
bar(20,65,600,75);
|
||||
if x[i]>x[i+gap] then begin { Vergleich von Elementen im Abstand "gap" }
|
||||
inc(z2);
|
||||
setcolor(15);
|
||||
str(z2,s);if z2<10 then s:='0'+s;
|
||||
bar(230,350,250,358);outtextxy(230,350,s);
|
||||
setcolor(green);
|
||||
outtextxy(16+round((i+gap/2)*20),65,'VERTAUSCHEN');
|
||||
for j:=100 to 120 do begin
|
||||
setcolor(blue);
|
||||
outtextxy(50+i*20,j,s1);
|
||||
outtextxy(50+(i+gap)*20,50+j div 2,s2);
|
||||
delay(1);
|
||||
bar(50+i*20,j,70+i*20,j+10);bar(50+(i+gap)*20,50+j div 2,70+(i+gap)*20,60+j div 2);
|
||||
end;
|
||||
for j:=1 to (gap*20) do begin
|
||||
setcolor(blue);
|
||||
outtextxy(50+i*20+j,120,s1);
|
||||
outtextxy(50+(i+gap)*20-j,110,s2);
|
||||
delay(1);
|
||||
bar(50+i*20+j,120,70+i*20+j,130);bar(50+(i+gap)*20-j,110,70+(i+gap)*20-j,120);
|
||||
end;
|
||||
for j:=120 downto 100 do begin
|
||||
setcolor(blue);
|
||||
outtextxy(50+i*20,j,s1);
|
||||
outtextxy(50+(i+gap)*20,50+j div 2,s2);
|
||||
delay(1);
|
||||
bar(50+i*20,j,70+i*20,j+10);bar(50+(i+gap)*20,50+j div 2,70+(i+gap)*20,60+j div 2);
|
||||
end;
|
||||
bar(20,65,600,75);
|
||||
h:=x[i];x[i]:=x[i+gap];x[i+gap]:=h; { Vertauschung, wenn "falsch" }
|
||||
sorted:=false; { Variable auf "nicht fertig sortiert" setzen }
|
||||
end;
|
||||
setcolor(0);
|
||||
line(60+i*20,95,60+i*20,80);
|
||||
line(60+(i+gap)*20,95,60+(i+gap)*20,80);
|
||||
line(60+i*20,80,60+(i+gap)*20,80);
|
||||
setcolor(15);
|
||||
str(x[i],s1);if x[i]<10 then s1:='0'+s1;
|
||||
outtextxy(50+i*20,100,s1);
|
||||
str(x[i+gap],s2);if x[i+gap]<10 then s2:='0'+s2;
|
||||
outtextxy(50+(i+gap)*20,100,s2);
|
||||
end;
|
||||
until sorted and (gap=1);
|
||||
END;
|
||||
|
||||
PROCEDURE auswahl;
|
||||
VAR c : char;
|
||||
BEGIN
|
||||
repeat
|
||||
setfillstyle(1,0);
|
||||
bar(0,0,getmaxx,getmaxy);
|
||||
setcolor(15);
|
||||
outtextxy(260,100,'C O M B S O R T');
|
||||
outtextxy(260,120,'###############');
|
||||
outtextxy(220,200,'1...DEMONSTRATION');
|
||||
outtextxy(220,220,'2...ENDE');
|
||||
|
||||
repeat
|
||||
c:=readkey;
|
||||
until c<>'';
|
||||
case c of
|
||||
'1': combsortdar;
|
||||
end;
|
||||
until c='2';
|
||||
END;
|
||||
BEGIN
|
||||
graf;
|
||||
auswahl;
|
||||
closegraph;
|
||||
END.
|
||||
29
ITG/TEST1_02.PAS
Normal file
29
ITG/TEST1_02.PAS
Normal file
@ -0,0 +1,29 @@
|
||||
program SortName;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var Nam: array[1..3] of string;
|
||||
i: integer;
|
||||
|
||||
procedure Swap(var i1,i2: string);
|
||||
var tmp: string;
|
||||
begin
|
||||
tmp := i1;
|
||||
i1 := i2;
|
||||
i2 := tmp;
|
||||
end;
|
||||
|
||||
begin
|
||||
for i:=1 to 3 do begin
|
||||
Write('Geben Sie den ',i,'. Namen ein: ');
|
||||
ReadLn(Nam[i]);
|
||||
end;
|
||||
if Nam[3]<Nam[1] then Swap(Nam[3],Nam[1]);
|
||||
if Nam[2]<Nam[1] then Swap(Nam[2],Nam[1]);
|
||||
if Nam[3]<Nam[2] then Swap(Nam[3],Nam[2]);
|
||||
for i:=1 to 3 do begin
|
||||
WriteLn('Name ',i,': ',Nam[i]);
|
||||
end;
|
||||
WriteLn('Bitte eine Taste dr<64>cken!');
|
||||
ReadKey;
|
||||
end.
|
||||
260
ITG/TIERFELD.PAS
Normal file
260
ITG/TIERFELD.PAS
Normal file
@ -0,0 +1,260 @@
|
||||
program Tiersuche_im_Feld;
|
||||
uses Crt, CursorOnOff;
|
||||
type TBuchQuadrat = array[1..20,1..20] of char;
|
||||
const DesktopCol=2;
|
||||
Quadrat: TBuchQuadrat =
|
||||
(('A','M','S','E','L','L','E','R','O','F','M','R','U','W','D','N','A','B','O','A'),
|
||||
('L','E','G','I','U','H','E','G','N','A','L','H','C','S','N','A','N','D','U','L'),
|
||||
('B','O','C','K','B','U','E','N','A','Y','H','O','R','N','I','S','S','E','H','L'),
|
||||
('N','H','A','H','E','H','S','U','A','L','U','C','H','S','T','S','R','L','U','I'),
|
||||
('R','P','N','E','Z','N','A','W','R','E','H','D','R','A','P','O','E','L','R','G'),
|
||||
('E','A','I','E','R','E','W','I','E','S','E','L','R','E','C','H','L','I','U','A'),
|
||||
('P','V','U','C','E','T','R','A','D','N','A','P','C','H','C','E','S','R','G','T'),
|
||||
('I','I','G','H','T','S','O','B','N','A','L','H','S','S','O','C','T','G','N','O'),
|
||||
('V','A','N','W','T','U','D','A','A','P','T','E','U','Z','Y','H','E','B','A','R'),
|
||||
('M','N','I','A','A','G','N','R','R','M','I','M','S','I','O','T','R','L','K','H'),
|
||||
('M','I','P','N','N','N','O','S','A','I','L','E','L','E','T','T','A','R','C','S'),
|
||||
('E','U','L','R','S','A','K','C','W','H','T','T','N','G','E','M','A','S','U','H'),
|
||||
('R','B','W','B','E','L','L','H','H','C','I','A','N','E','A','N','I','A','K','C'),
|
||||
('E','B','B','E','E','I','E','E','E','S','S','U','T','O','I','F','R','N','C','V'),
|
||||
('I','E','L','O','F','T','E','W','D','H','E','N','B','C','I','B','E','T','U','F'),
|
||||
('H','V','M','L','R','F','O','G','O','V','E','R','H','A','O','P','D','I','K','A'),
|
||||
('E','L','E','E','L','L','A','R','A','U','P','E','I','R','K','F','R','L','R','H'),
|
||||
('R','E','G','E','L','E','N','M','K','N','W','E','S','P','E','A','A','O','A','C'),
|
||||
('E','I','N','D','E','B','U','A','T','E','S','I','E','M','A','U','M','P','C','S'),
|
||||
('T','F','L','O','W','P','A','N','T','H','E','R','N','R','E','T','S','E','E','S'));
|
||||
|
||||
var whats: string;
|
||||
times: byte;
|
||||
|
||||
procedure DrawBorder(x1,y1,x2,y2,FG,BG: byte);
|
||||
const frame='Û';
|
||||
var i,j,xlen,ylen: byte;
|
||||
tox,toy: byte;
|
||||
xc,yc: byte;
|
||||
max: byte;
|
||||
DDel: byte;
|
||||
begin
|
||||
CursorOff;
|
||||
xlen := (x2-x1);
|
||||
ylen := (y2-y1);
|
||||
TextColor(FG);
|
||||
TextBackground(BG);
|
||||
if xlen>ylen then max:=xlen else max:=ylen;
|
||||
DDel:=400 DIV max;
|
||||
for i:=0 to max do begin
|
||||
tox:=(xlen*i) DIV max;
|
||||
toy:=(ylen*i) DIV max;
|
||||
|
||||
for j:=0 to 100 do begin
|
||||
xc := (x1+(tox*(100-j) DIV 100));
|
||||
yc := (y1+(toy*j DIV 100));
|
||||
if (xc>x1) AND (yc>y1) AND (xc<x2) AND (yc<y2) then begin
|
||||
GotoXY(xc,yc);
|
||||
Write(' ');
|
||||
end;
|
||||
xc := (x2-(tox*(100-j) DIV 100));
|
||||
yc := (y2-(toy*j DIV 100));
|
||||
if (xc>x1) AND (yc>y1) AND (xc<x2) AND (yc<y2) then begin
|
||||
GotoXY(xc,yc);
|
||||
Write(' ');
|
||||
end;
|
||||
end;
|
||||
|
||||
GotoXY(x1+tox,y1);
|
||||
Write(frame);
|
||||
GotoXY(x1,y1+toy);
|
||||
Write(frame);
|
||||
GotoXY(x2-tox,y2);
|
||||
Write(frame);
|
||||
GotoXY(x2,y2-toy);
|
||||
Write(frame);
|
||||
Delay(DDel);
|
||||
end;
|
||||
for i:=x1+1 to x2-1 do begin
|
||||
for j:=y1+1 to y2-1 do begin
|
||||
GotoXY(i,j);
|
||||
Write(' ');
|
||||
end;
|
||||
end;
|
||||
CursorOn;
|
||||
end;
|
||||
|
||||
procedure WriteMash;
|
||||
var x,y: byte;
|
||||
begin
|
||||
TextColor(15);
|
||||
TextBackground(1);
|
||||
for y:=1 to 20 do begin
|
||||
for x:=1 to 20 do begin
|
||||
GotoXY(4+x,4+y);
|
||||
Write(Quadrat[y,x]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
TextMode(CO80+Font8x8);
|
||||
ClrScr;
|
||||
DrawBorder(1,1,79,49,14,DesktopCol);
|
||||
DrawBorder(53,13,71,21,0,3);
|
||||
TextColor(0);
|
||||
TextBackground(3);
|
||||
GotoXY(55,15);
|
||||
Write('Richtungsschema');
|
||||
GotoXY(60,17);
|
||||
Write('8 1 2');
|
||||
GotoXY(60,18);
|
||||
Write('7 ');
|
||||
TextColor(15);
|
||||
WritE('X');
|
||||
TextColor(0);
|
||||
Write(' 3');
|
||||
GotoXY(60,19);
|
||||
Write('6 5 4');
|
||||
DrawBorder(3,3,26,26,15,1);
|
||||
WriteMash;
|
||||
CursorOff;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
DrawBorder(1,1,79,49,0,0);
|
||||
TextMode(CO80);
|
||||
end;
|
||||
|
||||
function Get(x,y,dir,len: byte): string;
|
||||
var i: byte;
|
||||
ax,ay: byte;
|
||||
tmp: string;
|
||||
begin
|
||||
i:=len;
|
||||
ax:=x;
|
||||
ay:=y;
|
||||
tmp:='';
|
||||
repeat
|
||||
tmp:=tmp+Quadrat[ay,ax];
|
||||
case dir of
|
||||
1: Dec(ay);
|
||||
2: begin Inc(ax); Dec(ay); end;
|
||||
3: Inc(ax);
|
||||
4: begin Inc(ax); Inc(ay); end;
|
||||
5: Inc(ay);
|
||||
6: begin Dec(ax); Inc(ay); end;
|
||||
7: Dec(ax);
|
||||
8: begin Dec(ax); Dec(ay); end;
|
||||
end;
|
||||
Dec(i);
|
||||
until i=0;
|
||||
Get:=tmp;
|
||||
end;
|
||||
|
||||
procedure Input;
|
||||
var i: byte;
|
||||
tmp: string;
|
||||
begin
|
||||
DrawBorder(33,5,73,11,11,1);
|
||||
TextColor(11);
|
||||
TextBackground(1);
|
||||
GotoXY(43,7);
|
||||
WriteLn('Geben Sie ein Tier an');
|
||||
TextColor(15);
|
||||
GotoXY(38,9);
|
||||
CursorOn;
|
||||
ReadLn(tmp);
|
||||
CursorOff;
|
||||
whats:='';
|
||||
for i:=1 to Length(tmp) do whats:=whats+UpCase(tmp[i]);
|
||||
DrawBorder(33,5,73,11,DesktopCol,DesktopCol);
|
||||
TextColor(15);
|
||||
end;
|
||||
|
||||
procedure Mark(x,y,dir,len,fg,bg: byte);
|
||||
var ax,ay,i: byte;
|
||||
begin
|
||||
TextColor(fg);
|
||||
TextBackground(bg);
|
||||
ax:=x; ay:=y;
|
||||
i:=len;
|
||||
repeat
|
||||
GotoXY(4+ax,4+ay);
|
||||
if (ay>=1) AND (ay<=20) AND (ax>=1) AND (ax<=20) then Write(Quadrat[ay,ax]);
|
||||
case dir of
|
||||
1: Dec(ay);
|
||||
2: begin Inc(ax); Dec(ay); end;
|
||||
3: Inc(ax);
|
||||
4: begin Inc(ax); Inc(ay); end;
|
||||
5: Inc(ay);
|
||||
6: begin Dec(ax); Inc(ay); end;
|
||||
7: Dec(ax);
|
||||
8: begin Dec(ax); Dec(ay); end;
|
||||
end;
|
||||
Dec(i);
|
||||
until i=0;
|
||||
Delay(30);
|
||||
TextBackground(0);
|
||||
TextColor(15);
|
||||
end;
|
||||
|
||||
procedure Search(what: string);
|
||||
var i,j,k: byte;
|
||||
ox,oy: byte;
|
||||
tmp: string;
|
||||
begin
|
||||
TextBackground(0);
|
||||
ox:=1;
|
||||
oy:=1;
|
||||
for i:=1 to 20 do begin
|
||||
for j:=1 to 20 do begin
|
||||
(* Mark(j,i,1,1,9,1); *)
|
||||
if (Quadrat[i,j]=what[1]) then begin
|
||||
for k:=1 to 8 do begin
|
||||
tmp:=Get(j,i,k,Length(what));
|
||||
(* Mark(j,i,k,Length(what),0,1); *)
|
||||
if tmp=what then begin
|
||||
Window(5,30,75,46);
|
||||
GotoXY(ox,oy);
|
||||
Inc(times);
|
||||
WriteLn('Hab ''',what,''' bei (',j:2,'|',i:2,') gefunden. Richtung ',k,', L„nge ',Length(what));
|
||||
ox:=WhereX; oy:=WhereY;
|
||||
Window(1,1,80,50);
|
||||
Mark(j,i,k,Length(what),0,7);
|
||||
Delay(50);
|
||||
end;
|
||||
(* Mark(j,i,k,Length(what),15,1); *)
|
||||
end;
|
||||
end;
|
||||
(* Mark(j,i,1,1,15,1); *)
|
||||
end;
|
||||
end;
|
||||
window(5,30,75,46);
|
||||
GotoXY(ox,oy);
|
||||
if (times=0) then begin
|
||||
WriteLn('Hab nix gefunden - versuch'' was anderes.');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ClearErg;
|
||||
begin
|
||||
DrawBorder(3,28,77,47,DesktopCol,DesktopCol);
|
||||
DrawBorder(3,28,77,47,15,0);
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
repeat
|
||||
times:=0;
|
||||
{ WriteMash; }
|
||||
ClearErg;
|
||||
Input;
|
||||
if (whats<>'') then begin
|
||||
Search(whats);
|
||||
WriteLn;
|
||||
WriteLn('[ Taste dr<64>cken, um fort zu fahren ]');
|
||||
window(1,1,80,50);
|
||||
ReadKey;
|
||||
end;
|
||||
until whats='';
|
||||
Outit;
|
||||
end.
|
||||
137
ITG/TIMECALC.PAS
Normal file
137
ITG/TIMECALC.PAS
Normal file
@ -0,0 +1,137 @@
|
||||
program TimeCalc; { Unterrichtsstoff der 12. Klasse - L”sung von Markus Birth }
|
||||
|
||||
uses Crt,Strings;
|
||||
|
||||
var tstr: string[40];
|
||||
h1,m1,s1,hs1: integer;
|
||||
h2,m2,s2,hs2: integer;
|
||||
hf,mf,sf,hsf: integer;
|
||||
|
||||
procedure GetData(which: string;var h,m,s,hs: integer);
|
||||
var i,ec,tmp,oldi: integer;
|
||||
begin
|
||||
Write('Geben Sie die ',which,' Zeit ein [hh:mm.ss,tt]: ');
|
||||
ReadLn(tstr);
|
||||
oldi := 1;
|
||||
for i:=1 to Length(tstr) do begin
|
||||
if ((tstr[i]=':') OR (tstr[i]='.') OR (tstr[i]=',')) then begin
|
||||
Val(Copy(tstr,oldi,i-oldi),tmp,ec);
|
||||
oldi := i+1;
|
||||
case tstr[i] of
|
||||
':': h:=tmp;
|
||||
'.': m:=tmp;
|
||||
',': s:=tmp;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Val(Copy(tstr,oldi,Length(tstr)-oldi+1),tmp,ec);
|
||||
hs:=tmp;
|
||||
end;
|
||||
|
||||
procedure AddData(h1,m1,s1,hs1,h2,m2,s2,hs2: integer; var hf,mf,sf,hsf: integer; Add: boolean);
|
||||
begin
|
||||
if Add then begin
|
||||
hsf := hs1 + hs2;
|
||||
sf := s1 + s2;
|
||||
mf := m1 + m2;
|
||||
hf := h1 + h2;
|
||||
|
||||
sf := sf + hsf DIV 100;
|
||||
hsf := hsf MOD 100;
|
||||
|
||||
mf := mf + sf DIV 60;
|
||||
sf := sf MOD 60;
|
||||
|
||||
hf := hf + mf DIV 60;
|
||||
mf := mf MOD 60;
|
||||
end else begin
|
||||
hsf := hs1 - hs2;
|
||||
sf := s1 - s2;
|
||||
mf := m1 - m2;
|
||||
hf := h1 - h2;
|
||||
|
||||
while hsf<0 do begin
|
||||
hsf := hsf + 100;
|
||||
sf := sf - 1;
|
||||
end;
|
||||
|
||||
while sf<0 do begin
|
||||
sf := sf + 60;
|
||||
mf := mf - 1;
|
||||
end;
|
||||
|
||||
while mf<0 do begin
|
||||
mf := mf + 60;
|
||||
hf := hf - 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TimeOut(h,m,s,t: integer);
|
||||
begin
|
||||
WriteLn(h:2,':',m:2,'.',s:2,'''',t:2,'''''');
|
||||
end;
|
||||
|
||||
procedure DataOut(Add: boolean);
|
||||
begin
|
||||
Write(' ');
|
||||
TimeOut(h1,m1,s1,hs1);
|
||||
if Add then Write('+') else Write('-');
|
||||
TimeOut(h2,m2,s2,hs2);
|
||||
WriteLn('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
|
||||
AddData(h1,m1,s1,hs1,h2,m2,s2,hs2,hf,mf,sf,hsf,Add);
|
||||
Write(' ');
|
||||
TimeOut(hf,mf,sf,hsf);
|
||||
WriteLn('ÄÍÍÍÍÍÍÍÍÍÍÍÍÍÄ');
|
||||
end;
|
||||
|
||||
procedure SwapVals(var h1,m1,s1,t1,h2,m2,s2,t2: integer);
|
||||
var tmp: integer;
|
||||
begin
|
||||
tmp := h1;
|
||||
h1 := h2;
|
||||
h2 := tmp;
|
||||
|
||||
tmp := m1;
|
||||
m1 := m2;
|
||||
m2 := tmp;
|
||||
|
||||
tmp := s1;
|
||||
s1 := s2;
|
||||
s2 := tmp;
|
||||
|
||||
tmp := t1;
|
||||
t1 := t2;
|
||||
t2 := tmp;
|
||||
end;
|
||||
|
||||
procedure Time2Secs(h,m,s: integer; var sec: longint);
|
||||
begin
|
||||
sec := h*3600 + m*60 + s;
|
||||
end;
|
||||
|
||||
procedure Secs2Time(sec: longint; var h,m,s: integer);
|
||||
begin
|
||||
h := sec div 3600;
|
||||
sec := sec mod 3600;
|
||||
m := sec div 60;
|
||||
s := sec mod 60;
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
GetData(' erste',h1,m1,s1,hs1);
|
||||
GetData('zweite',h2,m2,s2,hs2);
|
||||
Window(1,4,26,10);
|
||||
DataOut(true);
|
||||
Window(26,4,52,10);
|
||||
DataOut(false);
|
||||
Window(52,4,78,10);
|
||||
SwapVals(h1,m1,s1,hs1,h2,m2,s2,hs2);
|
||||
DataOut(false);
|
||||
Window(1,1,80,25);
|
||||
GotoXY(1,11);
|
||||
WriteLn;
|
||||
WriteLn('*** Bitte dr<64>cken Sie eine Taste ***');
|
||||
ReadKey;
|
||||
end.
|
||||
347
ITG/VISUAL.PAS
Normal file
347
ITG/VISUAL.PAS
Normal file
@ -0,0 +1,347 @@
|
||||
program Visualization;
|
||||
|
||||
uses Crt, Graph, BGIP;
|
||||
|
||||
const CompareColor = 14;
|
||||
HaveToSwapC = 12;
|
||||
MarkDelay = 500;
|
||||
Bool_Active = 11;
|
||||
Bool_AText = 0;
|
||||
Bool_Disabl = 9;
|
||||
Bool_DText = 15;
|
||||
|
||||
var xmax, ymax, xmed, ymed: word;
|
||||
xarr: array[1..10] of byte;
|
||||
|
||||
procedure InitGraphics;
|
||||
var grDriver, grMode: integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAHi;
|
||||
InitGraph(grDriver, grMode, BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xmax DIV 2;
|
||||
ymed := ymax DIV 2;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
TextMode(CO80);
|
||||
WriteLn('VMode : ',xmax,'x',ymax);
|
||||
WriteLn('Center: ',xmed,'x',ymed);
|
||||
WriteLn;
|
||||
WriteLn('Programm beendet.');
|
||||
end;
|
||||
|
||||
function V2S(x: byte): string;
|
||||
var tmp: string;
|
||||
begin
|
||||
Str(x,tmp);
|
||||
V2S := tmp;
|
||||
end;
|
||||
|
||||
procedure SwapVal(var x1,x2: integer);
|
||||
var tmp: integer;
|
||||
begin
|
||||
tmp := x1;
|
||||
x1 := x2;
|
||||
x2 := tmp;
|
||||
end;
|
||||
|
||||
procedure SwapValB(var x1,x2: byte);
|
||||
var tmp: byte;
|
||||
begin
|
||||
tmp := x1;
|
||||
x1 := x2;
|
||||
x2 := tmp;
|
||||
end;
|
||||
|
||||
procedure InitArray;
|
||||
var i: byte;
|
||||
begin
|
||||
Randomize;
|
||||
for i:=1 to 10 do xarr[i] := Random(256);
|
||||
end;
|
||||
|
||||
procedure MakeBox(el: byte;x,y: integer);
|
||||
var tw: word;
|
||||
begin
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
tw := TextWidth(V2S(xarr[el]));
|
||||
SetFillStyle(SolidFill,1);
|
||||
Bar(x-tw DIV 2-2,y-5,x+tw DIV 2+2,y+5);
|
||||
SetColor(11);
|
||||
SetLineStyle(SolidLn,0,NormWidth);
|
||||
Rectangle(x-tw DIV 2-2,y-5,x+tw DIV 2+2,y+5);
|
||||
SetColor(15);
|
||||
OutTextXY(x,y+1,V2S(xarr[el]));
|
||||
end;
|
||||
|
||||
procedure ClearBox(el: byte;x,y: integer);
|
||||
var tw: word;
|
||||
begin
|
||||
SetFillStyle(SolidFill,0);
|
||||
tw := TextWidth(V2S(xarr[el]));
|
||||
Bar(x-tw DIV 2-2,y-5,x+tw DIV 2+2,y+5);
|
||||
end;
|
||||
|
||||
procedure OutArrayPlain(title: string);
|
||||
var i: byte;
|
||||
begin
|
||||
ClearViewPort;
|
||||
for i:=1 to 10 do begin
|
||||
MakeBox(i,64*i-32,40);
|
||||
SetColor(7);
|
||||
OutTextXY(64*i-32,30,V2S(i));
|
||||
end;
|
||||
SetColor(14);
|
||||
OutTextXY(320,15,title);
|
||||
end;
|
||||
|
||||
procedure Mark(el,col: byte);
|
||||
var tw: word;
|
||||
x : integer;
|
||||
begin
|
||||
tw := TextWidth(V2S(xarr[el]));
|
||||
x := 64*el-32;
|
||||
SetColor(col);
|
||||
SetLineStyle(SolidLn,0,ThickWidth);
|
||||
Line(x-tw DIV 2-2,48,x+tw DIV 2+2,48);
|
||||
end;
|
||||
|
||||
procedure Connect(el1,el2,col,depth: byte);
|
||||
var x: integer;
|
||||
begin
|
||||
SetColor(col);
|
||||
Mark(el1,col);
|
||||
Mark(el2,col);
|
||||
x := 64*el1-32;
|
||||
MoveTo(x,49);
|
||||
SetLineStyle(SolidLn,0,NormWidth);
|
||||
LineTo(x,49+depth*20);
|
||||
x := 64*el2-32;
|
||||
LineTo(x,49+depth*20);
|
||||
LineTo(x,49);
|
||||
end;
|
||||
|
||||
procedure ClearConns;
|
||||
begin
|
||||
SetFillStyle(SolidFill,0);
|
||||
Bar(5,47,635,149);
|
||||
end;
|
||||
|
||||
procedure Swap(el1,el2: byte);
|
||||
var i: integer;
|
||||
x1,x2: integer;
|
||||
lo,hi: integer;
|
||||
m1,m2: integer;
|
||||
SwapDelay: integer;
|
||||
begin
|
||||
if (el1=el2) then Exit;
|
||||
x1 := 64*el1-32;
|
||||
x2 := 64*el2-32;
|
||||
if (x2<x1) then begin
|
||||
SwapVal(x1,x2);
|
||||
SwapValB(el1,el2);
|
||||
end;
|
||||
SwapDelay := 1000 DIV (x2-x1);
|
||||
for i:=40 to 80 do begin
|
||||
ClearBox(el1,x1,i);
|
||||
MakeBox(el1,x1,i+1);
|
||||
ClearBox(el2,x2,i);
|
||||
MakeBox(el2,x2,i+1);
|
||||
Delay(SwapDelay);
|
||||
end;
|
||||
|
||||
for i:=x1 to x2-1 do begin
|
||||
m1 := i;
|
||||
m2 := x1+x2-i;
|
||||
ClearBox(el1,m1,81);
|
||||
MakeBox(el1,m1+1,81);
|
||||
ClearBox(el1,m2,81);
|
||||
MakeBox(el2,m2-1,81);
|
||||
Delay(SwapDelay);
|
||||
end;
|
||||
|
||||
for i:=80 downto 40 do begin
|
||||
ClearBox(el2,x1,i+1);
|
||||
MakeBox(el2,x1,i);
|
||||
ClearBox(el1,x2,i+1);
|
||||
MakeBox(el1,x2,i);
|
||||
Delay(SwapDelay);
|
||||
end;
|
||||
SwapValB(xarr[el1],xarr[el2]);
|
||||
end;
|
||||
|
||||
procedure ShowValue(desc: string;val: integer;el,col,depth: byte);
|
||||
var OT: string;
|
||||
begin
|
||||
SetFillStyle(SolidFill,0);
|
||||
Bar(0,320+depth*10-5,640,320+depth*10+5);
|
||||
SetColor(col);
|
||||
SetTextJustify(LeftText,CenterText);
|
||||
OT := desc+': '+V2S(val);
|
||||
OutTextXY(5,320+depth*10,OT);
|
||||
if (el<>0) then begin
|
||||
Mark(el,10);
|
||||
SetLineStyle(SolidLn,0,NormWidth);
|
||||
MoveTo(64*el-32,49);
|
||||
LineTo(64*el-32,320+depth*10);
|
||||
LineTo(TextWidth(OT)+10,320+depth*10);
|
||||
Delay(MarkDelay);
|
||||
SetColor(0);
|
||||
MoveTo(64*el-32,49);
|
||||
LineTo(64*el-32,320+depth*10);
|
||||
LineTo(TextWidth(OT)+10,320+depth*10);
|
||||
SetColor(CompareColor);
|
||||
MoveTo(64*el-32,49);
|
||||
LineTo(64*el-32,69);
|
||||
Mark(el,CompareColor);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Bool(text1,text2: string;what: boolean;depth: byte);
|
||||
var OT: string;
|
||||
begin
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
if (what) then begin
|
||||
SetFillStyle(SolidFill,Bool_Active);
|
||||
SetColor(Bool_AText);
|
||||
OT := text1;
|
||||
end else begin
|
||||
SetFillStyle(SolidFill,Bool_Disabl);
|
||||
SetColor(Bool_DText);
|
||||
OT := text2;
|
||||
end;
|
||||
Bar(320,240+(depth-1)*20,639,240+(depth)*20);
|
||||
OutTextXY(480,240+(depth)*20-10,OT);
|
||||
end;
|
||||
|
||||
{###########################################################################
|
||||
###########################################################################
|
||||
##################### SORTIER ALGORITHMEN #################################
|
||||
###########################################################################
|
||||
###########################################################################}
|
||||
|
||||
procedure Sort_Simple;
|
||||
var i,j: integer;
|
||||
begin
|
||||
for i:=1 to 9 do
|
||||
for j:=i+1 to 10 do begin
|
||||
Connect(i,j,CompareColor,1);
|
||||
Delay(MarkDelay);
|
||||
if xarr[j]<xarr[i] then begin
|
||||
Connect(i,j,HaveToSwapC,1);
|
||||
Delay(MarkDelay);
|
||||
ClearConns;
|
||||
Swap(i,j);
|
||||
end;
|
||||
ClearConns;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Sort_Selectionsort;
|
||||
var i,j,minpos: integer;
|
||||
begin
|
||||
for i:=1 to 9 do begin
|
||||
minpos := i;
|
||||
ShowValue('minpos',minpos,0,15,1);
|
||||
for j:=i+1 to 10 do begin
|
||||
Connect(i,j,CompareColor,1);
|
||||
Delay(MarkDelay);
|
||||
if xarr[j]<xarr[minpos] then begin
|
||||
minpos:=j;
|
||||
ShowValue('minpos',minpos,j,10,1);
|
||||
Delay(MarkDelay);
|
||||
end;
|
||||
ClearConns;
|
||||
end;
|
||||
if (i<>minpos) then begin
|
||||
Connect(i,minpos,HaveToSwapC,1);
|
||||
Delay(MarkDelay);
|
||||
ClearConns;
|
||||
end;
|
||||
Swap(i,minpos);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Sort_Bubblesort;
|
||||
var i: integer;
|
||||
canswap: boolean;
|
||||
begin
|
||||
repeat
|
||||
canswap:=false;
|
||||
Bool('Konnte was tauschen','Konnte (noch) nichts tauschen',canswap,1);
|
||||
for i:=1 to 9 do begin
|
||||
Connect(i,i+1,CompareColor,1);
|
||||
Delay(MarkDelay);
|
||||
if xarr[i]>xarr[i+1] then begin
|
||||
Connect(i,i+1,HaveToSwapC,1);
|
||||
Delay(MarkDelay);
|
||||
ClearConns;
|
||||
Bool('TAUSCHE','',true,1);
|
||||
Swap(i,i+1);
|
||||
canswap := true;
|
||||
end;
|
||||
Bool('Konnte was tauschen','Konnte (noch) nichts tauschen',canswap,1);
|
||||
ClearConns;
|
||||
end;
|
||||
until (NOT canswap);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{###########################################################################
|
||||
###########################################################################
|
||||
######################### DER LETZTE REST #################################
|
||||
###########################################################################
|
||||
###########################################################################}
|
||||
|
||||
procedure WaitForKey;
|
||||
var x: byte;
|
||||
begin
|
||||
repeat
|
||||
x := Random(16);
|
||||
SetColor(x);
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
OutTextXY(320,240,'SORTIERUNG ABGESCHLOSSEN - bitte eine Taste dr<64>cken');
|
||||
Delay(1);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
procedure Simplest_DEMO;
|
||||
begin
|
||||
InitArray;
|
||||
OutArrayPlain('einfachste Sortierung');
|
||||
Sort_Simple;
|
||||
WaitForKey;
|
||||
end;
|
||||
|
||||
procedure Selection_DEMO;
|
||||
begin
|
||||
InitArray;
|
||||
OutArrayPlain('Selectionsort');
|
||||
Sort_Selectionsort;
|
||||
WaitForKey;
|
||||
end;
|
||||
|
||||
procedure Bubble_DEMO;
|
||||
begin
|
||||
InitArray;
|
||||
OutArrayPlain('Bubblesort');
|
||||
Sort_Bubblesort;
|
||||
WaitForKey;
|
||||
end;
|
||||
|
||||
begin
|
||||
InitGraphics;
|
||||
{ Simplest_DEMO; }
|
||||
Selection_DEMO;
|
||||
Bubble_DEMO;
|
||||
Outit;
|
||||
end.
|
||||
35
ITG/VISUAL2.INI
Normal file
35
ITG/VISUAL2.INI
Normal file
@ -0,0 +1,35 @@
|
||||
D:\LANG\BP\BGI
|
||||
2000
|
||||
15
|
||||
8
|
||||
5
|
||||
0
|
||||
1
|
||||
50
|
||||
1
|
||||
10
|
||||
30
|
||||
0
|
||||
1
|
||||
10
|
||||
0
|
||||
|
||||
INI-Datei f<>r VISUAL2.EXE (bzw. VISUAL2.PAS)
|
||||
|
||||
Copyright (c)1999 by Markus Birth <mbirth@webwriters.de>
|
||||
|
||||
1. Zeile: BGI-Path
|
||||
2. Zeile: Pre-Delay vor Grafikanzeige
|
||||
3. Zeile: Punktfarbe
|
||||
4. Zeile: Spurfarbe
|
||||
5. Zeile: einfachstes Sort (normal): -Faktor
|
||||
6. -Delay
|
||||
7. Zeile: einfachstes Sort (quick): -Faktor
|
||||
8. -Delay
|
||||
9. Zeile: Selectionsort: -Faktor
|
||||
10. -Delay
|
||||
11. Zeile: Bubblesort: -Faktor
|
||||
12. -Delay
|
||||
13. Zeile: Quicksort: -Faktor
|
||||
14. -Delay
|
||||
15. Zeile: Arraytype (0-Random, 1-aufsteigend, 2-absteigend)
|
||||
926
ITG/VISUAL2.PAS
Normal file
926
ITG/VISUAL2.PAS
Normal file
@ -0,0 +1,926 @@
|
||||
program Visualization2;
|
||||
|
||||
uses Crt, Graph, VFx, BGIP;
|
||||
|
||||
const cnt: byte=0;
|
||||
abo: boolean=false;
|
||||
firstrun: boolean=true;
|
||||
Simple_quick:boolean=false;
|
||||
DataFile='visual2.ini';
|
||||
Arraytypes: array[0..2] of string[20]=('zufall','aufsteigend','absteigend');
|
||||
|
||||
var xmax, ymax, xmed, ymed: word;
|
||||
xarr,oarr: array[0..639] of integer;
|
||||
pretime, opretime: integer;
|
||||
slow_, fact_, oslow_, ofact_: array[1..11] of integer;
|
||||
slow,fact: integer;
|
||||
sel: byte;
|
||||
DotCol, TrailCol, oDotCol, oTrailCol: byte;
|
||||
{BGIPath,} oBGIPath: string;
|
||||
Arraytype, oArraytype, OAT: byte;
|
||||
|
||||
function GetIniString(line: byte): string;
|
||||
var f: text;
|
||||
i: integer;
|
||||
tmp: string;
|
||||
begin
|
||||
Assign(f,DataFile);
|
||||
{$I-}
|
||||
Reset(f);
|
||||
if IOResult<>0 then begin
|
||||
TextMode(co80);
|
||||
WriteLn('Fehler beim Lesen der ',Datafile,' ... existiert die auch?');
|
||||
WriteLn('... und sind wir auch im richtigen Verzeichnis????');
|
||||
WriteLn;
|
||||
WriteLn('Egal ... ich leg'' mir selbst eine an ... ');
|
||||
Rewrite(f);
|
||||
if IOResult<>0 then begin
|
||||
WriteLn('Scheiáe ... nicht mal das geht auf diesem Sau-Rechner ...');
|
||||
WriteLn('Muát wohl doch DU das Problem l”sen .... sieh'' mal zu, daá');
|
||||
WriteLn('Du mehr Rechte auf dieses Verzeichnis bekommst!');
|
||||
WriteLn;
|
||||
Halt;
|
||||
end;
|
||||
WriteLn(f,'D:\BP\BGI');
|
||||
WriteLn(f,'2000');
|
||||
WriteLn(f,'15');
|
||||
WriteLn(f,'8');
|
||||
WriteLn(f,'5');
|
||||
WriteLn(f,'0');
|
||||
WriteLn(f,'1');
|
||||
WriteLn(f,'50');
|
||||
WriteLn(f,'1');
|
||||
WriteLn(f,'10');
|
||||
WriteLn(f,'30');
|
||||
WriteLn(f,'0');
|
||||
WriteLn(f,'1');
|
||||
WriteLn(f,'10');
|
||||
WriteLn(f,'0');
|
||||
WriteLn(f,'');
|
||||
WriteLn(f,'INI-Datei f<>r VISUAL2.EXE (bzw. VISUAL2.PAS)');
|
||||
WriteLn(f,'');
|
||||
WriteLn(f,' Copyright (c)1999 by Markus Birth <mbirth@webwriters.de>');
|
||||
WriteLn(f,'');
|
||||
WriteLn(f,' 1. Zeile: BGI-Path');
|
||||
WriteLn(f,' 2. Zeile: Pre-Delay vor Grafikanzeige');
|
||||
WriteLn(f,' 3. Zeile: Punktfarbe');
|
||||
WriteLn(f,' 4. Zeile: Spurfarbe');
|
||||
WriteLn(f,' 5. Zeile: einfachstes Sort (normal): -Faktor');
|
||||
WriteLn(f,' 6. -Delay');
|
||||
WriteLn(f,' 7. Zeile: einfachstes Sort (quick): -Faktor');
|
||||
WriteLn(f,' 8. -Delay');
|
||||
WriteLn(f,' 9. Zeile: Selectionsort: -Faktor');
|
||||
WriteLn(f,'10. -Delay');
|
||||
WriteLn(f,'11. Zeile: Bubblesort: -Faktor');
|
||||
WriteLn(f,'12. -Delay');
|
||||
WriteLn(f,'13. Zeile: Quicksort: -Faktor');
|
||||
WriteLn(f,'14. -Delay');
|
||||
WriteLn(f,'15. Zeile: Arraytype (0-Random, 1-aufsteigend, 2-absteigend)');
|
||||
Close(f);
|
||||
WriteLn('Sooo, das w„re geschafft! Wenn Du jetzt das Programm nocheinmal');
|
||||
WriteLn('aufrufst, m<>áte alles funktionieren!');
|
||||
Halt;
|
||||
end;
|
||||
{$I+}
|
||||
for i:=1 to line do ReadLn(f,tmp);
|
||||
Close(f);
|
||||
GetIniString := tmp;
|
||||
end;
|
||||
|
||||
function Str2Val(st: string): integer;
|
||||
var tmp, ec: integer;
|
||||
begin
|
||||
Val(st,tmp,ec);
|
||||
if (ec<>0) then begin
|
||||
TextMode(co80);
|
||||
WriteLn('Fehler beim Umwandeln eines Strings in einen numerischen Wert.');
|
||||
WriteLn('Stimmen die Eintr„ge in der INI-Datei??');
|
||||
Halt;
|
||||
end;
|
||||
Str2Val := tmp;
|
||||
end;
|
||||
|
||||
procedure ReadIni;
|
||||
var tmp: string;
|
||||
begin
|
||||
BGIPath := GetIniString(1);
|
||||
pretime := Str2Val(GetIniString(2));
|
||||
DotCol := Str2Val(GetIniString(3));
|
||||
TrailCol := Str2Val(GetIniString(4));
|
||||
fact_[1] := Str2Val(GetIniString(5));
|
||||
slow_[1] := Str2Val(GetIniString(6));
|
||||
fact_[11] := Str2Val(GetIniString(7));
|
||||
slow_[11] := Str2Val(GetIniString(8));
|
||||
fact_[2] := Str2Val(GetIniString(9));
|
||||
slow_[2] := Str2Val(GetIniString(10));
|
||||
fact_[3] := Str2Val(GetIniString(11));
|
||||
slow_[3] := Str2Val(GetIniString(12));
|
||||
fact_[4] := Str2Val(GetIniString(13));
|
||||
slow_[4] := Str2Val(GetIniString(14));
|
||||
Arraytype := Str2Val(GetIniString(15));
|
||||
end;
|
||||
|
||||
procedure InitGraphics;
|
||||
var grDriver, grMode: integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAHi;
|
||||
InitGraph(grDriver, grMode, BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xmax DIV 2;
|
||||
ymed := ymax DIV 2;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
TextBackground(0);
|
||||
ClrScr;
|
||||
WriteLn('Dieses Programm wurde Ihnen pr„sentiert von ..... nein, nicht Krombacher!');
|
||||
WriteLn('Aber daf<61>r von Markus Birth, Sch<63>ler der 12. Klasse im Jahrgang 1998/99');
|
||||
WriteLn;
|
||||
WriteLn;
|
||||
WriteLn('VMode : ',xmax,'x',ymax);
|
||||
WriteLn('Center: ',xmed,'x',ymed);
|
||||
WriteLn;
|
||||
WriteLn('Programm beendet.');
|
||||
end;
|
||||
|
||||
function V2S(x: byte): string;
|
||||
var tmp: string;
|
||||
begin
|
||||
Str(x,tmp);
|
||||
V2S := tmp;
|
||||
end;
|
||||
|
||||
procedure SwapVal(var x1,x2: integer);
|
||||
var tmp: integer;
|
||||
begin
|
||||
tmp := x1;
|
||||
x1 := x2;
|
||||
x2 := tmp;
|
||||
end;
|
||||
|
||||
function InArray(what: integer): boolean;
|
||||
var i: word;
|
||||
tmp: boolean;
|
||||
begin
|
||||
tmp := false;
|
||||
for i:=0 to 639 do begin
|
||||
if xarr[i]=what then begin
|
||||
tmp := true;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
InArray := tmp;
|
||||
end;
|
||||
|
||||
procedure InitArray;
|
||||
var i: word;
|
||||
tmp: integer;
|
||||
begin
|
||||
Randomize;
|
||||
for i:=0 to 639 do begin
|
||||
case Arraytype of
|
||||
0: xarr[i] := Random(480);
|
||||
1: if (i<480) then xarr[i] := i else xarr[i] := 479;
|
||||
2: if (i<480) then xarr[i] := 479-i else xarr[i] := 0;
|
||||
end;
|
||||
oarr[i] := xarr[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure OutArray;
|
||||
var i: word;
|
||||
begin
|
||||
if (keypressed) then begin
|
||||
abo := true;
|
||||
Exit;
|
||||
end;
|
||||
Inc(cnt);
|
||||
if (cnt>=fact) then begin
|
||||
cnt := 0;
|
||||
for i:=0 to 639 do begin
|
||||
PutPixel(i,479-oarr[i],TrailCol);
|
||||
PutPixel(i,479-xarr[i],DotCol);
|
||||
oarr[i]:=xarr[i];
|
||||
end;
|
||||
Delay(slow);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PutBigPixel(x,y: word;c: byte);
|
||||
begin
|
||||
PutPixel(x-1,y-1,c);
|
||||
PutPixel(x-1,y,c);
|
||||
PutPixel(x-1,y+1,c);
|
||||
PutPixel(x,y-1,c);
|
||||
PutPixel(x,y,c);
|
||||
PutPixel(x,y+1,c);
|
||||
PutPixel(x+1,y-1,c);
|
||||
PutPixel(x+1,y,c);
|
||||
PutPixel(x+1,y+1,c);
|
||||
end;
|
||||
|
||||
|
||||
{###########################################################################
|
||||
###########################################################################
|
||||
##################### SORTIER ALGORITHMEN #################################
|
||||
###########################################################################
|
||||
###########################################################################}
|
||||
|
||||
procedure Sort_Simple;
|
||||
var i,j: integer;
|
||||
yi,yj: integer;
|
||||
begin
|
||||
for i:=0 to 638 do begin
|
||||
for j:=i+1 to 639 do begin
|
||||
yi := 479-xarr[i];
|
||||
yj := 479-xarr[j];
|
||||
{ PutBigPixel(j,yj,12); }
|
||||
if xarr[j]<xarr[i] then begin
|
||||
SwapVal(xarr[i],xarr[j]);
|
||||
if NOT Simple_quick then OutArray;
|
||||
end;
|
||||
{ Delay(5);
|
||||
PutBigPixel(j,yj,0);
|
||||
PutPixel(j,479-xarr[j],15); }
|
||||
if (abo) then Exit;
|
||||
end;
|
||||
if (abo) then Exit;
|
||||
if Simple_quick then OutArray;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Sort_Selectionsort;
|
||||
var i,j,minpos: integer;
|
||||
begin
|
||||
for i:=0 to 638 do begin
|
||||
minpos := i;
|
||||
for j:=i+1 to 639 do begin
|
||||
if xarr[j]<xarr[minpos] then begin
|
||||
minpos:=j;
|
||||
end;
|
||||
end;
|
||||
SwapVal(xarr[i],xarr[minpos]);
|
||||
OutArray;
|
||||
if (abo) then Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Sort_Bubblesort;
|
||||
var i: integer;
|
||||
canswap: boolean;
|
||||
begin
|
||||
repeat
|
||||
canswap:=false;
|
||||
for i:=0 to 638 do begin
|
||||
if xarr[i]>xarr[i+1] then begin
|
||||
SwapVal(xarr[i],xarr[i+1]);
|
||||
OutArray;
|
||||
canswap := true;
|
||||
end;
|
||||
if (abo) then Exit;
|
||||
end;
|
||||
until (NOT canswap) OR (abo);
|
||||
end;
|
||||
|
||||
{#################################}
|
||||
|
||||
procedure Sort_Insertionsort;
|
||||
var h,i,j: integer;
|
||||
begin
|
||||
for i:=2 to 638 do begin
|
||||
h := xarr[i];
|
||||
xarr[0] := h;
|
||||
j := i-1;
|
||||
while h<xarr[j] do begin
|
||||
xarr[j+1] := xarr[j];
|
||||
OutArray;
|
||||
if (i>2) then Dec(j) else exit;
|
||||
end;
|
||||
xarr[j+1] := h;
|
||||
if (abo) then Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure Sort_QuickSort(sta,sto: integer; var f: array of integer);
|
||||
var li, re: integer;
|
||||
h, vgl: integer;
|
||||
begin
|
||||
li:=sta; re:=sto; vgl:=f[(li+re) DIV 2];
|
||||
|
||||
if li<re then begin
|
||||
repeat
|
||||
while f[li]<vgl do Inc(li);
|
||||
while f[re]>vgl do Dec(re);
|
||||
if li<=re then begin
|
||||
SwapVal(f[li],f[re]);
|
||||
inc(li); dec(re);
|
||||
OutArray;
|
||||
end;
|
||||
until (li>re) OR (abo);
|
||||
if (NOT abo) then begin
|
||||
Sort_QuickSort(sta,re,f);
|
||||
Sort_QuickSort(li,sto,f);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{###########################################################################
|
||||
###########################################################################
|
||||
######################### DER LETZTE REST #################################
|
||||
###########################################################################
|
||||
###########################################################################}
|
||||
|
||||
procedure WaitForKey;
|
||||
var x: byte;
|
||||
begin
|
||||
repeat
|
||||
x := Random(16);
|
||||
SetColor(x);
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
OutTextXY(320,240,'SORTIERUNG ABGESCHLOSSEN - bitte eine Taste dr<64>cken');
|
||||
Delay(1);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
procedure DoIt(what: byte);
|
||||
begin
|
||||
InitArray;
|
||||
InitGraphics;
|
||||
OutArray;
|
||||
Delay(pretime);
|
||||
slow := slow_[what];
|
||||
fact := fact_[what];
|
||||
case what of
|
||||
1: Sort_Simple;
|
||||
11: begin
|
||||
Simple_quick := true;
|
||||
Sort_Simple;
|
||||
end;
|
||||
2: Sort_Selectionsort;
|
||||
3: Sort_Bubblesort;
|
||||
4: Sort_Quicksort(0,639,xarr);
|
||||
end;
|
||||
cnt := fact;
|
||||
OutArray;
|
||||
ReadyBeep;
|
||||
ReadKey;
|
||||
TextMode(co80);
|
||||
end;
|
||||
|
||||
function KeyValid(sel: char): boolean;
|
||||
begin
|
||||
if (sel IN ['A'..'E','a'..'e','s','S','X','x']) then KeyValid := true
|
||||
else KeyValid := false;
|
||||
end;
|
||||
|
||||
procedure UpdateAType;
|
||||
var ofxwd: integer;
|
||||
begin
|
||||
ofxwd := fxwd;
|
||||
fxwd := 650;
|
||||
if (OAT<>255) then begin
|
||||
GotoXY(46,20);
|
||||
WriteLR(Arraytypes[OAT],1);
|
||||
end;
|
||||
GotoXY(46,20);
|
||||
WriteLR(Arraytypes[ArrayType],15);
|
||||
OAT := ArrayType;
|
||||
fxwd := ofxwd;
|
||||
end;
|
||||
|
||||
function Menu: byte;
|
||||
var sel: char;
|
||||
begin
|
||||
OAT := 255;
|
||||
TextBackground(0);
|
||||
TextMode(co80 + Font8x8);
|
||||
ClrScr;
|
||||
DrawBorder2(1,1,79,50,11,1);
|
||||
if firstrun then fxwd := 650 else fxwd := 10;
|
||||
GotoXY(1,3);
|
||||
TextColor(8);
|
||||
CursorOff;
|
||||
WriteC('--==+ Visualization 2 +==--');
|
||||
Delay(300);
|
||||
FXWriteC('--==+ Visualization 2 +==--',15);
|
||||
GotoXY(29,6); FXWrite('[ ] Simplesort (normal)',11);
|
||||
GotoXY(29,8); FXWrite('[ ] Simplesort (quick)',11);
|
||||
GotoXY(29,10); FXWrite('[ ] Selectionsort',11);
|
||||
GotoXY(29,12); FXWrite('[ ] Bubblesort',11);
|
||||
GotoXY(29,14); FXWrite('[ ] Quicksort',11);
|
||||
GotoXY(29,20); FXWrite('[ ] Zahlenfolge: ',11);
|
||||
GotoXY(29,24); FXWrite('[ ] Voreinstellungen „ndern',11);
|
||||
GotoXY(29,26); FXWrite('[ ] Programm beenden',11);
|
||||
fxwd := 10;
|
||||
GotoXY(30,6); FXWrite('A',14);
|
||||
GotoXY(30,8); FXWrite('B',14);
|
||||
GotoXY(30,10); FXWrite('C',14);
|
||||
GotoXY(30,12); FXWrite('D',14);
|
||||
GotoXY(30,14); FXWrite('E',14);
|
||||
GotoXY(30,20); FXWrite('T',14);
|
||||
GotoXY(30,24); FXWrite('S',14);
|
||||
GotoXY(30,26); FXWrite('X',14);
|
||||
if firstrun then fxwd := 650;
|
||||
UpdateAType;
|
||||
firstrun := false;
|
||||
GotoXY(1,30);
|
||||
FXWriteC('Dr<44>cken Sie einen der gelben Buchstaben (auf der Tastatur).',7);
|
||||
Menu := 0;
|
||||
repeat
|
||||
sel := ReadKey;
|
||||
if (NOT KeyValid(sel)) AND NOT (sel IN ['t','T']) then begin
|
||||
Sound(400);
|
||||
Delay(100);
|
||||
NoSound;
|
||||
end else begin
|
||||
Sound(1200);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
end;
|
||||
if (sel IN ['t','T']) then begin
|
||||
Inc(ArrayType);
|
||||
if (ArrayType>2) then ArrayType := 0;
|
||||
UpdateAType;
|
||||
end;
|
||||
until KeyValid(sel);
|
||||
case sel of
|
||||
'a','A': Menu := 1;
|
||||
'b','B': Menu := 2;
|
||||
'c','C': Menu := 3;
|
||||
'd','D': Menu := 4;
|
||||
'e','E': Menu := 5;
|
||||
'x','X': Menu := 0;
|
||||
's','S': Menu := 128;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteLet(b: char;text: string;c: byte);
|
||||
begin
|
||||
TextColor(c);
|
||||
Write('[');
|
||||
TextColor(14);
|
||||
Write(UpCase(b));
|
||||
TextColor(c);
|
||||
Write('] ',text);
|
||||
end;
|
||||
|
||||
procedure OutSetup;
|
||||
begin
|
||||
GotoXY(5,10); WriteLet('A','BGI-Pfad: ',10);
|
||||
TextColor(15); Write(BGIPath);
|
||||
GotoXY(5,12); WriteLet('B','Pre-Delay: ',10);
|
||||
TextColor(15); Write(pretime:0);
|
||||
GotoXY(30,12); WriteLet('C','Punktfarbe: ',10);
|
||||
TextColor(15); Write(DotCol:3,' ');
|
||||
TextColor(DotCol); Write('Û');
|
||||
GotoXY(55,12); WriteLet('D','Spurfarbe: ',10);
|
||||
TextColor(15); Write(TrailCol:3,' ');
|
||||
TextColor(TrailCol); Write('Û');
|
||||
GotoXY(5,15); WriteLet('E','einfachstes Sort (normal)',11);
|
||||
GotoXY(45,15); WriteLet('F','einfachstes Sort (quick)',11);
|
||||
GotoXY(5,19); WriteLet('G','Selectionsort',11);
|
||||
GotoXY(45,19); WriteLet('H','Bubblesort',11);
|
||||
GotoXY(5,23); WriteLet('I','Quicksort',11);
|
||||
TextColor(8);
|
||||
GotoXY(45,25); Write('Zahlenfolge: ',ArrayTypes[ArrayType]);
|
||||
GotoXY(11,16); Write('Faktor: ',fact_[1]);
|
||||
GotoXY(11,17); Write('Delay : ',slow_[1]);
|
||||
GotoXY(51,16); Write('Faktor: ',fact_[11]);
|
||||
GotoXY(51,17); Write('Delay : ',slow_[11]);
|
||||
GotoXY(11,20); Write('Faktor: ',fact_[2]);
|
||||
GotoXY(11,21); Write('Delay : ',slow_[2]);
|
||||
GotoXY(51,20); Write('Faktor: ',fact_[3]);
|
||||
GotoXY(51,21); Write('Delay : ',slow_[3]);
|
||||
GotoXY(11,24); Write('Faktor: ',fact_[4]);
|
||||
GotoXY(11,25); Write('Delay : ',slow_[4]);
|
||||
GotoXY(7,47);
|
||||
WriteLet('O','Eingaben <20>bernehmen',15); Write(' ');
|
||||
WriteLet('S','Eingaben sichern',15); Write(' ');
|
||||
WriteLet('X','Abbrechen',15);
|
||||
end;
|
||||
|
||||
function Setup_KeyValid(what: char): boolean;
|
||||
begin
|
||||
if (what IN ['A'..'I','a'..'i','o','O','s','S','x','X']) then Setup_KeyValid:=true
|
||||
else Setup_KeyValid := false;
|
||||
end;
|
||||
|
||||
procedure DoHelp;
|
||||
begin
|
||||
window(5,28,75,45);
|
||||
TextBackground(1);
|
||||
ClrScr;
|
||||
window(6,29,74,44);
|
||||
TextColor(14);
|
||||
WriteLn('--==+ HILFE +==--');
|
||||
WriteLn;
|
||||
TextColor(15);
|
||||
end;
|
||||
|
||||
procedure HelpDone;
|
||||
begin
|
||||
window(1,1,80,50);
|
||||
TextBackground(2);
|
||||
end;
|
||||
|
||||
procedure ClearHelp;
|
||||
begin
|
||||
window(5,28,75,45);
|
||||
TextBackground(2);
|
||||
ClrScr;
|
||||
window(1,1,80,50);
|
||||
end;
|
||||
|
||||
procedure Setup_GetVal(var v: integer);
|
||||
var tmp: string;
|
||||
tmp2, ec: integer;
|
||||
wx, wy: word;
|
||||
begin
|
||||
wx := WhereX;
|
||||
wy := WhereY;
|
||||
repeat
|
||||
GotoXY(wx,wy);
|
||||
Write(Space(10));
|
||||
GotoXY(wx,wy);
|
||||
ReadLn(tmp);
|
||||
Val(tmp,tmp2,ec);
|
||||
if (ec<>0) then ErrorBeep;
|
||||
until (tmp='') OR (ec=0);
|
||||
if (tmp<>'') then v := tmp2;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure Setup_GetByte(var v: byte);
|
||||
var tmp: string;
|
||||
tmp2, ec: integer;
|
||||
wx, wy: word;
|
||||
begin
|
||||
wx := WhereX;
|
||||
wy := WhereY;
|
||||
repeat
|
||||
GotoXY(wx,wy);
|
||||
Write(Space(5));
|
||||
GotoXY(wx,wy);
|
||||
ReadLn(tmp);
|
||||
Val(tmp,tmp2,ec);
|
||||
if (ec<>0) then ErrorBeep;
|
||||
until (tmp='') OR (ec=0);
|
||||
if (tmp<>'') then v := tmp2;
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure Setup_BGIpath;
|
||||
var tmp: string;
|
||||
begin
|
||||
GotoXY(5,10);
|
||||
TextColor(10+blink); Write('[ ]');
|
||||
GotoXY(6,10);
|
||||
TextColor(14+blink); Write('A');
|
||||
DoHelp;
|
||||
WriteLn('Geben Sie den Pfad zu den BGI-Dateien an.');
|
||||
WriteLn;
|
||||
WriteLn('Beispiel: C:\SCHULS~1\TP\BGI');
|
||||
WriteLn;
|
||||
WriteLn('Um den alten Wert zu behalten, einfach [ENTER] dr<64>cken.');
|
||||
HelpDone;
|
||||
GotoXY(19,10); Write(Space(50));
|
||||
GotoXY(19,10);
|
||||
TextColor(15);
|
||||
ReadLn(tmp);
|
||||
if (tmp<>'') then BGIpath := tmp;
|
||||
ClearHelp;
|
||||
GotoXY(5,10); TextColor(10); Write('[ ]');
|
||||
GotoXY(6,10); TextColor(14); Write('A');
|
||||
GotoXY(19,10);TextColor(15); Write(BGIpath);
|
||||
end;
|
||||
|
||||
procedure Setup_PreDelay;
|
||||
var tmp: string;
|
||||
tmp2, ec: integer;
|
||||
begin
|
||||
GotoXY(5,12);
|
||||
TextColor(10+blink); Write('[ ]');
|
||||
GotoXY(6,12);
|
||||
TextColor(14+blink); Write('B');
|
||||
DoHelp;
|
||||
WriteLn('Geben Sie die Zeit an, die vor der Grafikanzeige gewartet werden');
|
||||
WriteLn('soll. Dies ist bei den neueren Monitoren n”tig, da sie einige');
|
||||
WriteLn('Zeit ben”tigen, um in den Grafikmodus zu schalten.');
|
||||
WriteLn;
|
||||
WriteLn('Beispiel: 2000 - f<>r 2 Sekunden');
|
||||
WriteLn;
|
||||
WriteLn('Um den alten Wert zu behalten, einfach [ENTER] dr<64>cken.');
|
||||
HelpDone;
|
||||
GotoXY(20,12); TextColor(15);
|
||||
Setup_GetVal(pretime);
|
||||
ClearHelp;
|
||||
GotoXY(5,12); TextColor(10); Write('[ ]');
|
||||
GotoXY(6,12); TextColor(14); Write('B');
|
||||
GotoXY(20,12); Write(Space(10));
|
||||
GotoXY(20,12);TextColor(15); Write(pretime:0);
|
||||
end;
|
||||
|
||||
procedure ColTab;
|
||||
begin
|
||||
WriteLn(' 0 1 2 3 4 5 6 7');
|
||||
CWriteLn('%%0#ÛÛÛÛ%%1#ÛÛÛÛ%%2#ÛÛÛÛ%%3#ÛÛÛÛ%%4#ÛÛÛÛ%%5#ÛÛÛÛ%%6#ÛÛÛÛ%%7#ÛÛÛÛ');
|
||||
CWriteLn('%%8#ÛÛÛÛ%%9#ÛÛÛÛ%%10#ÛÛÛÛ%%11#ÛÛÛÛ%%12#ÛÛÛÛ%%13#ÛÛÛÛ%%14#ÛÛÛÛ%%15#ÛÛÛÛ');
|
||||
WriteLn(' 8 9 10 11 12 13 14 15');
|
||||
end;
|
||||
|
||||
procedure Setup_DotCol;
|
||||
var tmp: string;
|
||||
tmp2,ec: integer;
|
||||
begin
|
||||
GotoXY(30,12);
|
||||
TextColor(10+blink); Write('[ ]');
|
||||
GotoXY(31,12);
|
||||
TextColor(14+blink); Write('C');
|
||||
DoHelp;
|
||||
WriteLn('Geben Sie die Farbe f<>r die aktiven Punkte an.');
|
||||
WriteLn;
|
||||
WriteLn('Die Zahl muá zwischen 0 und 255 liegen.');
|
||||
WriteLn('Um den alten Wert zu behalten, einfach [ENTER] dr<64>cken.');
|
||||
WriteLn;
|
||||
WriteLn('Beispiele:');
|
||||
WriteLn;
|
||||
ColTab;
|
||||
HelpDone;
|
||||
GotoXY(46,12); TextColor(15);
|
||||
Setup_GetByte(DotCol);
|
||||
ClearHelp;
|
||||
GotoXY(30,12); TextColor(10); Write('[ ]');
|
||||
GotoXY(31,12); TextColor(14); Write('C');
|
||||
GotoXY(46,12); Write(Space(5));
|
||||
GotoXY(46,12);TextColor(15); Write(DotCol:3,' '); TextColor(DotCol); Write('Û');
|
||||
end;
|
||||
|
||||
procedure Setup_TrailCol;
|
||||
var tmp: string;
|
||||
tmp2,ec: integer;
|
||||
begin
|
||||
GotoXY(55,12);
|
||||
TextColor(10+blink); Write('[ ]');
|
||||
GotoXY(56,12);
|
||||
TextColor(14+blink); Write('D');
|
||||
DoHelp;
|
||||
WriteLn('Geben Sie die Farbe f<>r die ehemaligen Punkte an.');
|
||||
WriteLn;
|
||||
WriteLn('Die Zahl muá zwischen 0 und 255 liegen. 0 deaktiviert die Funktion.');
|
||||
WriteLn('Um den alten Wert zu behalten, einfach [ENTER] dr<64>cken.');
|
||||
WriteLn;
|
||||
WriteLn('Beispiele:');
|
||||
WriteLn;
|
||||
ColTab;
|
||||
HelpDone;
|
||||
GotoXY(70,12); TextColor(15);
|
||||
Setup_GetByte(TrailCol);
|
||||
ClearHelp;
|
||||
GotoXY(55,12); TextColor(10); Write('[ ]');
|
||||
GotoXY(56,12); TextColor(14); Write('D');
|
||||
GotoXY(70,12); Write(Space(5));
|
||||
GotoXY(70,12);TextColor(15); Write(TrailCol:3,' '); TextColor(TrailCol); Write('Û');
|
||||
end;
|
||||
|
||||
procedure Setup_Algos(x,y: word;c: char;t: string;no: byte);
|
||||
var key: char;
|
||||
begin
|
||||
GotoXY(x,y); TextColor(11+blink); Write('[ ]');
|
||||
GotoXY(x+1,y); TextColor(14+blink); Write(c);
|
||||
GotoXY(x+4,y); TextColor(15); Write(t);
|
||||
GotoxY(x+2,y+1); WriteLet('1','Faktor:',11);
|
||||
TextColor(15); Write(' ',fact_[no]);
|
||||
GotoXY(x+2,y+2); WriteLet('2','Delay :',11);
|
||||
TextColor(15); Write(' ',slow_[no]);
|
||||
repeat
|
||||
DoHelp;
|
||||
WriteLn('Dr<44>cken Sie "1" oder "2" um den Faktor oder das Delay zu „ndern.');
|
||||
WriteLn('"X", wenn Sie hier nichts „ndern wollen.');
|
||||
WriteLn;
|
||||
WriteLn('Faktor - ist die Beschleunigung, d.h. es wird nur noch jeder Xte');
|
||||
WriteLn(' Zustand auf dem Bildschirm ausgegeben, was die');
|
||||
WriteLn(' Bearbeitung und Visualisierung ungemein beschleunigt.');
|
||||
WriteLn;
|
||||
WriteLn('Delay - die Wartedauer zwischen zwei Ausgaben. Bei schnellen Algo-');
|
||||
WriteLn(' rithmen sollte man ein Delay setzen, damit die Visuali-');
|
||||
WriteLn(' sierung in einer vern<72>nftigen Geschwindigkeit abl„uft.');
|
||||
HelpDone;
|
||||
key := ReadKey;
|
||||
case key of
|
||||
'1': begin
|
||||
GotoXY(x+2,y+1); TextColor(11+blink); Write('[ ]');
|
||||
GotoXY(x+3,y+1); TextColor(14+blink); Write('1');
|
||||
GotoXY(x+6,y+1); TextColor(15); Write('Faktor:');
|
||||
GotoXY(x+14,y+1); TextColor(15);
|
||||
DoHelp;
|
||||
WriteLn('Der Faktor gibt an, wieviel Zust„nde w„hrend der Visualisierung');
|
||||
WriteLn('<27>bersprungen werden sollen. Es wird nur jeder Xte Zustand');
|
||||
WriteLn('angezeigt. Die Zahl kann im Bereich von 1 bis 32767 liegen,');
|
||||
WriteLn('aber man sollte sie nicht gr”áer als etwa 100 w„hlen, da sonst');
|
||||
WriteLn('die Visualisierung etwas merkw<6B>rdig aussieht.');
|
||||
WriteLn;
|
||||
WriteLn('Um den Wert nicht zu „ndern, einfach [ENTER] dr<64>cken.');
|
||||
HelpDone;
|
||||
Setup_GetVal(fact_[no]);
|
||||
if (fact_[no]<1) then fact_[no]:=1;
|
||||
GotoXY(x+2,y+1); WriteLet('1','Faktor:',11);
|
||||
TextColor(15);
|
||||
GotoXY(x+14,y+1); Write(Space(10));
|
||||
GotoXY(x+14,y+1); Write(fact_[no]);
|
||||
end;
|
||||
'2': begin
|
||||
GotoXY(x+2,y+2); TextColor(11+blink); Write('[ ]');
|
||||
GotoXY(x+3,y+2); TextColor(14+blink); Write('2');
|
||||
GotoXY(x+6,y+2); TextColor(15); Write('Delay :');
|
||||
GotoXY(x+14,y+2); TextColor(15);
|
||||
DoHelp;
|
||||
WriteLn('Das Delay gibt an, wieviel Millisekunden zwischen der Anzeige');
|
||||
WriteLn('der einzelnen Zust„nde "gewartet" werden sollen. Die Zahl kann');
|
||||
WriteLn('im Bereich von 0 bis 32767 liegen, sollte aber nie grӇer als');
|
||||
WriteLn('ca. 500 (« Sekunde) gew„hlt werden, da man sonst Stunden vor');
|
||||
WriteLn('dem Rechner sitzen kann, ohne groá was zu sehen.');
|
||||
WriteLn;
|
||||
WriteLn('Um den Wert nicht zu „ndern, einfach [ENTER] dr<64>cken.');
|
||||
HelpDone;
|
||||
Setup_GetVal(slow_[no]);
|
||||
GotoXY(x+2,y+2); WriteLet('2','Delay :',11);
|
||||
TextColor(15);
|
||||
GotoXY(x+14,y+2); Write(Space(10));
|
||||
GotoXY(x+14,y+2); Write(slow_[no]);
|
||||
end;
|
||||
end;
|
||||
until (key IN ['x','X']);
|
||||
ClearHelp;
|
||||
GotoXY(x,y); WriteLet(c,t,11);
|
||||
TextColor(8);
|
||||
GotoXY(x+2,y+1); Write(' Faktor:');
|
||||
GotoXY(x+2,y+2); Write(' Delay :');
|
||||
GotoXY(x+14,y+1); Write(Space(10));
|
||||
GotoXY(x+14,y+1); Write(fact_[no]);
|
||||
GotoXY(x+14,y+2); Write(Space(10));
|
||||
GotoXY(x+14,y+2); Write(slow_[no]);
|
||||
end;
|
||||
|
||||
procedure Setup_SimpleSN;
|
||||
var key: char;
|
||||
begin
|
||||
Setup_Algos(5,15,'E','einfachstes Sort (normal)',1);
|
||||
end;
|
||||
|
||||
procedure Setup_SimpleSQ;
|
||||
begin
|
||||
Setup_Algos(45,15,'F','einfachstes Sort (quick)',11);
|
||||
end;
|
||||
|
||||
procedure Setup_SelectionS;
|
||||
begin
|
||||
Setup_Algos(5,19,'G','Selectionsort',2);
|
||||
end;
|
||||
|
||||
procedure Setup_BubbleS;
|
||||
begin
|
||||
Setup_Algos(45,19,'H','Bubblesort',3);
|
||||
end;
|
||||
|
||||
procedure Setup_QuickS;
|
||||
begin
|
||||
Setup_Algos(5,23,'I','Quicksort',4);
|
||||
end;
|
||||
|
||||
procedure Setup_SaveVals;
|
||||
var f: text;
|
||||
begin
|
||||
Assign(f,DataFile);
|
||||
{$I-}
|
||||
Rewrite(f);
|
||||
if IOResult<>0 then begin
|
||||
TextMode(co80);
|
||||
WriteLn('Fehler beim Schreiben der INI-Datei ... haben Sie genug Rechte?');
|
||||
WriteLn('Ist die Datei VISUAL2.INI nicht schreibgesch<63>tzt? Ist genug Platz');
|
||||
WriteLn('vorhanden?');
|
||||
WriteLn;
|
||||
Halt;
|
||||
end;
|
||||
{$I+}
|
||||
WriteLn(f,BGIPath);
|
||||
WriteLn(f,pretime:0);
|
||||
WriteLn(f,DotCol:0);
|
||||
WriteLn(f,TrailCol:0);
|
||||
WriteLn(f,fact_[1]:0);
|
||||
WriteLn(f,slow_[1]:0);
|
||||
WriteLn(f,fact_[11]:0);
|
||||
WriteLn(f,slow_[11]:0);
|
||||
WriteLn(f,fact_[2]:0);
|
||||
WriteLn(f,slow_[2]:0);
|
||||
WriteLn(f,fact_[3]:0);
|
||||
WriteLn(f,slow_[3]:0);
|
||||
WriteLn(f,fact_[4]:0);
|
||||
WriteLn(f,slow_[4]:0);
|
||||
WriteLn(f,ArrayType:0);
|
||||
WriteLn(f,'');
|
||||
WriteLn(f,'INI-Datei f<>r VISUAL2.EXE (bzw. VISUAL2.PAS)');
|
||||
WriteLn(f,'');
|
||||
WriteLn(f,' Copyright (c)1999 by Markus Birth <mbirth@webwriters.de>');
|
||||
WriteLn(f,'');
|
||||
WriteLn(f,' 1. Zeile: BGI-Path');
|
||||
WriteLn(f,' 2. Zeile: Pre-Delay vor Grafikanzeige');
|
||||
WriteLn(f,' 3. Zeile: Punktfarbe');
|
||||
WriteLn(f,' 4. Zeile: Spurfarbe');
|
||||
WriteLn(f,' 5. Zeile: einfachstes Sort (normal): -Faktor');
|
||||
WriteLn(f,' 6. -Delay');
|
||||
WriteLn(f,' 7. Zeile: einfachstes Sort (quick): -Faktor');
|
||||
WriteLn(f,' 8. -Delay');
|
||||
WriteLn(f,' 9. Zeile: Selectionsort: -Faktor');
|
||||
WriteLn(f,'10. -Delay');
|
||||
WriteLn(f,'11. Zeile: Bubblesort: -Faktor');
|
||||
WriteLn(f,'12. -Delay');
|
||||
WriteLn(f,'13. Zeile: Quicksort: -Faktor');
|
||||
WriteLn(f,'14. -Delay');
|
||||
WriteLn(f,'15. Zeile: Arraytype (0-Random, 1-aufsteigend, 2-absteigend)');
|
||||
Close(f);
|
||||
AckBeep;
|
||||
end;
|
||||
|
||||
procedure Setup_Abort;
|
||||
begin
|
||||
BGIPath := oBGIPath;
|
||||
pretime := opretime;
|
||||
slow_ := oslow_;
|
||||
fact_ := ofact_;
|
||||
DotCol := oDotCol;
|
||||
TrailCol := oTrailCol;
|
||||
ArrayType:= oArrayType;
|
||||
end;
|
||||
|
||||
procedure Setup_SavePre;
|
||||
begin
|
||||
oBGIPath := BGIPath;
|
||||
opretime := pretime;
|
||||
oslow_ := slow_;
|
||||
ofact_ := fact_;
|
||||
oDotCol := DotCol;
|
||||
oTrailCol := TrailCol;
|
||||
oArrayType:= ArrayType;
|
||||
end;
|
||||
|
||||
procedure Setup;
|
||||
var sel: char;
|
||||
begin
|
||||
Setup_SavePre;
|
||||
DrawBorder2(2,5,78,49,15,2);
|
||||
GotoXY(1,7);
|
||||
FXWriteC('Voreinstellungen „ndern',15);
|
||||
OutSetup;
|
||||
repeat
|
||||
sel := ReadKey;
|
||||
if NOT Setup_KeyValid(sel) then begin
|
||||
Sound(400);
|
||||
Delay(100);
|
||||
NoSound;
|
||||
end else begin
|
||||
Sound(1200);
|
||||
Delay(50);
|
||||
NoSound;
|
||||
end;
|
||||
case sel of
|
||||
'a','A': Setup_BGIpath;
|
||||
'b','B': Setup_PreDelay;
|
||||
'c','C': Setup_DotCol;
|
||||
'd','D': Setup_TrailCol;
|
||||
'e','E': Setup_SimpleSN;
|
||||
'f','F': Setup_SimpleSQ;
|
||||
'g','G': Setup_SelectionS;
|
||||
'h','H': Setup_BubbleS;
|
||||
'i','I': Setup_QuickS;
|
||||
's','S': Setup_SaveVals;
|
||||
'x','X': Setup_Abort;
|
||||
end;
|
||||
until (sel IN ['o','O','x','X','s','S']);
|
||||
end;
|
||||
|
||||
begin
|
||||
ReadIni;
|
||||
repeat
|
||||
sel := Menu;
|
||||
abo := false;
|
||||
case sel of
|
||||
1: Doit(1);
|
||||
2: Doit(11);
|
||||
3: Doit(2);
|
||||
4: Doit(3);
|
||||
5: Doit(4);
|
||||
128: Setup;
|
||||
end;
|
||||
until (sel=0);
|
||||
Outit;
|
||||
end.
|
||||
5
ITG/WAHLEN.PAS
Normal file
5
ITG/WAHLEN.PAS
Normal file
@ -0,0 +1,5 @@
|
||||
uses Crt;const S:array[1..3,1..4] of word=((825,999,637,723),(436,638,345,451),(652,821,504,633));var B:array[1..3] of word;
|
||||
P:array[1..4] of word;procedure A;var i,j:byte;begin for i:=1 to 3 do for j:=1 to 4 do begin P[j]:=P[j]+S[i,j];
|
||||
B[i]:=B[i]+S[i,j];end;end;procedure C;var i,j:byte;begin WriteLn('<=========*=========>');Write(' ');
|
||||
WriteLn('ROT BLAU GELB GRšN ====');for i:=1 to 3 do begin Write('Bezirk ',i,' ');for j:=1 to 4 do Write(S[i,j]:4,' ');
|
||||
WriteLn(B[i]:4);end;Write('======== ');for i:=1 to 4 do Write(P[i]:4,' ');WriteLn;end;begin A;C;ReadKey;end.
|
||||
63
ITG/WASSRTMP.PAS
Normal file
63
ITG/WASSRTMP.PAS
Normal file
@ -0,0 +1,63 @@
|
||||
program Wassertemp;
|
||||
|
||||
uses Crt;
|
||||
|
||||
const un='øC';
|
||||
|
||||
var l: real;
|
||||
T1,T2,Tw: real;
|
||||
|
||||
procedure CalcTemp(l,T1,T2,Tw: real);
|
||||
var x: real;
|
||||
begin
|
||||
if ((Tw>T1) AND (Tw>T2)) then begin
|
||||
TextColor(12);
|
||||
WriteLn('Du Idiot! Hast Du ''ne Mikrowelle neben Deiner Badewanne?');
|
||||
WriteLn('Das Wasser kann doch nicht w„rmer werden, wie die max. Temp!');
|
||||
Exit;
|
||||
end;
|
||||
if ((Tw<T1) AND (Tw<T2)) then begin
|
||||
TextColor(12);
|
||||
WriteLn('Du Arsch! Hast Du etwa Deinen K<>hlschrank in der Badewanne?');
|
||||
WriteLn('Das Wasser kann doch nicht k„lter als die k„lteste Temp. werden!');
|
||||
Exit;
|
||||
end;
|
||||
x := ((Tw-T2)*l)/(T1-T2);
|
||||
WriteLn('Daf<61>r brauchst Du ',x:0:2,'l Wasser mit einer Temperatur von ',T1:0:2,un,' und');
|
||||
WriteLn(l-x:0:2,'l Wasser mit einer Temperatur von ',T2:0:2,un,' und fertig ist die');
|
||||
WriteLn('gew<65>nschte Mixtur.');
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
TextColor(15);
|
||||
WriteLn('-=+ MBUWTBPADIU +=-'); { Markus Birth's ultimatives WasserTemperatur }
|
||||
WriteLn; { Berechnungs Programm Aus Dem InformatikUnterricht }
|
||||
TextColor(7);
|
||||
Write('Wieviel Liter sollen rein? ');
|
||||
ReadLn(l);
|
||||
Write('Was f<>r ''ne Temperatur hat die erste Wasserquelle (in ',un,')? ');
|
||||
ReadLn(T1);
|
||||
Write('Und die zweite, h„h? ');
|
||||
ReadLn(T2);
|
||||
WriteLn;
|
||||
Write('Und wie warm soll es denn jetzt werden (in ',un,')? ');
|
||||
ReadLn(Tw);
|
||||
WriteLn;
|
||||
WriteLn('Na, dann wollen wir mal schau''n ...');
|
||||
Delay(500);
|
||||
Write('*knatter* ');
|
||||
Delay(500);
|
||||
Write('*ratter* ');
|
||||
Delay(500);
|
||||
Write('*klapper* ');
|
||||
Delay(500);
|
||||
WriteLn('*pling*');
|
||||
WriteLn;
|
||||
CalcTemp(l,T1,T2,Tw);
|
||||
TextColor(7);
|
||||
WriteLn;
|
||||
WriteLn('Fertich, Meista! Nu'' dr<64>ck'' mal auf ''ne Taste!!');
|
||||
ReadKey;
|
||||
end.
|
||||
55
ITG/WEEKDAY.PAS
Normal file
55
ITG/WEEKDAY.PAS
Normal file
@ -0,0 +1,55 @@
|
||||
program DayOfYear;
|
||||
|
||||
uses Crt;
|
||||
|
||||
var d,m,y,h,Rest,WD: integer;
|
||||
|
||||
procedure GetDate;
|
||||
begin
|
||||
Write('Tag : '); ReadLn(d);
|
||||
Write('Monat : '); ReadLn(m);
|
||||
Write('Jahr (4stellig): '); ReadLn(y);
|
||||
end;
|
||||
|
||||
procedure CalcWD;
|
||||
begin
|
||||
if (m=1) OR (m=2) then begin
|
||||
Inc(m,12);
|
||||
Dec(y);
|
||||
end;
|
||||
h := y DIV 100;
|
||||
Rest := y MOD 100;
|
||||
WriteLn('h',h,' Rest',Rest);
|
||||
WD := (d+(m+1)*26 DIV 10+5*Rest DIV 4+h DIV 4-2*h-1) MOD 7;
|
||||
end;
|
||||
|
||||
procedure OutWD1;
|
||||
begin
|
||||
Write('OutWD1: Das war ein ');
|
||||
case WD of
|
||||
0: Write('Sonntag');
|
||||
1: Write('Montag');
|
||||
2: Write('Dienstag');
|
||||
3: Write('Mittwoch');
|
||||
4: Write('Donnerstag');
|
||||
5: Write('Freitag');
|
||||
6: Write('Samstag');
|
||||
end;
|
||||
WriteLn('. [',WD,']');
|
||||
end;
|
||||
|
||||
procedure OutWD2;
|
||||
const Days:array[0..6] of string=('Sonntag','Montag','Dienstag','Mittwoch',
|
||||
'Donnerstag','Freitag','Samstag');
|
||||
begin
|
||||
Write('OutWD2: Das war ein ',Days[WD],'. [',WD,']');
|
||||
end;
|
||||
|
||||
begin
|
||||
ClrScr;
|
||||
WriteLn('Problemzonen: 19.5.2000');
|
||||
GetDate;
|
||||
CalcWD;
|
||||
OutWD1;
|
||||
OutWD2;
|
||||
end.
|
||||
178
ITG/WEIHNACH.PAS
Normal file
178
ITG/WEIHNACH.PAS
Normal file
@ -0,0 +1,178 @@
|
||||
program Froehliche_Weihnacht;
|
||||
|
||||
uses Crt, Graph, BGIP;
|
||||
|
||||
const pdel=10;
|
||||
bdel=100;
|
||||
bdis=20;
|
||||
|
||||
var xmax, ymax: word;
|
||||
oy: integer;
|
||||
|
||||
|
||||
procedure InitGraphics;
|
||||
var grDriver, grMode : integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAhi;
|
||||
InitGraph(grDriver,grMode,BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
end;
|
||||
|
||||
procedure OutitGraphics;
|
||||
begin
|
||||
TextMode(CO80);
|
||||
WriteLn('Programm beendet.');
|
||||
end;
|
||||
|
||||
procedure DrawStaffs;
|
||||
begin
|
||||
SetLineStyle(SolidLn, 0, NormWidth);
|
||||
SetColor(8);
|
||||
Rectangle(10,100,15,400);
|
||||
SetColor(6);
|
||||
Rectangle(11,101,14,399);
|
||||
Rectangle(12,101,13,399);
|
||||
SetColor(8);
|
||||
Rectangle(625,100,630,400);
|
||||
SetColor(6);
|
||||
Rectangle(626,101,629,399);
|
||||
Rectangle(627,101,628,399);
|
||||
end;
|
||||
|
||||
function y(x: integer): integer;
|
||||
const fac=0.001;
|
||||
xcen=320;
|
||||
ypos=195;
|
||||
var ot: string;
|
||||
t: integer;
|
||||
begin
|
||||
t := Round(-fac*(x-xcen)*(x-xcen)+ypos);
|
||||
{ if Abs(t-oy)>3 then begin
|
||||
Str(x,ot);
|
||||
OutText(ot+';');
|
||||
Str(t,ot);
|
||||
OutText(ot);
|
||||
end;
|
||||
oy := t; }
|
||||
y := t;
|
||||
|
||||
end;
|
||||
|
||||
procedure DrawLine;
|
||||
var i: integer;
|
||||
begin
|
||||
MoveTo(13,y(13));
|
||||
SetColor(8);
|
||||
for i:=13 to 627 do begin
|
||||
LineTo(i,y(i));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure BlowTorch(i: word;col: byte);
|
||||
const fcol=7; { Farbe der Lampenfassung }
|
||||
pcol=15; { Farbe des Kontakts }
|
||||
gcol=8; { Farbe des Glas }
|
||||
var j: integer;
|
||||
begin
|
||||
{ Just a 3x3 rectangle }
|
||||
{ PutPixel(i-1,y(i)-1,col);
|
||||
PutPixel(i-1,y(i),col);
|
||||
PutPixel(i-1,y(i)+1,col);
|
||||
PutPixel(i,y(i)-1,col);
|
||||
PutPixel(i,y(i),col);
|
||||
PutPixel(i,y(i)+1,col);
|
||||
PutPixel(i+1,y(i)-1,col);
|
||||
PutPixel(i+1,y(i),col);
|
||||
PutPixel(i+1,y(i)+1,col); }
|
||||
|
||||
{ A nice lamp }
|
||||
PutPixel(i,y(i)-2,pcol); { Kontakt }
|
||||
|
||||
for j:=-1 to 1 do PutPixel(i-1,y(i)+j,fcol); { Sockel }
|
||||
for j:=-1 to 1 do PutPixel(i,y(i)+j,fcol);
|
||||
for j:=-1 to 1 do PutPixel(i+1,y(i)+j,fcol);
|
||||
|
||||
PutPixel(i-2,y(i)+2,gcol); { Lampe }
|
||||
PutPixel(i+2,y(i)+2,gcol);
|
||||
PutPixel(i-2,y(i)+6,gcol);
|
||||
PutPixel(i+2,y(i)+6,gcol);
|
||||
for j:=3 to 5 do PutPixel(i-3,y(i)+j,gcol);
|
||||
for j:=3 to 5 do PutPixel(i+3,y(i)+j,gcol);
|
||||
for j:=-1 to 1 do PutPixel(i+j,y(i)+7,gcol);
|
||||
|
||||
for j:=3 to 5 do PutPixel(i-2,y(i)+j,col); { Licht }
|
||||
for j:=2 to 6 do PutPixel(i-1,y(i)+j,col);
|
||||
for j:=2 to 6 do PutPixel(i,y(i)+j,col);
|
||||
for j:=2 to 6 do PutPixel(i+1,y(i)+j,col);
|
||||
for j:=3 to 5 do PutPixel(i+2,y(i)+j,col);
|
||||
end;
|
||||
|
||||
procedure AnimateTorches_LineBlink;
|
||||
var i: integer;
|
||||
begin
|
||||
Randomize;
|
||||
for i:=13 to 627 do begin
|
||||
if i/bdis=Int(i/bdis) then begin
|
||||
BlowTorch(i,0);
|
||||
end;
|
||||
end;
|
||||
repeat
|
||||
for i:=13 to 627 do begin
|
||||
if i/bdis=Int(i/bdis) then begin
|
||||
BlowTorch(i,Random(16));
|
||||
Delay(pdel);
|
||||
end;
|
||||
end;
|
||||
Delay(bdel);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
procedure AnimateTorches_RandomBlink;
|
||||
var i: integer;
|
||||
begin
|
||||
Randomize;
|
||||
for i:=13 to 627 do begin
|
||||
if i/bdis=Int(i/bdis) then begin
|
||||
BlowTorch(i,0);
|
||||
end;
|
||||
end;
|
||||
repeat
|
||||
i := (Random(630 DIV bdis))*bdis+20;
|
||||
BlowTorch(i,Random(16));
|
||||
Delay(pdel);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
procedure AnimateTorches_ShiftBlink;
|
||||
const maxt=630 DIV bdis-1;
|
||||
var i: integer;
|
||||
lc: array[0..maxt] of byte;
|
||||
begin
|
||||
Randomize;
|
||||
for i:=13 to 627 do begin
|
||||
if i/bdis=Int(i/bdis) then begin
|
||||
BlowTorch(i,0);
|
||||
end;
|
||||
end;
|
||||
repeat
|
||||
for i:=maxt downto 1 do lc[i]:=lc[i-1];
|
||||
lc[0] := Random(16);
|
||||
for i:=0 to maxt do begin
|
||||
BlowTorch(i*bdis+20,lc[i]);
|
||||
end;
|
||||
Delay(bdel);
|
||||
until keypressed;
|
||||
ReadKey;
|
||||
end;
|
||||
|
||||
begin
|
||||
InitGraphics;
|
||||
DrawStaffs;
|
||||
DrawLine;
|
||||
AnimateTorches_ShiftBlink;
|
||||
OutitGraphics;
|
||||
end.
|
||||
333
ITG/rekGui.pas
Normal file
333
ITG/rekGui.pas
Normal file
@ -0,0 +1,333 @@
|
||||
program RekGUI;
|
||||
|
||||
uses Crt, Graph, DOS, GUI, RekGraph, BGIP;
|
||||
|
||||
const desktopcolor=3;
|
||||
skier_len: integer=120;
|
||||
skier_edge: integer=10;
|
||||
skier_globangle: integer=0;
|
||||
skier_fixedinit: boolean=true;
|
||||
haken_len: integer=150;
|
||||
haken_angle: integer=45;
|
||||
haken_globangle: integer=0;
|
||||
haken_fixedinit: boolean=true;
|
||||
quadrat_len: integer=150;
|
||||
quadrat_angle: integer=90;
|
||||
quadrat_globangle: integer=0;
|
||||
quadrat_fixedinit: boolean=true;
|
||||
spirale_len: integer=10;
|
||||
spirale_angle: integer=25;
|
||||
spirale_globangle: integer=0;
|
||||
spirale_fixedinit: boolean=true;
|
||||
|
||||
var xmax, ymax, xmed, ymed: word;
|
||||
ExitAll, ExitSetupAll: boolean;
|
||||
|
||||
procedure Init;
|
||||
var grDriver, grMode: integer;
|
||||
begin
|
||||
grDriver := VGA;
|
||||
grMode := VGAHi;
|
||||
initp_del := 30;
|
||||
InitGraph(grDriver, grMode, BGIPath);
|
||||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||||
xmed := xmax DIV 2;
|
||||
ymed := ymax DIV 2;
|
||||
om := 0;
|
||||
ExitAll := false;
|
||||
ExitSetupAll := false;
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
SetTextJustify(LeftText,TopText);
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(0,0,xmax-1,ymax-1);
|
||||
ClearStatus;
|
||||
end;
|
||||
|
||||
procedure InitGraphs;
|
||||
begin
|
||||
skier_del := 50;
|
||||
haken_del := 50;
|
||||
quadrat_del := 100;
|
||||
spirale_del := 50;
|
||||
end;
|
||||
|
||||
procedure Outit;
|
||||
begin
|
||||
TextMode(CO80);
|
||||
WriteLn('VMode : ',xmax,'x',ymax);
|
||||
WriteLn('Center: ',xmed,'x',ymed);
|
||||
WriteLn;
|
||||
WriteLn('Programm beendet.');
|
||||
end;
|
||||
|
||||
function V2S(x: byte): string;
|
||||
var tmp: string;
|
||||
begin
|
||||
Str(x:3,tmp);
|
||||
V2S := tmp;
|
||||
end;
|
||||
|
||||
procedure ShowSkier;
|
||||
begin
|
||||
globangle := skier_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(180,370);
|
||||
Skier(skier_len,skier_edge);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
procedure ShowHaken;
|
||||
begin
|
||||
globangle := haken_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(240,180);
|
||||
Haken(haken_len,haken_angle);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
procedure ShowQuadrat;
|
||||
begin
|
||||
globangle := haken_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(240,180);
|
||||
Quadrat(quadrat_len,quadrat_angle);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
|
||||
procedure ShowSpirale;
|
||||
begin
|
||||
globangle := spirale_globangle;
|
||||
SetViewPort(13,31,497,397,ClipOn);
|
||||
MoveTo(240,180);
|
||||
Spirale(spirale_len,spirale_angle);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
end;
|
||||
|
||||
procedure Palette;
|
||||
const tx=50;
|
||||
ty=31;
|
||||
var i,j: integer;
|
||||
begin
|
||||
for j:=1 to 16 do begin
|
||||
SetTextJustify(RightText,CenterText);
|
||||
SetColor(0);
|
||||
OutTextXY(tx,ty+(j-1)*10+5,V2S((j-1)*16));
|
||||
for i:=0 to 15 do begin
|
||||
SetFillStyle(SolidFill,(j-1)*16+i);
|
||||
SetColor((j-1)*15+i);
|
||||
Bar(tx+i*10,ty+(j-1)*10,tx+i*10+10,ty+(j-1)*10+10);
|
||||
end;
|
||||
SetTextJustify(LeftText,CenterText);
|
||||
SetColor(0);
|
||||
OutTextXY(tx+162,ty+(j-1)*10+5,V2S((j-1)*16+15));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckSetupStat;
|
||||
begin
|
||||
if (mb<>0) then ShowMouse(false);
|
||||
if MouseOver(15,405,525,425) then begin
|
||||
Status('Hiermit wird die Konfiguration so gespeichert');
|
||||
case mb of
|
||||
1: begin
|
||||
ExitSetupAll := true;
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(527,405,625,425) then begin
|
||||
Status('Hier geht''s nach Hause!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(527,405,625,425,'EXIT');
|
||||
ExitSetupAll:=true;
|
||||
ExitAll:=true;
|
||||
Delay(buttondelay);
|
||||
MakeButton(527,405,625,425,'EXIT');
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end else if (oldstat<>'') then begin
|
||||
ClearStatus;
|
||||
oldstat:='';
|
||||
end;
|
||||
if (mb<>0) then ShowMouse(true);
|
||||
end;
|
||||
|
||||
procedure SetupData;
|
||||
var sx,sy,sb: integer;
|
||||
begin
|
||||
MakeWindow(10,10,630,430,'Konfiguration');
|
||||
MakeButton(15,405,525,425,'Einstellungen so <20>bernehmen');
|
||||
MakeButton(527,405,625,425,'EXIT');
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
CheckSetupStat;
|
||||
StatusTime(false);
|
||||
until (mb=3) OR (ExitSetupAll);
|
||||
if (mb=3) then ExitAll := true;
|
||||
ShowMouse(false);
|
||||
end;
|
||||
|
||||
procedure BuildWindows;
|
||||
begin
|
||||
MakeWindow(10,10,500,400,'Hauptfenster');
|
||||
MakeWindow(505,10,600,400,'Optionen');
|
||||
MakeButton(510,385,595,395,'EXIT');
|
||||
MakeButton(510,373,595,383,'CLEAR');
|
||||
MakeButton(510,34,595,54,'Skierp.');
|
||||
MakeButton(510,56,595,76,'Haken');
|
||||
MakeButton(510,78,595,98,'Quadrat');
|
||||
MakeButton(510,100,595,120,'Spirale');
|
||||
MakeButton(510,350,595,371,'SETUP');
|
||||
end;
|
||||
|
||||
procedure CheckStat;
|
||||
begin
|
||||
if (mb<>0) then ShowMouse(false);
|
||||
if MouseOver(510,385,595,395) then begin
|
||||
Status('Hier geht''s nach Hause!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,385,595,395,'EXIT');
|
||||
ExitAll:=true;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,385,595,395,'EXIT');
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,373,595,383) then begin
|
||||
Status('Damit wird das Hauptfenster gel”scht!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,373,595,383,'CLEAR');
|
||||
SetFillStyle(SolidFill,7);
|
||||
Bar(13,31,497,397);
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,373,595,383,'CLEAR');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,350,595,371) then begin
|
||||
Status('Hier kann man die Einstellungen „ndern!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,350,595,371,'SETUP');
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(10,10,500,400);
|
||||
Delay(buttondelay DIV 2);
|
||||
Bar(505,10,600,400);
|
||||
Delay(buttondelay DIV 2);
|
||||
ExitSetupAll := false;
|
||||
SetupData;
|
||||
if NOT ExitAll then begin
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(10,10,630,430);
|
||||
BuildWindows;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,34,595,54) then begin
|
||||
Status('F<>r unsere Wintersportler!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,34,595,54,'Skierp.');
|
||||
ShowSkier;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,34,595,54,'Skierp.');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,56,595,76) then begin
|
||||
Status('Und das ist f<>r die Angler!');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,56,595,76,'Haken');
|
||||
ShowHaken;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,56,595,76,'Haken');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,78,595,98) then begin
|
||||
Status('Sehen Sie schon viereckig?');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,78,595,98,'Quadrat');
|
||||
ShowQuadrat;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,78,595,98,'Quadrat');
|
||||
end;
|
||||
end;
|
||||
end else if MouseOver(510,100,595,120) then begin
|
||||
Status('Ist was verstopft?');
|
||||
case mb of
|
||||
1: begin
|
||||
MakeBeveledButton(510,100,595,120,'Spirale');
|
||||
ShowSpirale;
|
||||
Delay(buttondelay);
|
||||
MakeButton(510,100,595,120,'Spirale');
|
||||
end;
|
||||
end;
|
||||
end else if (oldstat<>'') then begin
|
||||
ClearStatus;
|
||||
oldstat:='';
|
||||
end;
|
||||
if (mb<>0) then ShowMouse(true);
|
||||
end;
|
||||
|
||||
procedure StartScreen;
|
||||
begin
|
||||
MakeWindow(120,140,520,340,'Rekursive Grafikfunktionen');
|
||||
SetViewPort(123,161,517,337,ClipOn);
|
||||
SetColor(9);
|
||||
SetTextStyle(TripleXFont,HorizDir,10);
|
||||
SetTextJustify(CenterText,CenterText);
|
||||
OutTextXY(200,24,'GUI');
|
||||
OutTextXY(200,26,'GUI');
|
||||
OutTextXY(199,25,'GUI');
|
||||
OutTextXY(201,25,'GUI');
|
||||
SetTextStyle(SansSerifFont,HorizDir,2);
|
||||
OutTextXY(200,100,'GRAPHICAL USER INTERFACE');
|
||||
SetColor(0);
|
||||
SetTextStyle(SmallFont,HorizDir,5);
|
||||
OutTextXY(200,165,'geschrieben von Markus Birth <mbirth@webwriters.de>');
|
||||
SetTextStyle(SmallFont,VertDir,4);
|
||||
SetTextJustify(CenterText,TopText);
|
||||
SetColor(8);
|
||||
OutTextXY(385,2,'(c)1999 Web - Writers');
|
||||
SetColor(0);
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
OutTextXY(200,140,'Initialisiere Farbpalette ...');
|
||||
Delay(1000);
|
||||
InitPalette;
|
||||
SetFillStyle(SolidFill,7);
|
||||
Bar(0,130,400,150);
|
||||
SetTextStyle(DefaultFont,HorizDir,1);
|
||||
SetViewPort(0,0,639,479,ClipOff);
|
||||
Status('Bitte dr<64>cken Sie irgendeine Taste (Maus oder Tastatur)');
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
StatusTime(false);
|
||||
until (keypressed) OR (mb<>0);
|
||||
if keypressed then ReadKey;
|
||||
ShowMouse(false);
|
||||
SetFillStyle(SolidFill,desktopcolor);
|
||||
Bar(120,140,520,340);
|
||||
end;
|
||||
|
||||
begin
|
||||
Init;
|
||||
InitGraphs;
|
||||
StartScreen;
|
||||
BuildWindows;
|
||||
MouseReset;
|
||||
ShowMouse(true);
|
||||
repeat
|
||||
MouseStat(mx,my,mb);
|
||||
CheckStat;
|
||||
StatusTime(false);
|
||||
until (mb=3) OR (ExitAll);
|
||||
ShowMouse(false);
|
||||
FadeOut;
|
||||
Outit;
|
||||
end.
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user