| Home | Submit | Free Hosting | Link To Us | Contacts |
Pascal ASCII mode Pascal
 Download (.zip){$G+} Unit Qwik; INTERFACE const smal = $0707; { For Cursor manipulate } norm = $0607; half = $0307; Bar = $000D; Off = $2607; on = $0506; MaxVensters = 5; { playraam } type Charset = Set of #0..#255; { For Qinput procedure } DAC_Trio=Record Red,Green,Blue:Byte; { For fade in/out } End; VensterPtr = ^VENSTERTYPE; VENSTERTYPE = record Data : array[1..4000] of Char; XPos : Byte; YPos : Byte; VenX1 : Byte; VenY1 : Byte; VenX2 : Byte; VenY2 : Byte; end; ScreenArray = ARRAY[1..25 * 80] OF WORD; { dump asci screen } ScreenPtr = ^ScreenArray; DacType = Array[1..256,1..3] of Byte; ByteArray = Array[0..15] of Byte; { New CharacterSets } CharArray = Array[1..101] of Record CN : Byte; CD : ByteArray; end; Const newChars : CharArray = { kader } ((CN:218;CD:(0,0,7,15,28,56,48,48,48,48,48,48,48,48,48,48)), {} (CN:194;CD:(0,0,255,255,0,0,0,0,0,0,0,0,0,0,0,0)), {} (CN:191;CD:(0,0,224,240,56,28,12,12,12,12,12,12,12,12,12,12)), {} (CN:195;CD:(48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48)), {} (CN:180;CD:(12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12)), {} (CN:192;CD:(48,48,48,48,48,48,48,48,48,48,56,28,15,7,0,0)), {} (CN:193;CD:(0,0,0,0,0,0,0,0,0,0,0,0,255,255,0,0)), {} (CN:217;CD:(12,12,12,12,12,12,12,12,12,12,28,56,240,224,0,0)), {} { name softdesign } (CN:200;CD:(127,128,128,159,144,144,144,144,158,144,144,144, 144,128,128,127)), {} (CN:201;CD:(255,0,0,19,18,18,18,18,19,18,18,18,18,0,0,255)), {} (CN:202;CD:(255,0,0,195,36,36,36,36,195,128,128,68,35,0,0,255)), {} (CN:203;CD:(255,0,0,31,130,2,2,2,2,130,130,130,2,0,0,255)), {} (CN:204;CD:(255,0,0,129,2,2,2,2,2,2,2,2,1,0,0,255)), {} (CN:205;CD:(255,0,0,199,36,36,36,36,39,36,36,36,196,0,0,255)), {} (CN:206;CD:(255,0,0,132,68,68,68,68,132,4,4,4,4,0,0,255)), {} (CN:207;CD:(255,0,0,66,98,82,74,70,66,66,66,66,66,0,0,255)), {} (CN:208;CD:(255,0,0,33,34,34,34,34,34,34,34,34,33,0,0,255)), {} (CN:209;CD:(255,0,0,196,38,37,36,36,36,36,36,36,196,0,0,255)), {} (CN:210;CD:(252,2,2,34,34,34,162,98,34,34,34,34,34,2,2,252)), {} { diversen } (CN:220;CD:(0,0,255,255,255,255,255,255,255,255,255,255,255,255, 255,255)), {} (CN:221;CD:(252,252,252,252,252,252,252,252,252,252,252,252, 252,252,252,252)), {} (CN:222;CD:(31,31,31,31,31,31,31,31,31,31,31,31,31,31,31,31)), {} (CN:223;CD:(255,255,255,255,255,255,255,255,255,255,255,255,255, 255,0,0)), {} { ASCII backgronds } (CN:225;CD:(148,132,72,48,0,193,34,20,148,132,72,48,0,193,34,20)), {} (CN:226;CD:(32,64,143,16,32,64,143,16,32,64,143,16,32,64,143,16)), {} (CN:227;CD:(129,66,36,16,8,4,34,25,152,66,32,16,8,36,66,129)), {} (CN:228;CD:(62,65,65,65,65,65,62,128,62,65,65,65,65,65,62,128)), {} (CN:229;CD:(0,0,0,0,16,32,64,255,64,32,16,0,0,0,0,0)), { pijl } (CN:230;CD:(0,0,0,0,0,1,7,252,7,1,0,0,0,0,0,0)), { pijl } (CN:249;CD:(0,0,0,0,0,4,6,255,255,6,4,0,0,0,0,0)), { pijl printmenu } { numbers 0..9 } (CN:48;CD:(0,60,66,66,66,66,66,66,66,66,66,60,0,0,0,0)), {0} (CN:49;CD:(0,8,24,56,8,8,8,8,8,8,8,62,0,0,0,0)), {1} (CN:50;CD:(0,60,66,2,2,4,8,16,32,64,64,126,0,0,0,0)), {2} (CN:51;CD:(0,60,66,2,2,4,24,4,2,2,66,60,0,0,0,0)), {3} (CN:52;CD:(0,2,6,10,18,34,66,126,2,2,2,2,0,0,0,0)), {4} (CN:53;CD:(0,126,64,64,64,64,124,2,2,2,66,60,0,0,0,0)), {5} (CN:54;CD:(0,60,66,64,64,64,124,66,66,66,66,60,0,0,0,0)), {6} (CN:55;CD:(0,126,2,2,4,4,8,8,16,16,32,32,0,0,0,0)), {7} (CN:56;CD:(0,60,66,66,66,66,60,66,66,66,66,60,0,0,0,0)), {8} (CN:57;CD:(0,60,66,66,66,66,62,2,2,2,66,60,0,0,0,0)), {9} { characters A..Z } (CN:65;CD:(0,60,66,66,66,66,126,66,66,66,66,66,0,0,0,0)), {A} (CN:66;CD:(0,124,66,66,66,66,124,66,66,66,66,124,0,0,0,0)), {B} (CN:67;CD:(0,28,34,64,64,64,64,64,64,64,34,28,0,0,0,0)), {C} (CN:68;CD:(0,120,68,66,66,66,66,66,66,66,68,120,0,0,0,0)), {D} (CN:69;CD:(0,126,64,64,64,64,120,64,64,64,64,126,0,0,0,0)), {E} (CN:70;CD:(0,126,64,64,64,64,124,64,64,64,64,64,0,0,0,0)), {F} (CN:71;CD:(0,60,66,64,64,64,78,66,66,66,66,60,0,0,0,0)), {G} (CN:72;CD:(0,66,66,66,66,66,126,66,66,66,66,66,0,0,0,0)), {H} (CN:73;CD:(0,28,8,8,8,8,8,8,8,8,8,28,0,0,0,0)), {I} (CN:74;CD:(0,14,4,4,4,4,4,4,4,4,68,56,0,0,0,0)), {J} (CN:75;CD:(0,66,68,72,80,96,96,96,80,72,68,66,0,0,0,0)), {K} (CN:76;CD:(0,64,64,64,64,64,64,64,64,64,64,126,0,0,0,0)), {L} (CN:77;CD:(0,65,65,99,85,73,65,65,65,65,65,65,0,0,0,0)), {M} (CN:78;CD:(0,66,66,98,82,74,70,66,66,66,66,66,0,0,0,0)), {N} (CN:79;CD:(0,24,36,66,66,66,66,66,66,66,36,24,0,0,0,0)), {O} (CN:80;CD:(0,124,66,66,66,66,124,64,64,64,64,64,0,0,0,0)), {P} (CN:81;CD:(0,24,36,66,66,66,66,82,74,74,36,26,0,0,0,0)), {Q} (CN:82;CD:(0,124,66,66,66,66,124,96,80,72,68,66,0,0,0,0)), {R} (CN:83;CD:(0,60,66,64,64,64,60,2,2,2,66,60,0,0,0,0)), {S} (CN:84;CD:(0,127,8,8,8,8,8,8,8,8,8,8,0,0,0,0)), {T} (CN:85;CD:(0,66,66,66,66,66,66,66,66,66,66,60,0,0,0,0)), {U} (CN:86;CD:(0,66,66,66,66,66,66,66,36,36,36,24,0,0,0,0)), {V} (CN:87;CD:(0,65,65,65,65,65,73,73,42,54,34,34,0,0,0,0)), {W} (CN:88;CD:(0,66,66,66,36,36,24,24,36,36,66,66,0,0,0,0)), {X} (CN:89;CD:(0,65,65,65,65,34,34,28,8,8,8,8,0,0,0,0)), {Y} (CN:90;CD:(0,127,2,4,4,8,8,16,16,32,32,127,0,0,0,0)), {Z} (CN:196;CD:(0,0,0,0,0,0,0,204,51,0,0,0,0,0,0,0)), {} (CN:179;CD:(16,16,8,8,16,16,8,8,16,16,8,8,16,16,8,8)), {} (CN:58;CD:(0,0,0,0,0,12,12,0,0,0,12,12,0,0,0,0)), {:} (CN:45;CD:(0,0,0,0,0,0,0,126,0,0,0,0,0,0,0,0)), {-} (CN:40;CD:(0,2,4,4,8,8,8,8,8,4,4,2,0,0,0,0)), {(} (CN:41;CD:(0,32,16,16,8,8,8,8,8,16,16,32,0,0,0,0)), {)} { balk voor B.V. Vloeiende BackupStatusBar } (CN:231;CD:(145,196,145,196,145,196,145,196,145,196,145,196,145, 196,145,196)), {} (CN:232;CD:(209,196,209,196,209,196,209,196,209,196,209,196,209, 196,209,196)), {} (CN:233;CD:(241,228,241,228,241,228,241,228,241,228,241,228,241, 228,241,228)), {} (CN:234;CD:(241,244,241,244,241,244,241,244,241,244,241,244,241, 244,241,244)), {} (CN:235;CD:(249,252,249,252,249,252,249,252,249,252,249,252,249, 252,249,252)), {} (CN:236;CD:(253,252,253,252,253,252,253,252,253,252,253,252,253, 252,253,252)), {} (CN:237;CD:(255,254,255,254,255,254,255,254,255,254,255,254,255, 254,255,254)), {} (CN:238;CD:(255,255,255,255,255,255,255,255,255,255,255,255,255, 255,255,255)), {} { JOS DICKMANN SOFTWARE (c) 1997 } {J} (CN : 210;CD : ($1E,$1E,$0C,$0C,$0C,$0C,$0C,$0C,$CC,$CC,$CC,$CC,$78,$78,$00,$00)), {O} (CN : 190;CD : ($38,$38,$6C,$6C,$C6,$C6,$C6,$C6,$C6,$C6,$6C,$6C,$38,$38,$00,$00)), {S} (CN : 141;CD : ($7C,$7C,$C6,$C6,$E0,$E0,$78,$78,$0E,$0E,$C6,$C6,$7C,$7C,$00,$00)), {D} (CN : 159;CD : ($F8,$F8,$6C,$6C,$66,$66,$66,$66,$66,$66,$6C,$6C,$F8,$F8,$00,$00)), {I} (CN : 242;CD : ($78,$78,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$78,$78,$00,$00)), {C} (CN : 226;CD : ($3C,$3C,$66,$66,$C0,$C0,$C0,$C0,$C0,$C0,$66,$66,$3C,$3C,$00,$00)), {K} (CN : 171;CD : ($E6,$E6,$66,$66,$6C,$6C,$78,$78,$6C,$6C,$66,$66,$E6,$E6,$00,$00)), {M} (CN : 156;CD : ($C6,$C6,$EE,$EE,$FE,$FE,$FE,$FE,$D6,$D6,$C6,$C6,$C6,$C6,$00,$00)), {A} (CN : 179;CD : ($30,$30,$78,$78,$CC,$CC,$CC,$CC,$FC,$FC,$CC,$CC,$CC,$CC,$00,$00)), {N} (CN : 250;CD : ($C6,$C6,$E6,$E6,$F6,$F6,$DE,$DE,$CE,$CE,$C6,$C6,$C6,$C6,$00,$00)), {F} (CN : 161;CD : ($FE,$FE,$62,$62,$68,$68,$78,$78,$68,$68,$60,$60,$F0,$F0,$00,$00)), {T} (CN : 254;CD : ($FC,$FC,$B4,$B4,$30,$30,$30,$30,$30,$30,$30,$30,$78,$78,$00,$00)), {W} (CN : 130;CD : ($C6,$C6,$C6,$C6,$C6,$C6,$C6,$C6,$D6,$D6,$FE,$FE,$6C,$6C,$00,$00)), {R} (CN : 172;CD : ($FC,$FC,$66,$66,$66,$66,$7C,$7C,$6C,$6C,$66,$66,$E6,$E6,$00,$00)), {E} (CN : 253;CD : ($FE,$FE,$62,$62,$68,$68,$78,$78,$68,$68,$62,$62,$FE,$FE,$00,$00)), {c} (CN : 199;CD : ($00,$00,$00,$00,$78,$78,$CC,$CC,$C0,$C0,$CC,$CC,$78,$78,$00,$00)), {(} (CN : 247;CD : ($18,$18,$30,$30,$60,$60,$60,$60,$60,$60,$30,$30,$18,$18,$00,$00)), {)} (CN : 233;CD : ($60,$60,$30,$30,$18,$18,$18,$18,$18,$18,$30,$30,$60,$60,$00,$00)), {1} (CN : 248;CD : ($30,$30,$70,$70,$30,$30,$30,$30,$30,$30,$30,$30,$FC,$FC,$00,$00)), {9} (CN : 223;CD : ($78,$78,$CC,$CC,$CC,$CC,$7C,$7C,$0C,$0C,$18,$18,$70,$70,$00,$00)), {5} (CN : 191;CD : ($FC,$FC,$C0,$C0,$F8,$F8,$0C,$0C,$0C,$0C,$CC,$CC,$78,$78,$00,$00))); { QWIK.TPU } Procedure Qread_char; { read the standard characters ASCII set } Procedure Qreset_char; { reset the old character set } procedure Qfont0; { standard ASCII font } procedure Qfont1; { new font for ASCII characters } procedure Qfont_jos; { Qfont_jos is a personal(private) procedure | | writeln('Ҿ ⫝̸ ߿'); | | title =('JOS DICKMANN SOFTWARE (c) 1997') } Function Qinput(X,Y: Byte;StartStr,BackG,PassChar: String;MaxLen,StartPos: Integer;AcceptSet: CharSet;Ins: Boolean;var InputStatus: Byte):string; { X,Y Where on screen to put the input. | | StartStr Default input string. | | BackG Background Character, eg ' ' or '' etc. | | PassChar If defined this character will be | | displyed instead of the input stream | | MaxLen MaxLen of Input. | | StartPos Where in input string to place cursor, | | -1 = End of StartStr | | AcceptSet : Which characters should be accepted | | as input,often [#32..#255] | | if you include #8 in mask, you cannot use delete | | Ins : Begin in INSERT or OVERWRITE mode Boolean | | InputStatus exit from the input routine | | 13 = Input terminated with Enter. | | 27 = Input terminated with ESC. | | 72 = User pressed UpArrow | | 80 = User pressed DownArrow | | 73 = User pressed Page Up | | 81 = User pressed Page Down etc.... } function Qstring(x,y,color,maxlen :byte;AcceptSet: CharSet):string; { x,y Where on screen to put the input. | | MaxLen MaxLen of Input. | | AcceptSet = Which characters should be | | accepted as input, often [#32..#255] } { THE FOLLOW PROCEDURES ONLY USED IN WINDOW 0,0,80,25 } Procedure Qwrite(x, y: byte; s: string; f, b: byte); Procedure Qhor_write(x,y,aantal,teken,kleur :byte); { Qhor_write(20,2,10,176,3) = } Procedure Qver_write(x,y,aantal,teken,kleur :byte); { vertical asci rules } { USE IN PROCEDURE QWINDOW } procedure Qtext(x,y :byte;str :string;kleur,achtergrondkleur : Byte); Procedure Qhor(x,y,aantal,teken,kleur :byte); Procedure Qver(x,y,aantal,teken,kleur :byte); Procedure QCursor(Ctype: Word); { smal = $0707; | | norm = $0607; | | half = $0307; | | Bar = $000D; | | Off = $2607; | | on = $0506; } Procedure Qtime(x,y,kleur,achtergrondkleur :byte); Procedure Qdate(x,y,kleur,achtergrondkleur :byte); { kleur = color / achtergrondkleur = background color } Function Qday_of_week(Month,Day,Year :word):byte; { read the day of the week 0..6 } Function NumbofDaysInMth(y,m : Word): Byte; { read the days in a month / januari = 31 etc... } Procedure Qscreen_off; Procedure Qscreen_on; Procedure Qdelay(ms : Word); { ms = milliseconds } Procedure Qfill_screen(char,color :byte); { Fill screen 80x25 characters } Procedure Qborder(kleur: byte); { fills the border of the screen } Procedure Qsave_screen(filename :string); Procedure Qload_screen(filename :string); { I don't know of this works } { var Page : ARRAY[0..2] OF PageType; | | Counter : integer;key :char; | | | | begin | | Page[0] := Monitor; | | LoadScreen(Page[1],paramstr(1)); | | LoadScreen(Page[2],paramstr(2)); | | repeat | | while KeyPressed DO Key := ReadKey; | | IF Counter = 1 THEN Counter := 2 | | else Counter := 1; | | PageFlip(Page[Counter],AllRand); | | until Key = #27; | | PageFlip(Page[0],AllRand); | | end. } Procedure QScroll(x,y :byte;s:string;back,textcolor,highlight,dlay, waitkey:word); { x,y = screen location (1..80, 1..25) | | s = message to be displayed (length = 2..75) | | back = background color (0..7) | | textcolor = text color (0..15) | | highlight = highlight color (0..15) | | dlay = time delay (milliseconds) (0..) | | waitkey = 0 - cycle once only | | 1 - continue cycle until a key is hit } Procedure QFade_Out; { also for graphics screens } Procedure QFade_in; Procedure Qfadeout(Speed : Integer); { for asci screens } Procedure Qfadein(Speed : Integer); { for asci screens } Function QGetChar(X,Y:Byte):Char; { get the character on X,Y } procedure Qdel_file(filename :string); { delete a file } function Qexist_file(FileName : string) : boolean; function Qexist_dir(dir:string):boolean; procedure Qget_file_attr(fn:string;var Attr:word); procedure Qset_file_attr(fn :string;Attr:word); procedure Qget_file_size(FName :string;var Fsize :longint;var Error :word); procedure QCopy_file(file_of,file_to :string); procedure Qclear_buffer; { clear the keybord } function Qread_key :word; procedure Qsound(freq,delay :integer); procedure Qinfo(regel :string); { put info-text on rule 23 } Function Qerror(ErrorCode :integer):string; { 0: No Error'; | | 2: File Not Found'; | | 3: Path Not Found'; | | 4: Too Many Open Files'; | | 5: File Access Denied'; | | 6: Invalid File Handle'; | | 12: Invalid File Access Code'; | | 15: Invalid Drive Number'; | | 16: Cannot Remove Current Directory' | | 17: Cannot Rename Across Drives'; | | 18: File access error'; | | 100: Disk Read Error'; | | 101: Disk Write Error'; | | 102: File Not Assigned'; | | 103: File Not Open'; | | 104: File Not Open For Input'; | | 105: File Not Open For Output'; | | 106: Invalid Numeric Format'; | | 150: Disk Is Write-Protected'; | | 151: Unknown Unit'; | | 152: Drive Not Ready'; | | 153: Unknown Command'; | | 154: CRC Error In Data'; | | 155: Bad Drive Request Structure Leng | | 156: Disk Seek Error'; | | 157: Unknown Media Type'; | | 158: Sector Not Found'; | | 159: Printer Out Of Paper'; | | 160: Device Write Fault'; | | 161: Device Read Fault'; | | 162: Hardware Failure'; } Function Qprinter_ok :boolean; Procedure Qwindow(lx,ly,rx,ry :integer;kleur :byte); Procedure Qopen_window(x,y,xx,yy,color,back: Byte); Procedure Qclose_window; Function Upcase_string(regel :string):string; { Upcase hole string } Function Upcase_First_char(regel :string):string; { Upcase only the first character of a string } Function Lowcase_string(regel :string):string; { Put string in lowercase characters } IMPLEMENTATION uses crt,dos; var s,ss : String; ch : char; IS : Byte; x,y,p : integer; Orig_Pal : Array[0..255] Of Dac_Trio; { fade in/out } regs : registers; newCharset, oldCharset : Array[0..255,1..16] of Byte; { voor Qread / Qreset_char } raam : array[0..MaxVensters] of VensterPtr; VideoVenster : VensterPtr; VenTeller : Byte; dac1,dac2 : DacType; erg,gesamt : Word; { textfadein /out } Procedure Qread_char;{*****************************************************} Var b:Byte; w:Word; begin For b := 0 to 255 do begin w := b * 32; Inline($FA); PortW[$3C4] := $0402; PortW[$3C4] := $0704; PortW[$3CE] := $0204; PortW[$3CE] := $0005; PortW[$3CE] := $0006; Move(Ptr($A000, w)^, oldCharset[b, 1], 16); PortW[$3C4] := $0302; PortW[$3C4] := $0304; PortW[$3CE] := $0004; PortW[$3CE] := $1005; PortW[$3CE] := $0E06; Inline($FB); end; end; Procedure Qreset_char; Var b:Byte; w:Word; begin For b := 0 to 255 do begin w := b * 32; Inline($FA); PortW[$3C4] := $0402; PortW[$3C4] := $0704; PortW[$3CE] := $0204; PortW[$3CE] := $0005; PortW[$3CE] := $0006; Move(oldCharset[b, 1], Ptr($A000, w)^, 16); PortW[$3C4] := $0302; PortW[$3C4] := $0304; PortW[$3CE] := $0004; PortW[$3CE] := $1005; PortW[$3CE] := $0E06; Inline($FB); end; end; procedure Qfont0; begin for p := 1 to 30 do With regs do begin ah := $11; al := $0; bh := $10; bl := 0; cx := 1; dx := NewChars[p].CN; es := seg(NewChars[p].CD); bp := ofs(NewChars[p].CD); intr($10,regs); end; end; procedure Qfont1; { Alle Karakters 1..80 zonder mijn naam } begin for p := 1 to 80 do With regs do begin ah := $11; al := $0; bh := $10; bl := 0; cx := 1; dx := NewChars[p].CN; es := seg(NewChars[p].CD); bp := ofs(NewChars[p].CD); intr($10,regs); end; end; procedure Qfont_jos; { zet mijn naam in tpu bestand } begin for p := 81 to 101 do With regs do begin { laatste 21 karakters } ah := $11; al := $0; bh := $10; bl := 0; cx := 1; dx := NewChars[p].CN; es := seg(NewChars[p].CD); bp := ofs(NewChars[p].CD); intr($10,regs); end; end; procedure QCursor(Ctype: Word); assembler; asm mov ax, $0100 mov cx, CType int $10 end; Function Left(s: String;nr: byte): String; begin Delete(s,nr+1,length(s)); Left:=s; end; Function Mid(s: String;nr,nr2: byte): String; begin Delete(s,1,nr-1); Delete(s,nr2+1,length(s)); Mid:=s; end; Procedure WriteXY(x,y: Byte;s: String); var loop: Word; begin for loop:=x to x+length(s)-1 do Mem[$B800:(loop-1)*2+(y-1)*160]:=Ord(S[loop-x+1]); end; Function RepeatChar(s: String;antal: byte): String; var temp: String; begin temp:=s[1]; While Length(temp)<Antal do Insert(s[1],temp,1); RepeatChar:=Temp; end; Function qInput(X,Y: Byte;StartStr,BackG,PassChar: String;MaxLen,StartPos: Integer;AcceptSet: CharSet;Ins: Boolean;var InputStatus: Byte):string; Var P : Byte; Exit : Boolean; ext : Char; t : String[1]; begin Exit:=False; if Length(PassChar)>1 then PassChar:=PassChar[1]; if Length(BackG)>1 then BackG:=BackG[1]; if Length(BackG)=0 then BackG:=' '; if Length(StartStr)>MaxLen then StartStr:=Left(StartStr,MaxLen); if StartPos>Length(StartStr) then StartPos:=Length(StartStr); if StartPos=-1 then StartPos:=Length(StartStr); If StartPos>=MaxLen then StartPos:=MaxLen-1; s:=StartStr; WriteXY(X,Y,RepeatChar(BackG,MaxLen)); if StartStr<>'' then begin if passchar='' then WriteXY(X,Y,StartStr) else WriteXY(X,Y,RepeatChar(PassChar,Length(StartStr))); end; p:=StartPos; GotoXY(X+StartPos,Y); repeat if Ins then Qcursor(norm) else Qcursor(bar); ext:=#0; ch:=ReadKey; if ch=#0 then ext:=ReadKey; if ch=#27 then begin InputStatus:=27; Exit:=True; end; if ch in AcceptSet then begin t:=ch; if (p=length(s)) and (Length(s)<MaxLen) then begin s:=s+t; if PassChar='' then WriteXY(X+P,Y,T) else WriteXY(X+P,Y,PassChar); Inc(p); end else if length(s)<MaxLen then begin if Ins then Insert(T,S,P+1) else s[p+1]:=Ch; if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(S))) else WriteXY(X+Length(S)-1,Y,PassChar); Inc(p); end else if (Length(s)=MaxLen) and (not Ins) then begin s[p+1]:=ch; if PassChar='' then WriteXY(X+P,Y,T) else WriteXY(X+P,Y,PassChar); Inc(p); end; ch:=#0; if p>MaxLen-1 then p:=MaxLen-1; GotoXY(X+P,Y); end else begin case ch of { CTRL-Y } #25: begin WriteXY(X,Y,RepeatChar(BackG,Length(S))); P:=0; S:=''; GotoXY(X,Y); end; {Backspace} #8: If (P>0) then begin if (p+1=MaxLen) and (p<length(s)) then Ext:=#83 else begin Delete(S,P,1); Dec(P); GotoXY(X+P,Y); if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(s))+BackG) else if P>0 then WriteXY(X+Length(s)-1,Y,PassChar+BackG) else WriteXY(X+Length(s),Y,BackG); end; end; #9: begin { Exit on TAB } InputStatus:=9; Exit:=True; end; #13: begin InputStatus:=13; Exit:=True; end; end; { Case CH of } case ext of {Left Arrow} #75: if P>0 then begin Dec(P); GotoXY(X+P,Y); end; {Right Arrow} #77: if (P<Length(s)) and (P+1<MaxLen) then begin Inc(P); GotoXY(X+P,Y); end; #82: Ins:=Not(Ins); {Insert} {Delete} #83: If P<Length(s) then begin Delete(S,P+1,1); if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(s))+BackG) else if p>0 then WriteXY(X+Length(S)-1,Y,PassChar+BackG) else WriteXY(X+Length(S),Y,BackG); end; #71: begin p:=0; GotoXY(X+P,Y); end; #79: begin p:=Length(s); if p>=MaxLen then P:=MaxLen-1; GotoXY(X+P,Y); end; #72,#73,#80,#81,#59..#68: begin InputStatus:=Ord(Ext); Exit:=True; end; end; {Case of EXT } end; { if not normal char } until Exit; qinput:=S; Qcursor(off); end; function Qstring(x,y,color,maxlen :byte;AcceptSet: CharSet):string; label start; var posx :byte; begin Qcursor(on); ss :='';posx :=1; repeat start: gotoxy(x,y); ch :=readkey; if (ch =#8) and (posx+x-1 >x) then begin dec(posx); delete(ss,posx,1); dec(x,1); gotoxy(x,y);write(' '); goto start; end; if (ch in AcceptSet) and (posx <maxlen) then begin s :=ch;insert(s,ss,posx); Qtext(x,y,s,color,0); inc(x,1); inc(posx); end; until ch in[#13]; Qstring :=ss; Qcursor(off); end; procedure Qtext(x,y :byte;str :string;kleur,achtergrondkleur : Byte); begin textbackground(achtergrondkleur); textcolor(kleur); gotoxy(x,y);write(str); textbackground(0); end; procedure Qwrite(x, y: byte; s: string; f, b: byte); begin asm mov dh, y { move X and Y into DL and DH } mov dl, x xor al, al mov ah, b { load background into AH } mov cl, 4 { shift background over to next nibble } shl ax, cl add ah, f { add foreground } push ax { PUSH color combo onto the stack } mov bx, 0040h { look at 0040h:0049h to get video mode } mov es, bx mov bx, 0049h mov al, es:[bx] cmp al, 7 { see if mode = 7 (i.e., monochrome) } je @mono_segment mov ax, 0b800h { it's color: use segment B800h } jmp @got_segment @mono_segment: mov ax, 0b000h { it's mono: use segment B000h } @got_segment: push ax { PUSH video segment onto stack } mov bx, 004ah { check 0040h:0049h to get number of screen columns } xor ch, ch mov cl, es:[bx] xor ah, ah { move Y into AL; decrement to convert Pascal coords } mov al, dh dec al xor bh, bh { shift X over into BL; decrement again } mov bl, dl dec bl cmp cl, $50 { see if we're in 80-column mode } je @eighty_column mul cx { multiply Y by the number of columns } jmp @multiplied @eighty_column: { 80-column mode: it may be faster to perform the } mov cl, 4 { multiplication via shifts and adds: remember } shl ax, cl { that 80d = 1010000b , so one can SHL 4, copy } mov dx, ax { the result to DX, SHL 2, and add DX in. } mov cl, 2 shl ax, cl add ax, dx @multiplied: add ax, bx { add X in } shl ax, 1 { multiply by 2 to get offset into video segment } mov di, ax { video pointer is in DI } lea si, s { string pointer is in SI } SEGSS lodsb cmp al, 00h { if zero-length string, jump to end } je @done mov cl, al xor ch, ch { string length is in CX } pop es { get video segment back from stack; put in ES } pop ax { get color back from stack; put in AX (AH = color) } @write_loop: SEGSS lodsb { get character to write } mov es:[di], ax { write AX to video memory } inc di { increment video pointer } inc di loop @write_loop { if CX > 0, go back to top of loop } @done: { end } end; end; procedure qhor_write(x,y,aantal,teken,kleur :byte); begin for p :=1 to aantal do qwrite(x+p-1,y,chr(teken),kleur,0); end; procedure qver_write(x,y,aantal,teken,kleur :byte); begin for p :=1 to aantal do qwrite(x,y+p-1,chr(teken),kleur,0); end; procedure qhor(x,y,aantal,teken,kleur :byte); begin for p :=1 to aantal do qtext(x+p-1,y,chr(teken),kleur,0); end; procedure qver(x,y,aantal,teken,kleur :byte); begin for p :=1 to aantal do qtext(x,y+p-1,chr(teken),kleur,0); end; procedure Qtime(x,y,kleur,achtergrondkleur :byte); function leadingzero(w :word) :string; var st :string; begin str(w:0,st);if length(st) =1 then st :='0' +st;leadingzero :=st; end; var h,m,s,hund :word; begin textbackground(achtergrondkleur); textcolor(kleur);gettime(h,m,s,hund);gotoxy(x,y); writeln(' ', leadingzero(h), ':', leadingzero(m), ':', leadingzero(s), ' '); textbackground(0); end; procedure Qdate(x,y,kleur,achtergrondkleur :byte); var j,m,d,w :word; begin textbackground(achtergrondkleur); textcolor(kleur);getdate(j,m,d,w);gotoxy(x,y);write(d,'/',m,'/',j); textbackground(0); end; function Qday_Of_Week(Month,Day,Year :WORD):byte; var ivar1,ivar2 :Integer; begin IF (Day > 0) AND (Day < 32) AND (Month > 0) AND (Month < 13) then begin ivar1 := ( Year MOD 100 ); ivar2 := Day + ivar1 + ivar1 DIV 4; CASE Month OF 4, 7 : ivar1 := 0; 1, 10 : ivar1 := 1; 5 : ivar1 := 2; 8 : ivar1 := 3; 2,3,11 : ivar1 := 4; 6 : ivar1 := 5; 9,12 : ivar1 := 6; END; ivar2 := ( ivar1 + ivar2 ) MOD 7; IF ( ivar2 = 0 ) THEN ivar2 := 7; END ELSE ivar2 := 0; Qday_Of_Week := BYTE( ivar2 ); end; Function NumbofDaysInMth(y,m : Word): Byte; begin Case m of 1,3,5,7,8,10,12: NumbofDaysInMth := 31; 4,6,9,11 : NumbofDaysInMth := 30; 2 : NumbofDaysInMth := 28 + ord((y mod 4) = 0); end; end; procedure Qscreen_off; begin regs.ah := $12; { 12 = vgahi 640 x 480 } regs.al := ord(1); { 0 = on, 1 = off } regs.bl := $36; { Subfunction } intr($10, regs); { Call BIOS } end; procedure Qscreen_on; begin regs.ah := $12; { 12 = vgahi 640 x 480 } regs.al := ord(0); { 0 = on, 1 = off } regs.bl := $36; { Subfunction } intr($10, regs); { Call BIOS } end; Procedure Qdelay(ms : Word); Assembler; Asm mov ax, 1000; mul ms; mov cx, dx; mov dx, ax; mov ah, $86; int $15; end; procedure Qfill_screen(char,color :byte); begin regs.ah :=9; regs.al :=char; regs.bh :=0; regs.bl :=color; regs.ch :=7; regs.cl :=208; intr(16,regs); textbackground(0); end; procedure Qborder(kleur: byte); begin regs.ah:=$10; regs.al:=$01; regs.bh:=kleur; Intr(16,regs) end; Procedure Qsave_screen(FileName: String); var AScreen : ScreenPtr; f : FILE; begin if(LastMode = Mono) then AScreen := PTR($B000,0) else AScreen := PTR( $B800,0); assign(f,filename); rewrite(f,1); blockwrite(f,AScreen^,SIZEOF(AScreen^)); close(f); end; Procedure Qload_screen(FileName: String); var AScreen : ScreenPtr; f : FILE; begin assign(f,filename); {$I-} reset(f,1); {$I+} if ioresult <>0 then exit; blockread(f,AScreen^,SIZEOF(AScreen^)); close(f); end; procedure Qscroll(x,y :byte;s:string;back,textcolor,highlight,dlay, waitkey:word); var l,direction : byte; c : char; begin regs.ax:= $0100; regs.cx:= $2607; intr($10,regs); { hide cursor } direction:= 1; l:= 1; gotoxy(x,y); textattr:= textcolor+back*16; write(s); while (keypressed=FALSE) AND (direction>0) do begin if direction=1 then begin inc(l); if l=length(s) then direction:= 2; end else begin dec(l); if l=1 then direction:= 1; if (WaitKey=0) AND (direction=1) then begin direction:=0; gotoxy(x,y); textattr:= highlight+back*16; write(s[1]); Qdelay(dlay); end; end; if direction>0 then begin gotoxy(x+(l-1),y); textattr:= highlight+back*16; c:= s[l]; if (c>#96) AND (c<#123) then c:= chr(ord(c)-32); write(c); textattr:= textcolor+back*16; Qdelay(dlay); gotoxy(x+(l-1),y); write(s[l]); end; end; gotoxy(x,y); textattr:= textcolor+back*16; writeln(s); regs.ax:= $0100; regs.cx:= $0506; intr($10,regs); { restore cursor } end; Procedure WaitForRetrace; Begin Asm MOV DX,$3DA; @Wait1: IN AL,DX TEST AL,8 {retrace hapening?} JNZ @Wait1 {Yep, wait for it to end} @Wait2: IN AL,DX TEST AL,8 {Retrace happening?} JZ @Wait2 {nope, wait to finish} End End; Procedure SetPal(Var P; Start:Byte; Count:Word); Begin WaitForRetrace; {To eliminate snow.} Asm MOV DX,$3C8 MOV AL,Start OUT DX,AL INC DX MOV BX,DS LDS SI,P MOV CX,Count ADD CX,Count ADD CX,Count REP OUTSB MOV DS,BX End; End; Procedure GetPal(Var P; Start:Byte; Count:Word); Begin Asm MOV DX,$3C7 MOV AL,Start OUT DX,AL INC DX INC DX MOV BX,ES LES DI,P MOV CX,Count ADD CX,Count ADD CX,Count REP INSB MOV ES,BX End; End; Procedure QFade_Out; Var Pal : Array[0..255] Of Dac_Trio; Loop1,Loop2 : Byte; Begin GetPal(Orig_Pal,0,256); { Make a copy of origonal pallette } GetPal(Pal,0,255); For Loop1:=1 To 64 Do Begin For Loop2:=0 To 255 Do Begin If Pal[Loop2].Red>0 Then Dec(Pal[Loop2].Red); If Pal[Loop2].Green>0 Then Dec(Pal[Loop2].Green); If Pal[Loop2].Blue>0 Then Dec(Pal[Loop2].Blue); End; WaitForRetrace; SetPal(Pal,0,255); End; End; Procedure QFade_In; Var NewPal : Array[0..255] Of Dac_Trio Absolute orig_pal; Pal : Array[0..255] Of Dac_Trio; Loop1,Loop2 : Byte; Begin FillChar(Pal,SizeOf(Pal),0); {Set to black} SetPal(Pal,0,256); For Loop1:=63 DownTo 0 Do Begin For Loop2:=0 To 255 Do Begin If NewPal[Loop2].Red>Loop1 Then Inc(Pal[Loop2].Red); If NewPal[Loop2].Green>Loop1 Then Inc(Pal[Loop2].Green); If NewPal[Loop2].Blue>Loop1 Then Inc(Pal[Loop2].Blue); End; WaitForRetrace; SetPal(Pal,0,255); End; End; Function QGetChar(X,Y:Byte):Char; Const ColorSeg = $B800; (* For color system *) MonoSeg = $B000; (* For mono system *) begin QGetChar := Chr(Mem[ColorSeg:160*(Y-1) + 2*(X-1)]) end; procedure Qdel_file(filename :string); var f :file; begin assign(f,filename); {$I-} reset(f); {$I+} if ioresult = 0 then begin close(f); erase(f); end; end; function Qexist_file(FileName : string) : boolean; var sr : SearchRec; begin FindFirst(FileName, AnyFile, sr); QExist_File := (DosError = 0); end; function Qexist_dir(dir:string):boolean; var AktDir :string; begin IF Dir[Length(Dir)]='\' THEN Delete(Dir,Length(dir),1); GetDir(0,AktDir); {$I-} ChDir(Dir); {$I+} QExist_Dir:=(IoResult=0); ChDir(AktDir); end; procedure QGet_File_Attr(fn:string;var Attr:word); var Reg : Registers; begin fn:=fn+#0; Reg.AX:=$4300; Reg.DS:=Seg(fn[1]); Reg.DX:=Ofs(fn[1]); Intr($21,Reg); Attr:=Reg.CX; IF Odd(Reg.Flags) THEN DosError:=Reg.AX else DosError:=WORD(0); end; procedure QSet_File_Attr(fn :string;Attr:word); var Reg : Registers; begin fn:=fn+#0; Reg.AX:=$4301; Reg.CX:=Attr; Reg.DS:=Seg(fn[1]); Reg.DX:=Ofs(fn[1]); Intr($21,Reg); IF Odd(Reg.Flags) THEN DosError:=Reg.AX else DosError:=WORD(0); end; procedure QGet_File_Size(FName :string;var Fsize :longint;var Error :word); var SR : SearchRec; begin {$I-} FindFirst(FName,Archive,SR); Error := DosError; {$I+} if Error = 0 then FSize := SR.Size else FSize := 0; end; procedure QCopy_file(file_of,file_to :string); Var InFile, OutFile : File; Buffer : Array[ 1..1024 ] Of Char; NumberRead, NumberWritten : Word; begin Assign(InFile,file_of); {$I-} Reset(InFile,1); {$I+} { neemt bestand van c: } if ioresult <>0 then exit; { als bestand niet is gevonden } Assign(OutFile,file_to); { bestand voor a: } ReWrite(OutFile,1); Repeat BlockRead ( InFile, Buffer, Sizeof( Buffer ), NumberRead ); BlockWrite( OutFile, Buffer, NumberRead, NumberWritten ); Until (NumberRead = 0) or (NumberRead <> NumberWritten); Close(InFile); Close(OutFile); end; procedure Qclear_buffer; begin memw[$0000:$041C] :=memw[$0000:$041A]; end; function Qread_key :word; var Value : word; begin repeat until KeyPressed; Value := Ord(ReadKey); if Value = 0 then Value := Ord(ReadKey) + 256; Qread_key := Value; end; procedure Qsound(freq,delay :integer); begin sound(freq);Qdelay(delay);nosound; end; procedure Qinfo(regel :string); const lett : array[65..90] of string[1] =('A','B','C','D','E','F','G','H', 'I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'); var kleur : byte; aantal : integer; begin x :=40-(round(length(regel)/2)); Qhor(4,23,74,219,0); for p :=1 to length(regel) do begin { zoekt de hoofdletters op } s :=copy(regel,p,1); kleur :=7; { en zet deze om in een } for aantal :=65 to 90 do begin { andere kleur } if lett[aantal]=s then kleur :=13; end; gotoxy(x+1,23); textbackground(0); textcolor(kleur); write(s); inc(x); end; textbackground(0); end; procedure Qwindow(lx,ly,rx,ry :integer;kleur :byte); begin textcolor(kleur); window(lx,ly,rx,ry);clrscr;window(lx,ly,rx+1,ry); gotoxy(1,1);write(chr(218)); { linksboven } for p :=1 to ((rx -lx) -1) do write(chr(194)); { boven } write(chr(191)); { rechtsboven } for p :=1 to ((ry -ly) -1) do begin gotoxy(1,1 +p);write(chr(195)); { links } gotoxy((rx -lx)+1,1 +p);write(chr(180)); { rechts } end; gotoxy(1,(ry -ly) +1);write(chr(192)); { linksonder } for p :=1 to ((rx -lx) -1) do write(chr(193)); { onder } write(chr(217)); { rechtsonder } window(1,1,80,25); end; procedure read_dacs(Var Dac : DacType); begin regs.ax := $1017; regs.bx := 0; regs.cx := 256; regs.es := SEG(Dac); regs.dx := Ofs(Dac); Intr($10, regs); end; procedure write_dacs(Dac : DacType); begin regs.ax := $1012; regs.bx := 0; regs.cx := 256; regs.es := seg(Dac); regs.dx := Ofs(Dac); Intr($10, regs); end; procedure Qfadeout(Speed : Integer); begin; Repeat erg := 0; For x := 1 to 256 do For y := 1 to 3 do begin if dac2[x, y] > 0 then DEC(dac2[x, y]); erg := erg + dac2[x, y]; end; Write_Dacs(dac2); Qdelay(Speed); Until erg = 0; end; procedure QfadeIn(Speed : Integer); begin; Repeat erg := 0; For x := 1 to 256 do For y := 1 to 3 do begin if dac2[x, y] < dac1[x, y] then INC(dac2[x,y]); erg := erg + dac2[x, y]; end; Write_Dacs(dac2); Qdelay(Speed); Until (erg = gesamt) or (KeyPressed); Write_Dacs(dac1); end; function Qerror(ErrorCode :INTEGER):STRING; begin case ErrorCode OF 0: QError := 'No Error'; 2: QError := 'File Not Found'; 3: QError := 'Path Not Found'; 4: QError := 'Too Many Open Files'; 5: QError := 'File Access Denied'; 6: QError := 'Invalid File Handle'; 12: QError := 'Invalid File Access Code'; 15: QError := 'Invalid Drive Number'; 16: QError := 'Cannot Remove Current Directory'; 17: QError := 'Cannot Rename Across Drives'; 18: QError := 'File access error'; 100: QError := 'Disk Read Error'; 101: QError := 'Disk Write Error'; 102: QError := 'File Not Assigned'; 103: QError := 'File Not Open'; 104: QError := 'File Not Open For Input'; 105: QError := 'File Not Open For Output'; 106: QError := 'Invalid Numeric Format'; 150: QError := 'Disk Is Write-Protected'; 151: QError := 'Unknown Unit'; 152: QError := 'Drive Not Ready'; 153: QError := 'Unknown Command'; 154: QError := 'CRC Error In Data'; 155: QError := 'Bad Drive Request Structure Length'; 156: QError := 'Disk Seek Error'; 157: QError := 'Unknown Media Type'; 158: QError := 'Sector Not Found'; 159: QError := 'Printer Out Of Paper'; 160: QError := 'Device Write Fault'; 161: QError := 'Device Read Fault'; 162: QError := 'Hardware Failure'; end; end; function Qprinter_ok :boolean; begin If (Port[$379]) And (16) <> 16 Then QPrinter_OK := False Else QPrinter_OK := True; end; {******************************* RAAM *************************************} function F_Video :Word; var Regs : REGISTERS; begin INTR($11, Regs); if (Regs.AL and 48) = 48 then F_Video := $B000 else F_Video := $B800; end; procedure InitVensters; begin New(VideoVenster); for p := 0 to MaxVensters do New(raam[p]); with VideoVenster^ do begin VenX1 := 0; VenY1 := 0; VenX2 := 82; VenY2 := 26; end; VenTeller := 0; raam[VenTeller]^ := VideoVenster^; VideoVenster := Ptr(F_Video, $0000); end; procedure Kader1(x,y,xx,yy,ak :Byte); { voor kleur } begin textbackground(ak); window(x,y,xx,yy);clrscr;window(x,y,xx+1,yy); gotoxy(1,1);write(chr(218)); gotoxy(1,(yy-y+1));write(chr(192)); gotoxy((xx-x+1),1);write(chr(191)); gotoxy((xx-x+1),(yy-y+1));write(chr(217)); for p := 2 to(xx-x) do begin gotoxy(p,1);write(chr(194));end; for p := 2 to(xx-x) do begin gotoxy(p,(yy-y+1));write(chr(193));end; for p := 2 to(yy-y) do begin gotoxy(1,p);write(chr(195));end; for p := 2 to(yy-y) do begin gotoxy((xx-x+1),p);write(chr(180));end; window(x+1,y+1,xx-2,yy-1); textbackground(0); end; procedure Kader2(x,y,xx,yy,ak :Byte); { voor monocroom } begin textbackground(ak); window(x,y,xx,yy);clrscr;window(x,y,xx+1,yy); gotoxy(1,1);write(chr(218)); gotoxy(1,(yy-y+1));write(chr(192)); gotoxy((xx-x+1),1);write(chr(191)); gotoxy((xx-x+1),(yy-y+1));write(chr(217)); for p := 2 to(xx-x) do begin gotoxy(p,1);write(chr(196));end; for p := 2 to(xx-x) do begin gotoxy(p,(yy-y+1));write(chr(196));end; for p := 2 to(yy-y) do begin gotoxy(1,p);write(chr(179));end; for p := 2 to(yy-y) do begin gotoxy((xx-x+1),p);write(chr(179));end; window(x+1,y+1,xx-2,yy-1); textbackground(0); end; procedure Qopen_window(x,y,xx,yy,color,back :Byte); begin textcolor(color); if (VenTeller < MaxVensters) and (x < xx) and (x >= 1) and (xx <= 80) and (y < yy) and (y >= 1) and (yy <= 25) then begin raam[VenTeller]^.Data :=VideoVenster^.Data; raam[VenTeller]^.XPos :=WHEREX; raam[VenTeller]^.YPos :=WHEREY; Inc(VenTeller); WINDOW(x+1,y+1,xx-2,yy-1); with raam[VenTeller]^ do begin VenX1 := x; VenY1 := y; VenX2 := xx; VenY2 := yy; end; if f_video =$B800 then kader1(x,y,xx,yy,back) else kader2(x,y,xx,yy,back); end else begin window(1,1,80,25);clrscr; gotoxy(3,5); write('FOUT MET VENSTERS '); delay(1000); end; end; procedure Qclose_window; begin if VenTeller > 0 then begin Dec(VenTeller); VideoVenster^.Data :=raam[VenTeller]^.Data; with raam[VenTeller]^ do begin WINDOW(VenX1+1,VenY1+1,VenX2-2,VenY2-1); GOTOXY(XPos, YPos); end; end else begin CLRSCR; GOTOXY(3, 5); Write('GEEN VENSTER AANWEZIG '); DELAY(1000); end; end; Function Upcase_string(regel :string):string; begin for p :=1 to length(regel) do regel[p] :=upcase(regel[p]); Upcase_string :=regel; end; Function Upcase_First_char(regel :string):string; begin regel :=lowcase_string(regel); s :=copy(regel,1,1); for p :=1 to length(s) do s[p] :=upcase(s[p]); delete(regel,1,1); insert(s,regel,1); Upcase_First_char :=regel; end; Function Lowcase_string(regel:String):string; Function DWNCase(DWNCH:Char):Char; begin if dwnch in['A'..'Z'] then dwncase :=chr(ord(dwnch)+32) else dwncase :=dwnch; end; begin For p:=1 to LENGTH(regel) do regel[p]:=DWNCase(regel[p]); lowcase_string :=regel; end; begin textmode(CO80); InitVensters; Read_Dacs(dac1); dac2 := dac1; gesamt := 0; For x := 1 to 256 do For y := 1 to 3 do gesamt := gesamt + dac1[x, y]; { The authors name in the beginning of this unit Qcursor(off); Qfill_screen(219,0); clrscr; Qread_char; Qfont_jos; gotoxy(26,12);textcolor(12); writeln('Ҿ ⫝̸ ߿'); Qdelay(1000); Qfadeout(10); Qreset_char; clrscr; Qfadein(0); } end.
|
