SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00032 SCREEN HANDLING ROUTINES 1 05-28-9313:56ALL SWAG SUPPORT TEAM CLRSCR1.PAS IMPORT 7 Procedure fillWord(Var dest; count, data: Word);πbeginπ Inline(π $C4/$BE/dest/ { les di, dest[bp] }π $8B/$8E/count/ { mov cx, count[bp] }π $8B/$86/data/ { mov ax,data[bp] }π $FC/ { cld }π $F3/$AB { rep stosw }π )πend;ππProcedure ClrScr;πVarπ screen: Array[1..25, 1..80, 1..2] of Char Absolute $b800:$0000;πbeginπ fillWord(screen, sizeof(screen) div 2, $0720)πend;ππ{ or }ππProcedure ClrScr;πTypeπ TScreen: Array[1..25, 1..80, 1..2] of Char;πVarπ VideoSegment: Word;πbeginπ if (MemW[$40:$10] and $30)=$30 thenπ VideoSegment:=$B000π elseπ VideoSegment:=$B800;π fillWord(ptr(VideoSegment, 0)^, sizeof(TScreen) div 2, $0720)πend; 2 05-28-9313:56ALL SWAG SUPPORT TEAM CLRSCR2.PAS IMPORT 4 {π>How do you Write a clear screen Procedure in standard pascal forπ>the vax system? I talking about a nice clear screen prgm that does'tπ>scroll everything off the screen. Something that works in a flash..π}ππConstπ clear_screen = CHR(27) + CHR(91) + CHR(50) +CHR(74);ππbeginπ Write(clear_screen);π readln;πend. 3 05-28-9313:56ALL SWAG SUPPORT TEAM CLRSCR3.PAS IMPORT 7 {πMICHAEL NICOLAIππYou want to clear the entire screen? Then just Write 00 in every Byte!πYou have to save the screen first, of course. :-)ππThis Procedure saves the screen, clears it, waits For a keystroke andπthen restores the screen:π}ππUsesπ Crt;ππProcedure ClearScreen;πConstπ lines = 50; { number of lines }π length = 160 * lines - 1;πVarπ i : Word;π screen : Array [0..length] of Byte;πbeginπ { save the screen }π For i := 0 to length doπ screen[i] := mem[$B800 : i];π { blank screen }π For i := 0 to length doπ mem[$B800 : i] := 0;π { wait For keystroke }π While (NOT KeyPressed) do;π { restore screen }π For i := 0 to length doπ mem[$B800 : i] := screen[i];πend;ππbeginπ ClearScreen;πend.π 4 05-28-9313:56ALL SWAG SUPPORT TEAM DUALOUT1.PAS IMPORT 21 {π> Who knows how to detect and access dual display's?ππAs this feature is only available if you're using VGA as the primary adapterπyou can get information about a second adapter by interrupt 10h.ππ Get primary/secondary video adapter:π interrupt: 10hπ input: AH = 1Ahπ AL = 00h (subFunction)π output: AL = 1Ah (indicates Function support)π BL = code For active card (primary one)π BH = code For inactive cardππ where following codes are valid:π 00h no cardπ 01h MDA With monochrome displayπ 02h CGA With CGA displayπ 03h reservedπ 04h EGA With EGA or multiscan displayπ 05h EGA With monochrome displayπ 06h reservedπ 07h VGA With monochrome displayπ 08h VGA With VGA or multiscan displayπ 09h reservedπ 0Ah MCGA With CGA display (PS/2)π 0Bh MCGA With monochrome display (PS/2)π 0Ch MCGA With color display (PS/2)π FFh unknownππ Set primary/secondary video adapter:π interrupt: 10hπ input: AH = 1Ahπ AL = 01h (subFunction)π BL = code For active card (here secondary one)π BH = code For inactive cardπ output: AH = 1Ah (indicates Function support)ππFirst you call subFunction 00h to get the code of your primary and secondaryπvideo adapter. Then you can toggle between them by using subFunction 01h.ππTo get back ontopic (Pascal code is needed ;-)) here's a simple example For aπtoggle Procedure:π}πUses Dos;ππProcedure ToggleAdapters;πVar Regs : Registers;π Active,Inactive : Byte;πbeginπ Regs.AH := $1A;π Regs.AL := $00;π Intr($10,Regs);π If Regs.AL=$1A Then { is Function supported? (is VGA?) }π beginπ Active := Regs.BL; { exchange both codes }π Inactive := Regs.BH;π Regs.AH := $1A;π Regs.AL := $01;π Regs.BL := Inactive;π Regs.BH := Active;π Intr($10,Regs); { now you can't see me }π end;πend;π 5 05-28-9313:56ALL SWAG SUPPORT TEAM GETCHAR1.PAS IMPORT 12 {π│What would be the best way to find out what Character is at a certainπ│location on the screen. For example, Lets say I went to locationπ│(10,2) and at that location is the letter 'S' now withoutπ│disturbing the letter S how can I determine if it is there or not?πππA 25-line by 80-column screen has 2,000 possible cursor positions. Theπ2,000 Words that begin at the memory location $B800:0000 (or $B000:0000 ifπyour machine is monochrome) define the current image. The first Byte ofπeach Word is the ASCII Character to be displayed, and the second Byte isπthe attribute of the display, which controls such Characteristics as colorπand whether it should blink....ππI you used the standard (X,Y) coordinate system to define a cursor positonπon the screen, With the upper left corner at (1,1) and lower right cornerπat (80,25), then With a lettle algebra you can see that the offset valueπFor a cursor position can be found at:ππ Words: 80*(Y-1) + (X-1)πorπ Bytes: 160*(Y-1) + 2*(X-1)πππHere's a Function that will return the Character at location (X,Y):ππ}πFunction GetChar(X,Y:Byte):Char;π (* Returns the Character at location (X,Y) *)πConstπ ColorSeg = $B800; (* For color system *)π MonoSeg = $B000; (* For mono system *)πbeginπ GetChar := Chr(Mem[ColorSeg:160*(Y-1) + 2*(X-1)])πend;π 6 05-28-9313:56ALL SWAG SUPPORT TEAM GETCHAR2.PAS IMPORT 9 {π>I need a routine that will go to a specific screen position and grab oneπ>or two Characters that are there (or next to it) - e.g It would go to rowπ>1 column 1 and return With the Character in that spot..ππTry this For TP 6.0π}ππUsesπ Crt;ππFunction ScrnChar(x,y:Byte):Char;πVarπ xkeep, ykeep : Byte;πbeginπ xkeep := whereX;π ykeep := whereY;π GotoXY(x, y);π Asmπ push bxπ mov ah,8π xor bx,bxπ int 16π mov @Result,alπ pop bxπ end;π GotoXY(xkeep,ykeep)πend;π{πI am not sure about the "@Result" as being the correct name, but TP 6.0 has aπname that is used For the result of a Function. This should be Compatible withπthe Windows etc. of TP 6.0π}ππVarπ ch : Char;π Count : Integer;ππbeginπ ClrScr;π For Count := 1 to 500 doπ beginπ Write(chr(Count));π if count mod 80 = 0 thenπ Write(#13#10);π end;π ch := scrnChar(5,5);π Write(#13#10#10#10#10#10,'The Character at position (5,5) is: ',ch);π readln;πend. 7 05-28-9313:56ALL SWAG SUPPORT TEAM GETSTRNG.PAS IMPORT 10 Unit scn_io;ππInterfaceππProcedure GetScreenStr(x, y, l: Integer; Var s: String);ππImplementationππProcedure GetChar(x, y: Integer; Var ch: Char);π(*** gets the Character from screen position x, y;π x is horizontal co-ord, y is vertical;π top left corner is 0,0 ***)πConstπ base = $b800; (* $b000 For mono *)πVarπ screen_Byte: Byte;π offs: Integer;πbeginπ offs := ( (y*80) + x ) * 2;π screen_Byte := mem[base: offs];π ch := chr(screen_Byte);πend{proc..};ππProcedure PutChar(x, y: Integer; ch: Char);π(*** pits the Character ch to screen position x, y; ***)πConstπ base = $b800; (* $b000 For mono *)πVarπ screen_Byte: Byte;π offs: Integer;πbeginπ offs := ( (y*80) + x ) * 2;π screen_Byte := ord(ch);π mem[base: offs] := screen_Byte;πend{proc..};ππProcedure GetScreenStr(x, y, l: Integer; Var s: String);π(*** gets the String from screen position x,y of length l ***)πVarπ i: Integer;π ch: Char;πbeginπ s := '';π For i := 1 to l doπ beginπ GetChar(x, y, ch);π s := s + ch;π inc(x);π if x > 79 thenπ beginπ inc(y); x:= 0;π end{if x >..};π end{For i..}πend{proc..};ππend{Unit..}.π 8 05-28-9313:56ALL SWAG SUPPORT TEAM SAVERES.PAS IMPORT 10 Uses Dos,Crt;π{ saves and restores and area of screen }πConstπ Max = 3;ππTypeπ ScreenImage = Array[0..1999] of word;π FrameRec = Recordπ Upperleft : Word;π LowerRight : Word;π ScreenMemory : ScreenImage;π End;ππVARπ SnapShot : ^ScreenImage;π FrameStore : Array [1..10] of ^FrameRec;π WindowNum : Byte;ππProcedure OpenWindow(UpLeftX,UpLeftY,LoRightX,LoRightY : Byte);πBeginπ SnapShot := Ptr( $B800, $0000);π Inc(WindowNum);π New(FrameStore[WindowNum]);π WITH Framestore[WindowNum]^ doπ Beginπ ScreenMemory := SnapShot^;π UpperLeft := WindMin;π LowerRight := WindMax;π end;π Window(UpLeftX,UpLeftY,LoRightX,LoRightY);πend;ππProcedure CloseWindow;πBeginπ With Framestore[WindowNum]^ doπ Beginπ Snapshot^ := ScreenMemory;π Window ( (Lo(UpperLeft)+1), (Hi(UpperLeft)+1),π (Lo(LowerRight)+1), (Hi(LowerRight)+1) );π end;π Dispose( Framestore[WindowNum]);π Dec(WindowNum);πEnd;ππBeginπOpenWIndow(3,3,45,15);πClrScr;πReadkey;πCloseWindow;πEnd.π 9 05-28-9313:56ALL SWAG SUPPORT TEAM SCRLTEXT.PAS IMPORT 5 Usesπ Crt;ππProcedure ScrollTextLine (x1, x2 : Integer ; y : Integer ; St : String) ;πbeginπ While Length(St)<(x2-x1+1) Doπ St:=St+' ' ;π While not KeyPressed Doπ beginπ GotoXY(x1, y) ;π Write(Copy(St, 1, x2-x1+1)) ;π Delay(100) ;π St:=Copy(St, 2, Length(St)-1)+St[1] ;π end ;πend ;ππbeginπ ClrScr;π TextColor(lightgreen);π scrollTextline(10,60,12,'Hello There!');πend. 10 05-28-9313:56ALL SWAG SUPPORT TEAM SCRNSAVE.PAS IMPORT 18 { GLEN WILSON }ππ{$m 2000,0,0} (* Stops Pascal using all of memory *)π{$R-,s-,v-,b-,n-,l+} (* Nothing important, helps keep the size down*)πProgram screensaver; (* Only blanks screen on CGA/Mono not VGA/etc*)ππUsesπ Dos, Crt;ππConstπ TimerInt = $08; {Timer Interrupt}π KbdInt = $09; {Keyboard Interrupt}π Timerlimit : Word = 5460; {5 minute Delay}ππVarπ Regs : Registers;π Cnt : Word;π PortNum : Word;π PortOff : Word;π Porton : Word;π OldKBDVEC : Pointer;π OldTimerVec : Pointer;π i : Real;π code : Real;πππProcedure STI;πInline($FB);ππProcedure CLI;πInline($FA);ππProcedure CallOldInt(Sub : Pointer);π(* Primitive way of calling Old Interrupt, never the less, you can see what isπ happening! *)πbeginπInline($9c/ { PushF }π $FF/$5e/$06); { Call DWord PTR [BP+6] }πend;ππProcedure Keyboard(flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word); Interrupt;ππbeginπ CallOldInt(OldKbdVec);π if (CNT >= Timerlimit) thenπ port[portnum] := porton;π Cnt := 0;π STI;πend;ππProcedure Clock(flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word); Interrupt;πbeginπ CallOldInt(OldTimerVec);π if (CNT > Timerlimit) thenπ Port[portnum] := portoffπ elseπ Inc(Cnt);π STI;πend;πππbeginπ Regs.AH := $0F;π INTR($10, regs); (* determine Type of video adapter (Mono or Cga) *)ππ if Regs.AL= 7 thenπ beginπ Portnum := $3b8;π Portoff := $21;π PortOn := $2d;π endπ elseπ beginπ Portnum:=$3d8;π Portoff:=$25;π porton :=$2d;π end;ππ (* Save original Procedures *)π GetIntVec(KbdInt, OldKbdVEc);π GetIntVec(TimerInt, OldTimerVec);ππ (* Install new Interrupts *)π SetIntVec(timerint, @clock);π SetIntVec(KbdInt, @Keyboard);ππ Cnt := 0; (* Initialize counter *)π Keep(0); (* Tell Pascal to keep us in memory *)πend.ππ{πit seems rather complex but most of that crap is For turningπon and off the screen. if you don't have a CGA or MONO you can replace theπPort crap With Writeln statements so you can see whats hapening.ππBTW This is an example from a Programming book ( can't remember what it isπcalled ) becareful, It might be covered by Copy right laws.π}π 11 05-28-9313:56ALL SWAG SUPPORT TEAM SCRWRIT1.PAS IMPORT 19 {πDoes any one know of a way to Write 80 chrs to the bottom line of theπscreen without the screen advancing?ππYou're gonna have to Write directly to the screen : the problem is that,πwhen you use std ways to Write to the screen, the cursor is always oneπCharacter ahead of the Text you displayed... so standard display procsπcan not be used to Write to the 80th Character of the 25th line.ππHere is a simple proc to Write Text directly to the screen :π}ππConstπ VideoSeg : Word = $b800 ; { Replace With $b000 if no color card }ππProcedure DisplayString(x, y : Byte; Zlika : String; Attr : Byte); Assembler ;ππ{ x and y are 0-based }πAsmπ Mov ES, VideoSeg { Initialize screen segment adr }ππ { Let's Compute the screen address of coordinates (x, y) }π { Address:=(160*y)+(x ShL 2) ; }π Mov AL, 160 { 160 Bytes per screen line }π Mul Byte Ptr yπ Mov BL, xπ Xor BH, BHπ ShL BX, 1 { 2 Bytes per on-screen Character }π Add BX, AX { BX contains offset where to display }ππ { Initialize stuff... }π Push DS { Save DS }π ClD { String ops increment DI, SI }π LDS SI, Zlika { DS:DI points to String }π LodSB { Load String length in AL }π Mov CL, AL { Copy it to CL }π Xor CH, CH { CX contains String length }π Mov DI, BX { DI contains address where to display }π Mov AH, Attr { Attribute Byte in AH }π@Boucle:π LodSB { Load next Char to display in AL }π StoSW { Store Word (attr & Char) to the screen }π Loop @Boucle { Loop For all Chars }ππ Pop DS { Restore DS }πend ;ππ{πFurthermore, this is definitely faster than using Crt.Write...πI will ask those ones owning a CGA card to Forgive me, I ommited toπinclude the usual snow-checking... but this intends to be a shortπexample :-))πAlso note that there is no kind of checking, so you can Write out ofπthe screen if you want... but that's no good idea.πBTW, the attribute Byte value is Computed With the "magic Formula"πAttr:=Foreground_Color + (16 * Background_color) [ + 128 For blinking ]π}π 12 05-28-9313:56ALL SWAG SUPPORT TEAM SCRWRIT2.PAS IMPORT 21 {π SO> Got a question For you all out there..... How the heck can I Write aπ SO> Character into the bottom right corner of a Window without the Windowπ SO> scrolling?π SO>π SO> if anyone knows some way to keep the Write command from Forwarding theπ SO> cursor position Pointer, that would be fine enough For me.....ππSean, here is a way to do it without resorting to poking the screen.π}ππ{$A+,B+,D+,E-,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V-,X+,Y+}π{$M 8192,0,0}ππUsesπ Crt;πVarπ index1, Index2: Byte;ππbeginπ ClrScr;ππ{******************************************π First Write top line of bordered displayπ******************************************}ππ Write ('╔'); {Write top Left Corner}π For Index1 := 1 to 78 do {Write top Horizontal line }π Write ('═');π Write ('╗'); {Write top Right Corner}ππ{*******************************************π Now Write Bottom line of bordered displayπ*******************************************}ππ Write ('╚'); {Write Bottom Left Corner}π For Index1 := 1 to 78 do {Write Bottom horizontal line}π Write ('═');π Write ('╝'); {Write Bottom Right Corner}ππ{********************************************************************π Now inSERT 23 lines of Left&Right bordered display, pushing bottomπ line down as we doπ********************************************************************}ππ For Index1 := 1 to 23 do begin { Repeat 23 times }π GotoXY (1, 2); {Move cursor back to Col 1, Line 2}π InsLine; {Insert blank line (Scroll Text down)}π Write ('║'); {Write Left border vertical caracter}π For Index2 := 1 to 78 do {Write 78 spaces}π Write (' ');π Write ('║'); {Write Right border vertical caracter}π end;ππ{***********************************************************π I added this so the Program would pause For a key. This wayπ it will allow you to see that it does not scroll up sinceπ the cursor never Writes to position 25,80π***********************************************************}ππ Asm {Assembler code to flush keyboard}π mov Ax, 0C00h;π Int 21h;π end;π ReadKey ; {Wait For a keypress}ππend.ππ{πBTW, this was written, Compiled and Tested in BP 7.0 but should work inπTP 4.0 and up if you remove the Assembler stuff.π} 13 05-28-9313:56ALL SWAG SUPPORT TEAM SPEEDVID.PAS IMPORT 35 Unit SpeedVid;ππ{ High speed Text-video routines For working With binary Files, direct }π{ screen access etc. (c)1993 Chris Lautenbach }π{ }π{ You are hereby permitted to use this routines, so long as you give me }π{ credit. If you modify them, do not distribute the modified version. }π{ }π{ Notes: This Unit will work fine in 50 line mode, or on monochrome }π{ monitors. Remember; when working in 50 line mode, always }π{ make sure you call Window(1,1,80,50) so that WindMax is }π{ updated With the correct screen co-ordinates. In addition, }π{ the ScrollScreen() routine is much faster than it's standard }π{ BIOS Int 10h counterpart. }π{ }π{ Turbo Professional users have no need For FastWrite(), }π{ VideoMode, or ScreenHeight - since these are approximations }π{ are provided For use by people who do not have the TpCrt }π{ Unit. }π{ }π{ If you need to contact me, I can be found in the NANet, City2City, }π{ and Intelec Pascal echoes - or at my support BBS, Toronto Twilight }π{ Communications (416) 733-9012. Internet: cs911212@iris.ariel.yorku.ca }ππInterfaceππUsesπ Dos, Crt;ππConstπ MonoMode : Boolean = False;ππTypeπ ScreenLine = Array[1..160] of Char;π ScreenBuffer = Array[1..50] of ScreenLine;π DirectionType = (Up, Down);ππVarπ VideoScreen : ScreenBuffer Absolute $B800:$0000;π MonoScreen : ScreenBuffer Absolute $B000:$0000;ππFunction VideoMode : Byte; { Get video mode }πFunction ScreenHeight : Byte; { Return height of screen in lines }πProcedure ScrollScreen(Direction : DirectionType); { Scroll screen up/down }πProcedure FastWrite(st:String; x,y,color:Byte); { Write Text to vid mem }πProcedure RestoreScreen(Var p:Pointer); { Restore saved screen }πProcedure SaveScreen(Var p:Pointer); { Save screen to a Pointer }ππImplementationππFunction VideoMode : Byte;πVarπ Mode : Byte;πbeginπ Asmπ MOV AH, 0Fh { Set Function to 0Fh - Get current video mode }π INT 10h { Call interrupt 10h - Video Services }π MOV Mode, AL { Move INT 10h result to Mode Variable }π end;π VideoMode := Mode;πend;ππFunction ScreenHeight:Byte;πbeginπ ScreenHeight := (Hi(WindMax) + 1);πend;ππProcedure ScrollScreen(Direction : DirectionType);πbeginπ Case Direction ofπ Up :π If MonoMode thenπ Move(MonoScreen[2],MonoScreen[1],Sizeof(ScreenLine)*(ScreenHeight-1))π ELSEπ Move(VideoScreen[2],VideoScreen[1],Sizeof(ScreenLine)*(ScreenHeight-1));π Down :π If MonoMode thenπ Move(VideoScreen[1],VideoScreen[2],Sizeof(ScreenLine)*(ScreenHeight-1))π ELSEπ Move(VideoScreen[1],VideoScreen[2],Sizeof(ScreenLine)*(ScreenHeight-1));π end; { Case }πend;ππProcedure FastWrite(st:String; x,y,color:Byte);π{ Write a String directly to the screen, x=column, y=row }πVarπ idx, cdx : Byte;πbeginπ idx := x * 2;π cdx := 1;π Repeatπ {$R-}π If MonoMode thenπ beginπ MonoScreen[y][idx+2] := Chr(Color);π MonoScreen[y][idx+1] := St[cdx];π endπ ELSEπ beginπ VideoScreen[y][idx+2] := Chr(Color);π VideoScreen[y][idx+1] := St[cdx];π end;π {$R+}π Inc(idx,2);π Inc(cdx,1);π Until cdx>=length(st);πend;ππProcedure RestoreScreen(Var p:Pointer);πbeginπ If Assigned(P) then { make sure this Pointer IS allocated }π beginπ If MonoMode thenπ Move(P^, MonoScreen, 4000)π ELSEπ Move(P^, VideoScreen, ScreenHeight*SizeOf(ScreenLine));π FreeMem(P,ScreenHeight*Sizeof(ScreenLine));π end;πend;ππProcedure SaveScreen(Var p:Pointer);πbeginπ If not Assigned(P) then { make sure Pointer isn't already allocated }π beginπ GetMem(P,ScreenHeight*Sizeof(ScreenLine));π If MonoMode thenπ Move(MonoScreen, P^, 4000)π ELSEπ Move(VideoScreen, P^, ScreenHeight*Sizeof(ScreenLine));π end;πend;πππbeginπend. 14 05-28-9313:56ALL SWAG SUPPORT TEAM TESTVID.PAS IMPORT 29 Program TestVid;ππ{ High speed Text-video routines For working With binary Files, direct }π{ screen access etc. (c)1993 Chris Lautenbach }π{ }π{ You are hereby permitted to use this routines, so long as you give me }π{ credit. If you modify them, do not distribute the modified version. }π{ }π{ This is the example Program, see SPEEDVID.PAS For the actual Unit }π{ code, and usage information. }π{ }π{ "ScreenFile" is a File containing sequential binary screen images. The }π{ easiest way to make these, is to draw several screens in a Program }π{ like TheDraw, then save them as Binary. After you are done, copy them }π{ all to one File, like so: }π{ }π{ COPY /B SCREEN1.BIN+SCREEN2.BIN+SCREEN3.BIN SCREEN.BIN }π{ }π{ Note: the /B option is NECESSARY. Without specifying binary mode, }π{ COPY will insert ^Z's and other wierd stuff that will screw up }π{ the resulting File. }ππUses Dos, Crt, SpeedVid;ππVar ScreenFile : File of ScreenLine;π StartLine, TempLine, idx : Integer;π Cmd : Char;π p : Pointer;ππProcedure ShowScreenLine(Index:Word);πbeginπ If StartLine+Index<Filesize(ScreenFile) thenπ beginπ Seek(ScreenFile, StartLine+Index-1);π Read(ScreenFile, VideoScreen[Index]);π end;πend;ππbeginπ MonoMode := (VideoMode = 7);π SaveScreen(P);π Assign(ScreenFile,'testvid.exe');π {$I-} Reset(ScreenFile); {$I+}π If IOResult<>0 thenπ beginπ Writeln('Error: Cannot open SCREEN.BIN.');π Halt;π end;π StartLine:=0;π For TempLine:=1 to ScreenHeight do ShowScreenLine(TempLine);π Repeatπ Repeat Until KeyPressed;π Cmd:=ReadKey;π If Cmd=#0 thenπ beginπ Cmd:=ReadKey;π Case Cmd ofπ{Down} #80 : If StartLine+1<Filesize(ScreenFile) thenπ beginπ Inc(StartLine);π ScrollScreen(Up);π ShowScreenLine(ScreenHeight);π end;π{Up} #72 : If StartLine-1>=0 thenπ beginπ Dec(StartLine);π ScrollScreen(Down);π ShowScreenLine(1);π end;π{PgDn} #81 : beginπ If StartLine+ScreenHeight<Filesize(ScreenFile) thenπ TempLine:=ScreenHeightπ ELSEπ TempLine:=ScreenHeight-(Filesize(ScreenFile)-ScreenHeight);π For idx:=1 to TempLine doπ beginπ Inc(StartLine);π ScrollScreen(Up);π ShowScreenLine(ScreenHeight);π end;π end;π{PgUp} #73 : beginπ If StartLine-ScreenHeight>=0 thenπ TempLine:=ScreenHeightπ ELSEπ TempLine:=StartLine;π For idx:=1 to TempLine doπ beginπ Dec(StartLine);π ScrollScreen(Down);π ShowScreenLine(1);π end;π end;π end; {case}π end;π Until Cmd=#27; {ESC}π Close(ScreenFile);π RestoreScreen(P);πend.π 15 05-28-9313:56ALL SWAG SUPPORT TEAM TEXTMODE.PAS IMPORT 7 {π A small follow-up to the VGA tricks:π how about a 40x12 Textmode (posted earlier in the Assembler conference):π}ππProcedure Set12x40; Assembler;πAsmπ MOV AX, 1π inT $10 { activate 40x25 Text With BIOS }π MOV DX, $03D4 { CrtC }π MOV AL, 9 { maximum scan line register }π OUT DX, ALπ inC DXπ in AL, DXπ or AL, $80 { Double each scan-line bit7 = 1 }π OUT DX, ALπ MOV AX, $0040 { set up BIOS data area access }π MOV ES, AXπ MOV AL, $0B { BIOS txtlines on 12 = $B +1 }π MOV ES:[$0084], AL { so Programs like QEDIT will work With this }πend;ππ 16 05-28-9313:56ALL SWAG SUPPORT TEAM TEXTWDTH.PAS IMPORT 13 { Keld Hansen }πProcedure SetCrtC; NEAR; Assembler;πConstπ HorizParms : Array[1..2,1..7] of Word =π (($6A00,$5901,$5A02,$8D03,$6004,$8505,$2D13),π ($5F00,$4F01,$5002,$8203,$5504,$8105,$2813));πAsmπ PUSH DXπ MOV DX,ES:[0063h]π PUSH BXπ MOV AX,1110hπ xor CX,CXπ INT 10hπ POP BXπ MOV AL,11hπ OUT DX,ALπ INC DXπ in AL,DXπ DEC DXπ MOV AH,ALπ MOV AL,11hπ PUSH AXπ and AH,7Fhπ OUT DX,AXπ xor BH,BHπ SUB BL,8π NEG BXπ and BX,14π LEA SI,[BX+OFFSET HorizParms]π MOV CX,7π@LOOP: LODSWπ OUT DX,AXπ LOOP @LOOPπ POP AXπ OUT DX,AXπ POP DXπend;ππProcedure SetCharWidth(W : Word); Assembler;πAsmπ MOV ES,Seg0040π MOV BL,Byte PTR Wπ MOV BH,ES:[0085h]π CALL SetCrtCπ MOV DX,03C4hπ MOV AX,0100hπ CLIπ OUT DX,AXπ MOV BX,0001hπ CMP W,8π JE @L01π MOV BX,0800hπ@L01: MOV AH,BLπ MOV AL,1π OUT DX,AXπ MOV AX,0300hπ OUT DX,AXπ STIπ MOV BL,13hπ MOV AX,1000hπ INT 10hπ MOV AX,1000hπ MOV BX,0F12hπ INT 10hπ xor DX,DXπ MOV AX,720π div Wπ MOV ES:[004Ah],AXπend;ππ{πSetCharWidth can then be called With 8 (giving 90 Characters per line) or 9π(giving 80 Characters per line) after having switched into f.ex. 80x28 (byπselecting the appropriate number of scan lines and font size).π}π 17 05-28-9313:56ALL SWAG SUPPORT TEAM VIDEORAM.PAS IMPORT 9 {πAuthor : BERNIE PALLEKππ> Thanks to those of you who have been answering my question aboutπ> writing to the last position on the far right bottom of the screen.π> As you will recall, the trouble I had was that when you Write to thatπ> position (position 80, line 25) using a Write (not a Writeln) statementππAnother solution would be to create a Procedure that directly Writes to theπvideo ram, like this:π}ππConstπ vidSeg = $B800; { $B000 For monochrome monitors }ππProcedure WriteAt(x1, y1 : Byte; msg : String);πVarπ i : Integer;πbeginπ For i := 1 to Length(msg) doπ Mem[vidSeg : (x1 + i - 1) * 2 + (y1 - 1) * 160] := msg[i];πend;ππ{πThis will change the Text on any place on the screen, disregarding the cursorπposition. Be careful, though! if you Write a message With, say, 20πCharacters, and start it at 80, 25, only the first letter will be visible, andπthe rest of the String will over-Write other areas of ram, which could causeπmayhem! Use With caution!π} 18 06-08-9308:23ALL SWAG SUPPORT TEAM Three FAST write RoutinesIMPORT 21 π{ THREE DIFFERENT WAYS TO WRITE TO SCREEN WITH ROW AND COLUMN }π{ TWO ARE VERY FAST AND ALLOW COLOR }ππprocedure QWrite( Column, Line , Color : byte; S : STRING );ππvarπ VMode : BYTE ABSOLUTE $0040 : $0049; { Video mode: Mono=7, Color=0-3 }π NumCol : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }π VSeg : WORD;π OfsPos : integer; { offset position of the character in video RAM }π vPos : integer;π sLen : Byte ABSOLUTE S;ππBeginπ If VMode in [0,2,7] THEN VSeg := $B000 ELSE VSeg := $B800;π OfsPos := (((pred(Line) * NumCol) + pred(Column)) * 2);π FOR vPos := 0 to pred(sLen) doπ MemW[VSeg : (OfsPos + (vPos * 2))] :=π (Color shl 8) + byte(S[succ(vPos)])πEnd;πππprocedure fastwrite(x, y, f, b: byte; s : STRING);ππ{ Does a direct video write -- extremely fast.π X, Y = screen location of first byte;π S = string to display;π F = foreground color;π B = background color. }ππtype videolocation = record { the layout of a two-byte video location }π videodata: char; { character displayed }π videoattribute: byte; { attributes }π end;ππvar cnter: byte;π videosegment: word; { the location of video memory }π monosystem: boolean; { mono vs. color }π vidptr: ^videolocation; { pointer to video locations }ππbeginππ{ Find the memory location where the string will be displayed at, according toπ the monitor type and screen location. Then associate the pointer VIDPTR withπ that memory location: VIDPTR is a pointer to type VIDEOLOCATION. Insert aπ character and attribute; now go to the next character and video location. }ππ monosystem := (lastmode in [0,2,7]);π if monosystem then videosegment := $b000 else videosegment := $b800;π vidptr := ptr(videosegment, 2*(80*(y - 1) + (x - 1)));π for cnter := 1 to length(s) do beginπ vidptr^.videoattribute := (b shl 4) + f; { high nibble=bg; lo nibble=fg }π vidptr^.videodata := s[cnter]; { put character at location }π inc(vidptr); { go to next video location }π end;π end;πππProcedure Print(x,y : Byte; S : String);πBEGINπ ASMπ MOV DH, Y { DH = Row (Y) }π MOV DL, X { DL = Column (X) }π DEC DH { Adjust For Zero-based Bios routines }π DEC DL { Turbo Crt.GotoXY is 1-based }π MOV BH,0 { Display page 0 }π MOV AH,2 { Call For SET CURSOR POSITION }π INT 10hπ END;πWRITE(S);πEND;π 19 06-22-9309:22ALL SWAG SUPPORT TEAM A CRT Replacement IMPORT 47 unit scrn;π{$D-,I-,S-,V-}πinterfaceπUsesπ Dos;πConstπ display : Boolean = true;π FGround : Byte = 0;π BGround : Byte = 0;π attribute : Byte = 0;π apage : Word = $B800;π apoint : Word = 0;π { foreground and background colors }π Black = 0;π Blue = 1;π Green = 2;π Cyan = 3;π Red = 4;π Magenta = 5;π Brown = 6;π LightGray = 7;ππ { foreground colors }π DarkGray = 8;π LightBlue = 9;π LightGreen = 10;π LightCyan = 11;π LightRed = 12;π LightMagenta = 13;π Yellow = 14;π White = 15;ππ { add for blinking characters }π Blink = 128;ππVARπ regs : Registers;ππFunction GetMode : Byte;π{returns the current video mode}ππProcedure SetMode (m : Byte);π{sets the video mode}ππProcedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);π{scrolls the window up (nbr is +) or down (nbr is -)}π{If nbr is 0 or out of range then the screen clears}π{ur is the upper row, lc is the left column,π lr is the lower row, and rc is the right column}π{Note: using an out-of-range number may have unpredictableπ results on the colors...it is not recommended}ππProcedure SetCursor (s, e : Byte);π{sets the size of the cursor}π{s is the starting line, e is the ending line}ππProcedure SetAPage (page : Word);π{Set the Active (drawing) page}ππProcedure SetVPage (vpage : Byte);π{Set the display page}ππFunction DisplayCursor (display1 : Boolean) : Boolean;π{hides or displays the cursor}ππFunction Xis : Byte;π{Tells you what the X coordinate is for the current active page}ππFunction Yis : Byte;π{Tells you what the Y coordinate is for the current active page}ππProcedure PXY (x, y : Byte);π{sets the coordinates on the current active page}π{To move the cursor on the visual page, first make the visual pageπ and active page the same}π{x is the row, y is the column}ππProcedure SetFGround (FG : Byte);π{sets the foreground color}π{constants can be used}π{add 128 or the constant BLINK to make the foreground blink}ππProcedure SetBGround (BG : Byte);π{sets the background color}π{constants can be used}ππProcedure PWrite (S : String);π{writes a string to the current active page}π{numbers must be converted to a string before calling this procedure}ππProcedure PWriteln (S : String);ππProcedure ClrScrn;π{Clear the current active page}ππimplementationππFunction GetMode : Byte;π{returns the current video mode}πBeginπ regs.ah := $0F;π Intr($10,regs);π GetMode := regs.al;πEnd;ππProcedure SetMode (m : Byte);π{sets the video mode}πBeginπ regs.ah := 0;π regs.al := m;π Intr($10,regs);πEnd;ππProcedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);π{scrolls the window up (nbr is +) or down (nbr is -)}π{If nbr is 0 or out of range then the screen clears}πBeginπ Dec(ur);π Dec(lc);π Dec(lr);π Dec(rc);π If nbr < 0 Then regs.ah := 7 Else regs.ah := 6;π regs.al := Abs(nbr);π regs.bh := attribute;π regs.ch := ur;π regs.cl := lc;π regs.dh := lr;π regs.dl := rc;π Intr($10,regs);πEnd;ππProcedure SetCursor (s, e : Byte);πBeginπ regs.ah := 1;π regs.ch := s;π regs.cl := e;π Intr($10,regs);πEnd;ππProcedure SetAPage (page : Word);πBeginπ apage := $B800 + (page * $100);πEnd;ππProcedure SetVPage (vpage : Byte);πBeginπ regs.ah := 5;π regs.al := vpage;π Intr($10,regs);πEnd;ππFunction DisplayCursor(display1 : Boolean) : Boolean;πBeginπ If Not(display1) Then Beginπ regs.dh := 50;π regs.dl := 0;π Endπ Else regs.dx := apoint;π regs.ah := 2;π regs.bh := (apage - $B800) DIV $100;π Intr($10,regs);π display := display1;πEnd;ππFunction Xis : Byte;πVar cpage : Word;πBeginπ cpage := (apage - $B800) DIV $100;π Xis := (Mem[$40:$51+(cpage * 2)]) + 1;πEnd;ππFunction Yis : Byte;πVar cpage : Word;πBeginπ cpage := (apage - $B800) DIV $100;π Yis := (Mem[$40:$50+(cpage * 2)]) + 1;πEnd;πππProcedure PXY (x, y : Byte);πBeginπ Dec(x);π Dec(y);π regs.dh := x;π regs.dl := y;π regs.ah := 2;π regs.bh := (apage - $B800) DIV $100;π Intr($10,regs);π If Not(display) Then Beginπ regs.dh := 50;π regs.dl := 0;π regs.ah := 2;π regs.bh := (apage - $B800) DIV $100;π Intr($10,regs);π End;π apoint := x * 80 * 2 + y * 2;πEnd;ππProcedure SetFGround (FG : Byte);πBeginπ FGround := FG;π attribute := BGround * 16 + FGround;πEnd;ππProcedure SetBGround (BG : Byte);πBeginπ BGround := BG;π attribute := BGround * 16 + FGround;πEnd;ππProcedure PWrite (S : String);πVarπ Len, x, y : Byte;π tmp : Word;πBeginπ If Length(S) = 0 Then Exit;π tmp := apoint;π For Len := 0 To Length(S) - 1 Do Beginπ Mem[apage:apoint+Len] := Ord(S[Len+1]);π Inc(apoint);π Mem[apage:apoint+Len] := attribute;π End;π apoint := (tmp + Length(S) * 2) DIV 2;π y := apoint MOD 80;π x := apoint DIV 80;π Inc(x);π Inc(y);π PXY(x,y);π If Not(display) Then Beginπ regs.dh := 50;π regs.dl := 0;π regs.ah := 2;π regs.bh := (apage - $B800) DIV $100;π Intr($10,regs);π End;πEnd;ππProcedure PWriteln (S : String);πVarπ Len, x, y : Byte;π tmp : Word;πBeginπ If Length(S) = 0 Then Exit;π tmp := apoint;π For Len := 0 To Length(S) - 1 Do Beginπ Mem[apage:apoint+Len] := Ord(S[Len+1]);π Inc(apoint);π Mem[apage:apoint+Len] := attribute;π End;π apoint := (tmp + Length(S) * 2) DIV 2;π x := apoint DIV 80 + 2;π y := 1;π PXY(x,y);π If Not(display) Then Beginπ regs.dh := 50;π regs.dl := 0;π regs.ah := 2;π regs.bh := (apage - $B800) DIV $100;π Intr($10,regs);π End;πEnd;ππProcedure ClrScrn;πVarπ x : Word;πBeginπ x := 0;π While x < 4048 Do Beginπ Mem[apage:x] := $20;π Inc(x);π Mem[apage:x] := attribute;π Inc(x);π End;πEnd;ππ{initializes the foreground and backbround colors}πBeginπ regs.ah := 8;π regs.bh := 0;π Intr($10,regs);π attribute := regs.ah;π FGround := attribute MOD 16;π BGround := (attribute - FGround) DIV 16;πEnd.ππ 20 06-22-9309:22ALL SWAG SUPPORT TEAM Screen Copy Utility IMPORT 22 unit scrncopy;πinterfaceππConstπ bord : ARRAY [0..2, 0..5] Of Byte = (π ( 32, 32, 32, 32, 32, 32),π ( 196, 179, 218, 191, 217, 192),π ( 205, 186, 201, 187, 188, 200));ππprocedure copyscrn (scrn1,scrn2 : Byte);π{copy the screen}ππProcedure savescrn (scrn : Byte);π{saves the designated screen in RAM memory}ππProcedure restorescrn (scrn : Byte);π{restores the screen to the designated page}ππprocedure drawborder (Fg,Bg,ur,lc,lr,rc,lines,page : Word);π{draw the borders, optionally clears the screen}π{Fg is the foreground color, Bg is the background color,π ur is the upper row, lc is the left column,π lr is the lower row, rc is the right column,π lines is:π 0 for clear screen;π 1 for single lines (─┐);π 2 for double lines (═╗);π page is the screen page to draw the border on}ππimplementationπTypeπ Hold = ARRAY[0..4047] Of Byte;ππVARπ x : Word;π tmpscrn : ^Hold;πProcedure copyscrn (scrn1, scrn2 : Byte);πBeginπ For x := 0 To 4047 Doπ Mem[$B800:(scrn2*$1000+x)] := Mem[$B800:(scrn1*$1000+x)];πEnd;πProcedure savescrn (scrn : Byte);πBeginπ New(tmpscrn);π For x := 0 To 4047 Doπ tmpscrn^[x] := Mem[$B800:(scrn*$1000+x)];πEnd;ππProcedure restorescrn (scrn : Byte);πBeginπ For x := 0 To 4047 Doπ Mem[$B800:(scrn*$1000+x)] := tmpscrn^[x];π Dispose(tmpscrn);πEnd;ππProcedure drawborder (Fg,Bg,ur,lc,lr,rc,lines,page : Word);πVARπ x, y, point : Word;πBeginπ page := $B800 + (page * $100);π Fg := 16 * Bg + Fg;π Dec(ur);π Dec(lc);π Dec(lr);π Dec(rc);π point := ur * 80 * 2 + lc * 2;π Mem[page:point] := bord[lines,2];π Mem[page:point + 1] := Fg;π point := point + 2;π For x := point To (ur * 80 * 2 + (rc-1) * 2) + 1 Do Beginπ Mem[page:x] := bord[lines,0];π Inc(x);π Mem[page:x] := Fg;π End;π point := ur * 80 * 2 + rc * 2;π Mem[page:point] := bord[lines,3];π Mem[page:point+1] := Fg;π For x := ur + 1 To lr - 1 Do Beginπ point := x * 80 * 2 + lc * 2;π Mem[page:point] := bord[lines,1];π Mem[page:point + 1] := Fg;π For y := lc + 1 To rc - 1 Do Beginπ point := x * 80 * 2 + y * 2;π Mem[page:point] := 32;π Mem[page:point+1] := Fg;π End;π point := x * 80 * 2 + rc * 2;π Mem[page:point] := bord[lines,1];π Mem[page:point + 1] := Fg;π End;π point := lr * 80 * 2 + lc * 2;π Mem[page:point] := bord[lines,5];π Mem[page:point + 1] := Fg;π point := point + 2;π For x := point To (lr * 80 * 2 + (rc-1) * 2) + 1 Do Beginπ Mem[page:x] := bord[lines,0];π Inc(x);π Mem[page:x] := Fg;π End;π point := lr * 80 * 2 + rc * 2;π Mem[page:point] := bord[lines,4];π Mem[page:point+1] := Fg;πEnd;ππEnd.ππ 21 07-16-9306:05ALL SEAN PALMER Fast Direct Screen WritesIMPORT 37 r (*π===========================================================================π BBS: Canada Remote SystemsπDate: 06-22-93 (23:10) Number: 27381πFrom: SEAN PALMER Refer#: NONEπ To: LOU DUCHEZ Recvd: NOπSubj: FAST DIRECT WRITES Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πLD>SP>I've optimized it a little, if you're interested... 8)ππLD>SP>procedure qwrite(x, y: byte; s: string; f, b: byte);ππLD>Interesting optimizations -- do I assume that Inc, Dec, Pred, and SuccπLD>are faster than I had ever imagined? (Shoot, I always figured they'd beπLD>a lot slower than normal arithmetic!) Thanks!ππSucc and Pred are faster for byte-sized ordinals (at least in TP 6.0)πthan +1 and -1. The same for word-size. See, with +1 and -1, the byteπgets converted into a word first, but with Succ() and Pred() itπstays a byte... Inc(I) is faster than I:=I+1 or I:=Succ(I) stuff in 6.0πbut I think 7.0+ optimize them all to the same code...not sure, I don'tπhave 7.0...8(ππActually the fastest part of what I did is to pre-calculate theπattribute as the hi byte of a word, and use word stores instead of byteπstores. Could be done alot faster in assembly (don't access anyπmemory-based variables that way, it's all in registers..8)ππHere is a direct screen write unit I wrote in BASM. VERY fast...π*)ππ{$A-,B-,S-,V-X+}πunit Direct;πinterfaceππCONSTπ vSeg:word=$B800; {change for mono}ππVARπ VMode : BYTE ABSOLUTE $0040 : $0049; { Video mode: Mono=7, Color=0-3 }π ScrCols : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }ππ{in following parms, s=source,d=destination,n=count, words are offsetsπ into video memory (you calculate them with ((y*80+x)*2)}π{I did this mainly so less parms would have to be sent, as TP does aπ good job of the arithmetic for that expression...Oh well if you reallyπ don't like it I could make these use x and y coords, but this wasπ basically chopped from another project of mine..}ππprocedure moveScr(s,d,n:word); {one part of screen to another}πprocedure toScr(var s;d,n:word); {from string to video ram}πprocedure toScrA(var s;d,n:word;a:byte); {ditto with attribute also}πprocedure fillScr(d,n:word;c:char); {mainly useful for rows}πprocedure fillAttr(d,n:word;a:byte); {ditto}ππ{ I added the following to make this GREAT code more useful for us hackers !!}π{ Gayle Davis 06/26/93 }ππfunction ScreenAdr (Row,Col : Byte) : WORD;πprocedure Qwrite(Row, Col, Attr: byte; S: string);ππimplementationπππprocedure moveScr(s,d,n:word);assembler;asmπ mov cx,n; jcxz @X;π push ds; mov ax,vSeg; mov es,ax; mov ds,ax;π mov si,s; shl si,1;π mov di,d; shl di,1;π cmp si,di; jb @REV; {move in reverse to prevent overwrite}π cld; jmp @GO;π@REV: std; shl cx,1; add si,cx; add di,cx; shr cx,1; {start at end}π@GO: repz movsw; {move attr too!}π pop ds;π@X:π end;ππprocedure toScr(var s;d,n:word);assembler;asmπ mov cx,n; jcxz @X;π push ds; mov es,vSeg;π mov di,d; shl di,1;π lds si,s; cld;π@L: movsb; inc di; loop @L;π pop ds;π@X:π end;ππprocedure toScrA(var s;d,n:word;a:byte);assembler;asmπ mov cx,n; jcxz @X;π push ds; mov es,vSeg;π mov di,d; shl di,1;π lds si,s; cld;π mov al,a; {attribute}π@L: movsb; {doesn't affect al reg}π stosb; loop @L;π pop ds;π@X:π end;ππprocedure fillScr(d,n:word;c:char);assembler;asmπ mov cx,n; jcxz @X;π mov es,vSeg;π mov di,d; shl di,1;π mov al,c; cld;π@L: stosb; inc di; loop @L;π@X:π end;ππprocedure fillAttr(d,n:word;a:byte);assembler;asmπ mov cx,n; jcxz @X;π mov es,vSeg;π mov di,d; shl di,1;π mov al,a; cld;π@L: inc di; stosb; loop @L;π@X:π end;ππfunction ScreenAdr (Row,Col : Byte) : WORD;πBEGINπ ScreenAdr := PRED (Row) * ScrCols + PRED (Col) * 2;πEND;ππprocedure qwrite(Row, Col, Attr: byte; S: string);πBEGINπtoScrA(MemW[Seg(S):SUCC(Ofs(S))], ScreenAdr(Row,Col), Length(S), Attr);πEND;ππBEGINπIF VMode = 7 Then VSeg := $B000;πEND.ππππKeep in mind these are VERY low-level and aren't necessarily gonna beπeasy to work with but they are, by god, FAST.ππLD>As to why I pass attributes and don't use WhereX() and WhereY(), I wroteπLD>QWRITE mostly for screen drawing -- in fact, QWRITE doesn't even move theπLD>cursor. It's no good for "scrolling" text, but goldang, when you wantπLD>to draw a box on the screen or fill a region with a given character ...ππThese don't either (cursor? who needs it!)ππQWrite'll work a little faster now, anyway...ππ * OLX 2.2 * Cana-DOS: "Yer sure, eh?" [O]k, eh! [N]o way! [B]eauty! ?ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π 22 07-16-9306:07ALL MIKE BURNS Put Char at LAST Row/Col IMPORT 14 r ===========================================================================π BBS: Canada Remote SystemsπDate: 06-24-93 (15:09) Number: 27660πFrom: MIKE BURNS Refer#: NONEπ To: CHRIS PORTMAN Recvd: NO πSubj: Re: Putting A Character R Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Chris Portman to All <=-ππ CP> I was wondering if anyone knows how to put a character at the lastπ CP> row and the last column at the screen - every time I attempt that, theπ CP> computer scrolls down to the next line.ππ CP> Is there an assembler routine someone could write fast?ππ CP> Thanksππ CP> PS - An example of a program that does that is Novell's SYSCON for itsπ CP> background fill.ππTry this Chris;ππProcedure DVWRITE(X,Y:word;S:String;Back,Fore,BLNK:byte);πVarπI,I2:integer;πbeginπ If (X>80) or (Y>25) or (X<1) or (Y<1) then Exit;π If X+Length(S)>81 then Exit;π DEC(X);π DEC(Y);π I2:=0;π For I:= 0 to Length(S)-1 doπ beginπ Mem[$B800: (160 * y)+(x*2)+I2]:=Ord(S[I+1]);π Mem[$B800: (160 * y)+(x*2)+I2+1]:=BLNK+(Back SHL 4)+Fore;π INC(I2,2);π end;πEnd;ππThis is a direct video write, and can not scroll the screen.π Valid range X = 1..80 Y= 1..25πIf you like take out the DEC(X&Y) and you can use 0..79 0..24ππShould do the trick for you.ππ.\\ike Burnsππππ... Security, confine Ensign Portman to the brig.π--- Blue Wave/Max v2.12 [NR]π * Origin: Basic'ly Computers: Mooo-ing Right Along. (1:153/9.0)π 23 07-16-9306:08ALL GAYLE DAVIS Classical FASTWRITE ASM IMPORT 18 r πUNIT FastWrit;ππINTERFACEππprocedure FastWrite(Strng : String; Row, Col, Attr : Byte);ππIMPLEMENTATIONππVARπ BaseOfScreen : WORD;ππprocedure FastWrite(Strng : String; Row, Col, Attr : Byte); assembler;π asmπ PUSH DS { ;Save DS }π MOV CH,Row { ;CH = Row }π MOV BL,Col { ;BL = Column }ππ XOR AX,AX { ;AX = 0 }π MOV CL,AL { ;CL = 0 }π MOV BH,AL { ;BH = 0 }π DEC CH { ;Row (in CH) to 0..24 range }π SHR CX,1 { ;CX = Row * 128 }π MOV DI,CX { ;Store in DI }π SHR DI,1 { ;DI = Row * 64 }π SHR DI,1 { ;DI = Row * 32 }π ADD DI,CX { ;DI = (Row * 160) }π DEC BX { ;Col (in BX) to 0..79 range }π SHL BX,1 { ;Account for attribute bytes }π ADD DI,BX { ;DI = (Row * 160) + (Col * 2) }π MOV ES,BaseOfScreen { ;ES:DI points to BaseOfScreen:Row,Col }ππ LDS SI,DWORD PTR [Strng] { ;DS:SI points to St[0] }π CLD { ;Set direction to forward }π LODSB { ;AX = Length(St); DS:SI -> St[1] }π XCHG AX,CX { ;CX = Length; AL = WaitForRetrace }π JCXZ @FWExit { ;If string empty, exit }π MOV AH,Attr { ;AH = Attribute }π @FWDisplay:π LODSB { ;Load next character into AL }π { ; AH already has Attr }π STOSW { ;Move video word into place }π LOOP @FWDisplay { ;Get next character }π @FWExit:π POP DS { ;Restore DS }π end; {asm block}ππBEGINπASMπ mov BaseOfScreen,$B000π mov ax,$0F00π int $10π cmp al,2π je @XXXπ cmp al,7π je @XXXπ mov BaseOfScreen,$B800π@XXX :πend;πEND. 24 08-17-9308:45ALL BERNIE PALLEK MELT Chars on Video IMPORT 23 r (*π===========================================================================π BBS: Canada Remote SystemsπDate: 07-14-93 (10:28) Number: 30550πFrom: BERNIE PALLEK Refer#: NONEπ To: DENNIS HO Recvd: NOπSubj: NEATO VIDEO TRICKS Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πDH> Could anyone possibly tell me how I could make theπDH> characters on the screen change the the next letter untilπDH> they are Z then they disappear? Sort of a melting effect.πDH> I realize that this would probably have to be done in ASMπDH> but I would just like the source to incorperate into one ofπDH> my programs.ππHi, Dennis. Just a suggestion: it would probably look better if theyπdecremented down to a space character (and it would be easier toπprogram), but here's an example:π*)ππPROGRAM MeltTheCharactersInVideoMemory;ππ{ untested, by Bernie Pallek, 1993 }π{ best used in 80x25 mode, or you may have problems :') }ππ{ I don't think the program needs a USES clause }ππCONSTπ vidSeg : Word = $B800; { use $B000 for mono monitors }ππVARπ max : Byte;π w1,π w2 : Word;ππBEGINπ { the below part finds the max. number of iterations req'd byπ the melting loop }π max := 0;π FOR w1 := 0 TO 1999 DO IF (Mem[vidSeg : w1 * 2] > max) THENπ max := Mem[vidSeg : w1 * 2];π { I know, I know, bad indenting style :') }π FOR w1 := 1 TO max DO { could be from *0* TO max }π { by using w1 * 2, we skip the colour attributes }π FOR w2 := 0 TO 1999 DO IF (Mem[vidSeg : w2 * 2] > 32) THENπ Mem[vidSeg : w2 * 2] := Mem[vidSeg : w2 * 2] - 1;πEND.ππOh, you want me to *explain* it. I see. Well, text video memory is setπup like this: 4000 bytes starting at $B800 (for colour, $B000 for mono).πThe first byte ($B800 : 0) rep's the ASCII code of the char at 1, 1π(screen pos.), and the next byte ($B800 : 1) rep's the colour attributeπof the char at 1, 1. Then comes the ASCII code for the next character,πand then the colour for it. This keeps going, and when you reach memoryπposition $B800 : 160 (that 160 is decimal, not hex), it wraps to theπnext line on your screen. This goes on until you reach $B800 : 3999,πwhich is the lower-right char's colour attribute.πThe beginning part just finds how many times the characters will haveπto be updated before they are all space characters.πBTW, sorry for not making them turn to Zs; it was easier to do it withπspaces, and you may modify the program as you wish.ππHave fun, TTYL.ππBernie.π___π * SLMR 2.0 * ... I wouldn't be caught dead with a necrophiliac!ππ--- Maximus 2.01wbπ * Origin: * idiot savant * +1 416 935 6628 * (1:247/128)π 25 08-23-9309:15ALL WILLIAM SCHROEDER Get Video Char Direct IMPORT 13 r ===========================================================================π BBS: Canada Remote SystemsπDate: 08-18-93 (08:32) Number: 34760πFrom: WILLIAM SCHROEDER Refer#: NONEπ To: CHRIS PORTMAN Recvd: NO πSubj: RE: DIRECT VIDEO WRITES Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Chris Portman to All <=-ππ CP> Can anyone write me a procedure that will write a character on theπ CP> screen without moving the cursor (ie - DirWrite (80, 25, '!');). Iπ CP> just need this to write to the space at 80x25 without scrolling theπ CP> screen.ππfunction GetChar(x, y: integer): char; (* $B000 for mono *)πvar screen: array[1..25, 1..80] of word absolute $B800:0000;πbeginπ GetChar := char(screen[x][y] and $FF);πend;ππfunction GetTextColor(x, y: integer): integer; (* $B000 for mono *)πvar screen: array[1..25, 1..80] of word absolute $B800:0001;πbeginπ GetTextColor := integer(screen[x][y] and $FF);πend;ππ This is not the answer to your problem, but I'm sure it will help. All youπhave to do (I *think*) is write back to the screen variable (BIOS). Keep inπmind that X and Y are in DOS format. For some reason, DOS's X-Axis isπvertical and Y-Axis is horizontal; CRT.GotoXY reverses that.π Sorry I couldn't help further...ππ... Only reasonable people agree with me.π--- GEcho 1.00π * Origin: Not Ready For Prime Time * Victoria, Texas (1:3802/221.0)π 26 08-23-9309:16ALL JOHN GIESBRECT Direct Video in BASM IMPORT 15 r {π===========================================================================π BBS: Canada Remote SystemsπDate: 08-17-93 (19:47) Number: 34561πFrom: JOHN GIESBRECHT Refer#: NONEπ To: CHRIS PORTMAN Recvd: NOπSubj: DIRECT VIDEO WRITES Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πChris Portman (1:229/15) wrote to All on <15 Aug 10:38> :ππ CP> Can anyone write me a procedure that will write a character onπ CP> the screen without moving the cursor (ie - DirWrite (80, 25,π CP> '!');). I just need this to write to the space at 80x25π CP> without scrolling the screen.π}πUSESπ crt;ππPROCEDURE writechar (c : CHAR; attr, x, y : BYTE); assembler;ππ(* assumes video page 0π * upper left-hand corner is (1, 1)π *)πasmπ mov ax, $0300 (* get cursor position *)π XOR bh, bhπ INT $10π push dx (* and save it *)π mov ax, $0200 (* set cursor position *)π XOR bh, bhπ mov dh, BYTE PTR yπ DEC dhπ mov dl, BYTE PTR xπ DEC dlπ INT $10π mov ah, $09 (* write char and attribute *)π mov al, BYTE PTR cπ XOR bh, bhπ mov bl, BYTE PTR attrπ mov cx, $0001π INT $10 (* restore original cursor position *)π mov ax, $0200π XOR bh, bhπ pop dxπ INT $10πEND;ππPROCEDURE WriteString (Row, Col, Attr : BYTE; STR : STRING);πVAR Len : Byte ABSOLUTE Str;π I : Byte;πBEGINπ FOR I := 1 To Len DO writechar (STR[i], Attr, Col + i, Row);πEND;ππBEGINπ CLRSCR;π GOTOXY (40, 13);π writechar ('*', $0F, 1, 1);π writechar ('*', $0e, 80, 1);π writechar ('*', $0d, 1, 25);π writechar ('*', $0c, 80, 25);π WriteString(15,25,31,'Gayle Davis was here');π READKEY;πEND.ππ- - - MSQ - EE 2.1a / e2π * Origin : * idiot savant * St. Catharines, ON, Canada * (1 : 247 / 128)π 27 08-27-9320:27ALL DAVID DRZYZGA Changing Screen Attr IMPORT 6 r {πDAVID DRZYZGAππ> I want to know how to get and set the screen colors Without using theπ> Crt Unit or ansi codes. Any help is appreciated.ππThis will do what you ask. There is no checking of the vidseg since it isπassumed that if you want to Write in color that you are using a color monitor:π}ππProcedure WriteColorAt(X, Y : Byte; St : String; Attr : Byte);πVarπ Count : Byte;πbeginπ For Count := 1 to Length(St) doπ beginπ Mem[$B800 : 2 * (80 * (Y - 1) + X + Count - 2)] := Ord(St[Count]);π Mem[$B800 : 2 * (80 * (Y - 1) + X + Count - 2) + 1] := Attr;π end;πend;ππbeginπ WriteColorAt(34, 12, 'Hello World!', $4E);πend.π 28 08-27-9321:19ALL SEAN PALMER Very FAST FASTwrite IMPORT 11 r {πSEAN PALMERππ> I don't know if you'd be interested, but here's my version of aπ> direct-video writer: QWRITE.ππI've optimized it a little, if you're interested... 8)ππThis is WITHOUT using inline ASM... I have routines that would put thisπoptimized version to shame, in assembler....ππThis runs 2290 times in the time it took yours to run 1754 times in aπtest I ran.ππI suggest removing the f and b parameters, and using the crt.textAttrπvariable so the user can set textcolor() and textbackground() beforeπcalling the routine and it'll come out ok, since you depend on crtπanyway for the lastmode var... actually why not use wherex() andπwherey() instead of passing THOSE as parameters too... hmm...π}ππprocedure qwrite(x, y : byte; s : string; f, b : byte);ππ{ Does a direct video write -- extremely fast. <----heheheπ X, Y = screen location of first byte;π S = string to display;π F = foreground color;π B = background color. }ππvarπ cnter : word;π vidPtr : ^word;π attrib : word;ππbeginπ attrib := swap((b shl 4) + f);π vidptr := ptr($B800, 2 * (80 * pred(y) + pred(x)));π if lastmode = 7 thenπ dec(longint(vidptr), $08000000);π for cnter := 1 to length(s) doπ beginπ vidptr^ := attrib or byte (s[cnter]);π inc(vidptr);π end;πend;π 29 08-27-9321:53ALL SEAN PALMER Get/Set Screen Colors IMPORT 5 r {πSEAN PALMERππ> I want to know how to get and set the screen colors Without using theπ> Crt Unit or ansi codes. Any help is appreciated.ππChange the Byte in video memory For the attribute For a Character.π}ππVarπ ScreenMem : Array [0..24, 0..79, 0..1] of Char Absolute $B800 : 0;ππProcedure changeColor(x, y, attrib : Byte);πbeginπ screenMem[y - 1, x - 1, 1] := Char(attrib);πend;ππ{ For monochrome monitors it's Absolute $B000 : 0; }πbeginπ ChangeColor(34, 12, $1C);πend. 30 08-27-9321:54ALL LOU DUCHEZ Window Shadows IMPORT 16 r {πLOU DUCHEZππ> When I open the window, I want to give it a shadow, in C what youπ>would do is switch the 2nd bit of each character.ππShadowing here. You'll need "Crt" for this to work:π}ππprocedure atshadow(x1, y1, x2, y2 : byte);π{ Makes a "shadow" to the right of and below a screen region, by setting theπ foreground there to low intensity and the background to black. }πtypeπ videolocation = recordπ videodata : char;π videoattribute : byte;π end;πvarπ xbegin, xend,π ybegin, yend,π xcnt, ycnt : byte;π videosegment : word;π monosystem : boolean;π vidptr : ^videolocation;ππbeginπ { Determine location of video memory. }π monosystem := (lastmode in [0, 2, 7]);π if monosystem thenπ videosegment := $b000π elseπ videosegment := $b800;π { Determine the x coordinates where the shadowing begins and ends on theπ lower edge. (Basically two spaces to the right of the box.) }ππ xbegin := x1 + 2;π xend := x2 + 2;ππ { Determine the y coordinates where the shadowing begins and ends on theπ right. (Basically one row below the box.) }ππ ybegin := y1 + 1;π yend := y2 + 1;π ycnt := ybegin;π while (ycnt <= yend) and (ycnt <= 25) doπ beginπ { This loop goes through each row, putting in the shadows on the right andπ bottom. First thing to check on each pass: if we're not below the regionπ to shadow, shade only to the right. Otherwise, start at the left. }π if ycnt > y2 thenπ xcnt := xbeginπ elseπ xcnt := x2 + 1;π vidptr := ptr(videosegment, 2 * (80 * (ycnt - 1) + (xcnt - 1)));π while (xcnt <= xend) and (xcnt <= 80) doπ beginπ { This loop does the appropriate shadowing for this row. }π vidptr^.videoattribute := vidptr^.videoattribute and $07; { SHADOW! }π xcnt := xcnt + 1;π inc(vidptr);π end;π ycnt := ycnt + 1;π end;πend;ππ 31 08-27-9321:55ALL POON ROJANASOONTHON Turn Screen On/Off IMPORT 11 r {πPoon Rojanasoonthonππ>I use alot of line draws and some text on the screen....the lines come outπ>first and then the text a second or two later....is there a way so that theπ>whole output comes at once. I tried Setvisualpage and setactivepage but theπ>the whole output screen is off.ππTo Turn On/Off the Screen you may use these proceduresπ}ππProcedure ScreenOn;πBeginπ Port[$3C4] := 1;π Port[$3C5] := $00;πend;ππProcedure ScreenOff;πBeginπ Port[$3C4] := 1;π Port[$3C5] := Port[$3C5] or $20;πend;ππ{π>And my last question is.....I am also writing a card game in graphics. I knπ>the ASCII values for the heart, club, spades and diamonds are thru 3-6. Theπ>come out in the TEXT mode but they won't show on the screen in GRAPHICS. Isπ>there a way to display them or not? Thanks.πTo Put text in graphics screen you should turn off the directvideo to off first.π DirectVideo:=False;π}ππbeginπ Writeln('Turning Screen Off...');π Readln;π ScreenOff;π Writeln('Can you see this??');π Writeln('Can you see this??');π Writeln('Can you see this??');π Writeln('Can you see this??');π Writeln('Can you see this??');π Writeln('Can you see this??');π Writeln('Can you see this??');π Readln;π ScreenOn;π Readln;πend.π 32 08-27-9321:55ALL LOU DUCHEZ Direct Write & Scroll IMPORT 30 r {πLOU DUCHEZππ>I have two questions. First, How can I display ANSI files from a Pascalπ>program by using the CON driver (read: ANSI.SYS) instead of going to theπ>trouble of writing a terminal emulator, and still remainπ>window-relative? I used TP5.5's WRITE procedure to write to a fileπ>assigned to the CON device instead of the CRT unit's standard OutPut,π>but this obliterated my status line at the bottom of the screen when theπ>ANSI file scrolled. Is there an easy way to write to the CON deviceπ>while remaining window-relative without having to modify ANSI.SYS orπ>write a terminal emulation procedure?π> My second question: How can I call a batch file from within a Pascalπ>program and pass %1-%9 parameters to it? I'm aware of the EXECπ>procedure, but doesn't that only work on executables?ππSecond question first: you're right about EXEC calling only executables.πSo try calling "COMMAND.COM" as your program, and give it parameters ofπ"/C " plus the batch file name plus whatever arguments you intend to pass.π(That tells the system to run a single command out of DOS.) Look upπParamCount and ParamStr() to see how Pascal uses command-line parameters.ππFirst question second: you know, I addressed this problem just yesterdayπtrying to write a program. I concluded that, if you're going to bypassπCRT, you need to do a lot of "manual" work yourself to keep a windowπgoing. Let me show you the tools I devised:πππ---PROCEDURE ATSCROLL: SCROLLS A SCREEN REGION UP OR DOWN (negative orπ positive number in LINESDOWN, respectively)π}ππprocedure atscroll(x1, y1, x2, y2 : byte; linesdown : integer);πvarπ tmpbyte,π intbyte,π clearattrib : byte;πbeginπ if linesdown <> 0 thenπ beginπ clearattrib := foxfore + foxback shl 4;π x1 := x1 - 1;π y1 := y1 - 1;π x2 := x2 - 1;π y2 := y2 - 1;π if linesdown > 0 thenπ intbyte := $07π elseπ intbyte := $06;π tmpbyte := abs(linesdown);π asmπ mov ah, intbyteπ mov al, tmpbyteπ mov bh, clearattribπ mov ch, y1π mov cl, x1π mov dh, y2π mov dl, x2π int 10hπ end;π end;πend;ππ{π---FUNCTION YPOS: Returns the line the cursor is on. I wrote it becauseπ I don't always trust WHEREY (or WHEREX): they report, for example, theπ cursor position relative to a text window. So I had it lying around,π and I opted to use it in my routines.π}πfunction ypos : byte;πvarπ tmpbyt : byte;πbeginπ asmπ mov ah, 03hπ mov bh, 0π int 10hπ mov tmpbyt, dhπ end;π ypos := tmpbyt + 1;πend;ππ{π--- PROCEDURE WRITEANDFIXOVERHANG: I use it in place of WRITELN in myπ program: before writing a line of text, it checks if there's roomπ at the bottom of the screen. If not, it scrolls the screen upπ before writing. Keep in mind that this program is bent on preservingπ the top three or four screen lines, not the bottom lines.π}πprocedure writeandfixoverhang(strin : string);πconstπ scrollat : byte = 24;πvarπ overhang : byte;πbeginπ if ypos >= scrollat thenπ beginπ overhang := ypos - scrollat + 1;π atscroll(0, 4 + overhang, 0, 80, 25, -overhang);π movecursor(1, ypos - overhang);π end;π writeln(strin);πend;ππ{πSo assuming your text lines don't get too long (line longer than 160 chars),πthese routines will keep the top of your screen from getting eaten. If youπwant to preserve space at the bottom of the screen instead (or both top andπbottom), change WRITEANDFIXOVERHANG.ππBTW, if there are any compiling problems, let me know. I took out all theπstuff that applied specifically to my application -- I might have stupidlyπchanged something you need ...π}