{ MCRT01.PAS Copyright (c) Ales Kucik } { Moje CRT ver. 01 } { Modul s ruznymi uzitecnymi procedurami a funkcemi pro praci s v/v } { } { Datum:09.04.2002 http://www.trsek.com } unit MCRT01; { KONSTANTY: page0, page1, page2, page3 - ofsety jednotlivych videostranek page_size - velikost videostranky (jen pro obrazovku 80x25) PROMENNE: ActivePage - aktivni videostranka; VideoSeg - segment pocatku videopameti PROCEDURY A FUNKCE: procedure SetCursor(h,d:byte); -nastavi velikost kurzoru (cisla v intervalu 0..7) procedure CursorOn; -nastavi velikost kurzoru na puvodni velikost procedure CursorOff; -skrije kurzor procedure GetChar(var character:char; var attr:byte); -cte znak z aktualni pozice kurzoru, vrati znak a jeho atribut Parametry: -character - vraci znak precteny z aktualni pozice kurzoru -attr - vraci cislo atributu precteneho znaku procedure SetActivePage(number:byte); -nastavi aktivni videostranku Parametr: -number - cila z intervalu 0..3 procedure CopyPage(source, destination:word); -kopirovani videostranek (!! ZADAVAT OFSETY!!) Parametry: -source - ofset zdrojove videostranky -destination - oset cilove videostranky procedure WriteXY(x,y:byte; s:string); -zobrazi text na danych souradnicich Parametry: -x - cislo sloupce -y - cislo radky -s - text pro zobrazeni procedure HWriteXY(x,y,z,c:byte; s:string); -zobrazi text na danych souradnicich s jednim zviraznenym pismenem Parametry: -x - cilo sloupce -y - cislo radky -z - cislo zvirazneneho znaku text. retezce -c - barva zvirazneni procedure NormalWin(x1,y1,x2,y2:byte); -vytvori okno o danych souradnicich Parametry: -x1,y1 - souradnice leveho horniho rohu okna (cislo sloupce, radku) -x2,y2 - souradnice praveho dolniho rohu okna (sloupe, radek) procedure ErrorMes(s:string); -zobrazi hlaseni o chybe, zlutym pismem na cervenem podklade a ceka na stisk libovolne klavesy -max 28 znaku Parametr: -s - hlaseni o chybe function YesNo:boolean; -pri stisku klaves 'A','a' vraci true -pri stisku klaves 'N','n' vraci false function YesNoQ(s:string):boolean; -zobrazi dotaz a ceka na stisk klaves 'a,'A' pro ANO (pak vrati true) nebo 'n','N' pro NE (pak vrati false) -max 28 znaku Parametr: -s - text. retezec otazky function GetKey:integer; -Vraci cislo stisknute klavesy. Jsou zde osetreny i specialni klavesy, ktere nejprve posilaji znak cislo 0 a potom dalsi. Rozliseni je provedeno prictenim 256 k hodnote znaku. function GetTextMode:byte; -vraci cislo textoveho modu, precteno z datove oblasti BIOSu function GetActivePage:byte; -vraci cislo aktivni videostranky } interface uses Crt; const page0= $0000; page1= $1000; page2= $2000; page3= $3000; page_size=$FA0; var ActivePage:byte; VideoSeg:word; procedure SetCursor(h,d:byte); {Cisla v intervalu 0..7} procedure CursorOn; procedure CursorOff; procedure GetChar(var character:char; var attr:byte); procedure SetActivePage(number:byte); procedure CopyPage(source, destination:word); procedure WriteXY(x,y:byte; s:string); procedure HWriteXY(x,y,z,c:byte; s:string); procedure NormalWin(x1,y1,x2,y2:byte); procedure ErrorMes(s:string); function YesNoQ(s:string):boolean; function YesNo:boolean; function GetKey:integer; function GetTextMode:byte; {Vraci cislo textoveho modu} function GetActivePage:byte; implementation procedure SetCursor; assembler; asm mov ah, 01b mov cl, d mov ch, h int 10h end; procedure CursorOn; assembler; asm mov ah, 01h mov cl, 07h mov ch, 06h int 10h end; procedure CursorOff; assembler; asm mov ah, 01h mov cl, 20h mov ch, 20h int 10h end; procedure GetChar(var character:char; var attr:Byte); var l,h:byte; begin asm mov bh, 0h mov ah, 8h int $10 mov l, al mov h, ah end; character:=chr(l); attr:=h; end; function GetTextMode; var b:byte absolute 0:$0449; begin GetTextMode:=b; end; procedure SetActivePage; begin asm mov ah, 05h mov al, number int 10h end; ActivePage:=number; end; procedure CopyPage; begin move(mem[VideoSeg:source],mem[VideoSeg:destination],page_size); end; function GetActivePage:byte; begin GetActivePage:=ActivePage; end; function GetKey:integer; var a:integer; begin a:=ord(readkey); while a=0 do a:=256+ord(readkey); GetKey:=a; end; procedure WriteXY; begin gotoxy(x,y); write(s); end; procedure HWriteXY; var attr:byte; begin gotoxy(x,y); attr:=textattr; write(s); textcolor(c); gotoxy(x+z-1,y); write(s[z]); textattr:=attr; end; procedure NormalWin; var i,j:byte; begin window(x1,y1,x2,y2); clrscr; gotoxy(2,1); write(#201); for i:=1 to x2-x1-3 do write(#205); write(#187); for i:=2 to y2-y1 do begin gotoxy(2,i); write(#186); gotoxy(x2-x1,i); write(#186); end; gotoxy(2,y2-y1+1); write(#200); for i:=1 to x2-x1-3 do write(#205); write(#188); if lastmode>=256 then window(1,1,80,50) else window(1,1,80,25); end; procedure ErrorMes; var x,l:byte; attr:byte; begin attr:=TextAttr; textcolor(yellow); textbackground(red); l:=length(s); if l<28 then l:=28; x:=(80-l)div 2 -2; NormalWin(x,11,x+l+4,14); writeXY(x+2,12,s); l:=(l-28)div 2; writeXY(x+l+2,13,'Neco stiskni!'); GetKey; TextAttr:=attr; end; function YesNo:boolean; var nr:integer; {cislo stisknute klavesy} c:char; {znak stisknute klavesy} begin c:='x'; {prednastaveni hodnoty (ruzne od A a N)} repeat nr:=getkey; {precteni cisla znaku} if nr<256 then c:=upcase(chr(nr)); until c in ['A','N']; YesNo:= c='A'; end; function YesNoQ(s:string):boolean; var x,l:byte; attr:byte; begin attr:=TextAttr; textcolor(lightgreen); textbackground(lightblue); l:=length(s); if l<28 then l:=28; x:=(80-l)div 2 -2; NormalWin(x,11,x+l+4,14); writeXY(x+2,12,s); l:=(l-28)div 2; writeXY(x+l+2,13,'Stiskni ''A''=ANO ''N''=NE'); YesNoQ:=YesNo; TextAttr:=attr; end; begin ActivePage:=0; if GetTextMode=7 then VideoSeg:=$B000 else VideoSeg:=$B800; end.