SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00013 TEXT WINDOWING ROUTINES 1 05-28-9314:08ALL SWAG SUPPORT TEAM Execute DOS in a Window IMPORT 78 F╔«ƒ {$A+,B-,D+,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}π{$M 16384,0,655360}πUnit ExecWin;πInterfaceπVar SaveInt10 : Pointer;ππProcedure ExecWindow(X1,Y1,X2,Y2,π Attr : Byte;π Path,CmdLine : String);ππImplementationπUsesπ Crt,Dos;πTypeπ PageType = Array [1..50,1..80] of Word;πVarπ Window : Recordπ X1,Y1,X2,Y2,π Attr : Byte;π CurX,CurY : Byte;π end;π Regs : Registers;π Cleared : Boolean;π Screen : ^PageType;π ActPage,π VideoMode : ^Byte;π {$ifOPT D+}π Fnc,π OldFnc : Byte;π {$endif}ππ{$ifOPT D+}πFunction FStr(Num : LongInt) : String;πVarπ Dummy : String;πbeginπ Str(Num,Dummy);π FStr := Dummy;πend;ππProcedure WriteXY(X,Y,Attr : Byte;TextStr : String);πVarπ Loop : Byte;πbeginπ if Length(TextStr)>0 thenπ beginπ Loop := 0;π Repeatπ Inc(Loop);π Screen^[Y,X+(Loop-1)] := ord(TextStr[Loop])+Word(Attr SHL 8);π Until Loop=Length(TextStr);π end;πend;π{$endif}ππProcedure ScrollUp(X1,Y1,X2,Y2,Attr : Byte); Assembler;πAsmπ mov ah,$06π mov al,$01π mov bh,Attrπ mov ch,Y1π mov cl,X1π mov dh,Y2π mov dl,X2π dec chπ dec clπ dec dhπ dec dlπ int $10πend;ππProcedure ClearXY(X1,Y1,X2,Y2,Attr : Byte); Assembler;πAsmπ mov ah,$06π mov al,$00π mov bh,Attrπ mov ch,Y1π mov cl,X1π mov dh,Y2π mov dl,X2π dec chπ dec clπ dec dhπ dec dlπ int $10πend;ππ{$ifOPT D+}πProcedure Beep(Freq,Delay1,Delay2 : Word);πbeginπ Sound(Freq);π Delay(Delay1);π NoSound;π Delay(Delay2);πend;π{$endif}ππ{$F+}πProcedure NewInt10(Flags,CS,IP,AX,BX,CX,π DX,SI,DI,DS,ES,BP : Word); Interrupt;πVarπ X, Y, X1,π Y1, X2, Y2 : Byte;π Loop, DummyW : Word;πbeginπ SetIntVec($10,SaveInt10);π {$ifOPT D+}π Fnc := Hi(AX);π if Fnc<>OldFnc thenπ beginπ WriteXY(1,1,14,'Coordinates:');π WriteXY(20,1,14,'Register:');π WriteXY(20,2,14,'AH: '+FStr(Hi(AX))+' ');π WriteXY(20,3,14,'AL: '+FStr(Lo(AX))+' ');π WriteXY(20,4,14,'BH: '+FStr(Hi(BX))+' ');π WriteXY(20,5,14,'BL: '+FStr(Lo(BX))+' ');π WriteXY(30,2,14,'CH: '+FStr(Hi(CX))+' ');π WriteXY(30,3,14,'CL: '+FStr(Lo(CX))+' ');π WriteXY(30,4,14,'DH: '+FStr(Hi(DX))+' ');π WriteXY(30,5,14,'DL: '+FStr(Lo(DX))+' ');π Case Fnc ofπ $0 : WriteXY(40,1,14,'Set video mode. ');π $1 : WriteXY(40,1,14,'Set cursor shape. ');π $2 : WriteXY(40,1,14,'Set cursor position. ');π $3 : WriteXY(40,1,14,'Get cursor position. ');π $4 : WriteXY(40,1,14,'Get lightpen position. ');π $5 : WriteXY(40,1,14,'Set active page. ');π $6 : WriteXY(40,1,14,'Scroll up lines. ');π $7 : WriteXY(40,1,14,'Scroll down lines. ');π $8 : WriteXY(40,1,14,'Get Character/attribute. ');π $9 : WriteXY(40,1,14,'Write Character/attribute. ');π $A : WriteXY(40,1,14,'Write Character. ');π $D : WriteXY(40,1,14,'Get pixel in Graphic mode. ');π $E : WriteXY(40,1,14,'Write Character. ');π $F : WriteXY(40,1,14,'Get video mode. ');π else WriteXY(40,1,14,'(unknown/ignored Function) ');π end;π Case Hi(AX) ofπ $0..$E : Beep(Hi(AX)*100,2,5);π else beginπ Beep(1000,50,0);π Repeat Until ReadKey<>#0;π end;π end;π end;π {$endif}π Case Hi(AX) ofπ $00 : beginπ ClearXY(Window.X1,Window.Y1,Window.X2,Window.Y2,Window.Attr);π GotoXY(Window.X1,Window.Y1);π Window.CurX := Window.X1;π Window.CurY := Window.Y1;π end;π $01 : beginπ Regs.AH := $01;π Regs.CX := CX;π Intr($10,Regs);π end;π $02 : beginπ X := Lo(DX);π Y := Hi(DX);π Window.CurX := X+1;π if Cleared thenπ beginπ Window.CurY := Window.Y1;π Cleared := False;π endπ else Window.CurY := Y+1;π if Window.CurX<=Window.X2 thenπ beginπ Regs.AH := $02;π Regs.BH := ActPage^;π Regs.DL := X;π Regs.DH := Y;π Intr($10,Regs);π end;π end;π $03 : beginπ Regs.AH := $03;π Regs.BH := ActPage^;π Intr($10,Regs);π DX := (Window.X1-Regs.DL)+((Window.Y1-Regs.DH) SHL 8);π CX := Regs.CX;π end;π $04 : AX := Lo(AX);π $06 : beginπ X1 := Window.X1+Lo(CX)-1;π Y1 := Window.Y1+Hi(CX)-1;π X2 := Window.X2+Lo(DX)-1;π Y2 := Window.Y2+Hi(DX)-1;π if Lo(AX)=0 thenπ beginπ ClearXY(Window.X1,Window.Y1,π Window.X2,Window.Y2,Window.Attr);π GotoXY(Window.X1,Window.Y1);π Window.CurX := Window.X1;π Window.CurY := Window.Y1;π Cleared := True;π endπ elseπ beginπ if X2>Window.X2 then X2 := Window.X2;π if Y2>Window.Y2 then Y2 := Window.Y2;π Regs.AH := $06;π Regs.AL := Lo(AX);π Regs.CL := X1;π Regs.CH := Y1;π Regs.DL := X2;π Regs.DH := Y2;π Regs.BH := Window.Attr;π Intr($10,Regs);π end;π end;π $07 : beginπ X1 := Window.X1+Lo(CX)-1;π Y1 := Window.Y1+Hi(CX)-1;π X2 := Window.X2+Lo(DX)-1;π Y2 := Window.Y2+Hi(DX)-1;π if X2>Window.X2 thenπ X2 := Window.X2;π if Y2>Window.Y2 thenπ Y2 := Window.Y2;π Regs.AH := $07;π Regs.AL := Lo(AX);π Regs.CL := X1;π Regs.CH := Y1;π Regs.DL := X2;π Regs.DH := Y2;π Regs.BH := Window.Attr;π Intr($10,Regs);π end;π $08 : beginπ Regs.AH := $08;π Regs.BH := ActPage^;π Intr($10,Regs);π AX := Regs.AX;π end;π $09,π $0A : beginπ Regs.AH := $09;π Regs.BH := ActPage^;π Regs.CX := CX;π Regs.AL := Lo(AX);π Regs.BL := Window.Attr;π Intr($10,Regs);π end;π $0D : AX := Hi(AX) SHL 8;π $0D : AX := Hi(AX) SHL 8;π $0E : beginπ Case Lo(AX) ofπ 7 : Write(#7);π 13 : beginπ Window.CurX := Window.X1-1;π if Window.CurY>=Window.Y2 thenπ beginπ Window.CurY := Window.Y2-1;π ScrollUp(Window.X1,Window.Y1,π Window.X2,Window.Y2,Window.Attr);π end;π end;π elseπ beginπ Regs.AH := $0E;π Regs.AL := Lo(AX);π Regs.BL := Window.Attr;π Intr($10,Regs);π end;π end;π Inc(Window.CurX);π GotoXY(Window.CurX,Window.CurY);π end;π $0F : beginπ AX := $03+(80 SHL 8);π BX := Lo(BX);π end;π elseπ beginπ Regs.AX := AX;π Regs.BX := BX;π Regs.CX := CX;π Regs.DX := DX;π Regs.SI := SI;π Regs.DI := DI;π Regs.DS := DS;π Regs.ES := ES;π Regs.BP := BP;π Regs.Flags := Flags;π Intr($10,Regs);π AX := Regs.AX;π BX := Regs.BX;π CX := Regs.CX;π DX := Regs.DX;π SI := Regs.SI;π DI := Regs.DI;π DS := Regs.DS;π ES := Regs.ES;π BP := Regs.BP;π Flags := Regs.Flags;π end;π end;π {$ifOPT D+}π if Fnc<>OldFnc thenπ beginπ WriteXY(1,2,14,FStr(Window.CurX)+':'+FStr(Window.CurY)+' ');π WriteXY(1,3,14,FStr(Window.CurX-Window.X1+1)+':'+π FStr(Window.CurY-Window.Y1+1)+' ');π WriteXY(40,2,14,'AH: '+FStr(Hi(AX))+' ');π WriteXY(40,3,14,'AL: '+FStr(Lo(AX))+' ');π WriteXY(40,4,14,'BH: '+FStr(Hi(BX))+' ');π WriteXY(40,5,14,'BL: '+FStr(Lo(BX))+' ');π WriteXY(50,2,14,'CH: '+FStr(Hi(CX))+' ');π WriteXY(50,3,14,'CL: '+FStr(Lo(CX))+' ');π WriteXY(50,4,14,'DH: '+FStr(Hi(DX))+' ');π WriteXY(50,5,14,'DL: '+FStr(Lo(DX))+' ');π OldFnc := Fnc;π end;π {$endif}π SetIntVec($10,@NewInt10);πend;π{$F-}ππProcedure ExecWindow;πbeginπ Window.X1 := X1;π Window.Y1 := Y1;π Window.X2 := X2;π Window.Y2 := Y2;π Window.Attr := Attr;π {$ifOPT D+}π Fnc := 255;π OldFnc := 255;π {$endif}π ClearXY(Window.X1,Window.Y1,π Window.X2,Window.Y2,Window.Attr);π GotoXY(Window.X1,Window.Y1);π Window.CurX := Window.X1;π Window.CurY := Window.Y1;π SwapVectors;π GetIntVec($10,SaveInt10);π SetIntVec($10,@NewInt10);π Exec(Path,CmdLine);π SetIntVec($10,SaveInt10);π SwapVectors;πend;ππbeginπ Window.X1 := Lo(WindMin);π Window.Y1 := Hi(WindMin);π Window.X2 := Lo(WindMax);π Window.Y2 := Hi(WindMax);π Window.Attr := TextAttr;π Window.CurX := WhereX;π Window.CurY := WhereY;π Cleared := False;π ActPage := Ptr(Seg0040,$0062);π VideoMode := Ptr(Seg0040,$0049);π if VideoMode^=7 thenπ Screen := Ptr(SegB000,$0000)π elseπ Screen := Ptr(SegB800,$0000);πend.π 2 05-28-9314:08ALL SWAG SUPPORT TEAM SHADOW1.PAS IMPORT 10 F╔ye {π> I Write the following Procedure to shadow Text behind a box. It worksπ> fine (so Far), but am not sure if there is a quicker, easier way.ππYou are searching through the video-RAM For the Char and Attr, you want toπchange. Perhaps, it is easier and faster to use the interrupt, that returnsπyou the Char under the Cursor , than you can change the attribute.π}πUsesπ Dos, Crt;ππProcedure Shadow(x1, y1, x2, y2 : Byte);πVarπ s, i, j : Byte;ππ Procedure Z(x, y : Byte);π Varπ r : Registers;π beginπ r.ah := $02;π { Function 2hex (Put Position of Cursor) }π r.bh := 0;π r.dh := y - 1; { Y-Position }π r.dl := x - 1; { X-Position }π intr($10,r);π r.ah := $08;π { Fkt. 8hex ( Read Char under cursor ) }π r.bh := 0;π intr($10, r);π Write(chr(r.al));π end;ππbeginπ s := TextAttr; { save Attr }π TextAttr := 8;π For i := y1 + 1 to y2 + 1 doπ For j := x1 + 1 to x2 + 1 doπ z(i, j);π TextAttr := s; { Attr back }πend;ππbeginπ Shadow(10,10,20,20);π ReadKey;πend. 3 05-28-9314:08ALL SWAG SUPPORT TEAM SHADOW2.PAS IMPORT 8 F╔┐∞ {πI Write the following Procedure to shadow Text behind a box. It worksπfine (so Far), but am not sure if there is a quicker, easier way.π}ππProcedure Shadow(x, y, xlength, ylength : Byte);πVarπ xshad,π yshad : Word;π i : Byte;πbeginπ xlength := xlength shl 1; { xlength * 2 }π xshad := ((x*2)+(y*160)-162) + ((ylength+1) * 160) + 4; { x coord }π yshad := ((x*2)+(y*160)-162) + (xlength); { y coord }π if Odd(Xshad) then Inc(XShad); { we want attr not Char }π if not Odd(YShad) then Inc(YShad); { " }π For i := 1 to xlength Doπ if Odd(i) thenπ Mem[$B800:xshad+i] := 8; { put x shadow }π For i := 1 to ylength Doπ beginπ Mem[$B800:yshad+(i*160)] := 8; { put y shadows }π Mem[$B800:yshad+2+(i*160)] := 8π endπend;π 4 05-28-9314:08ALL SWAG SUPPORT TEAM WINDOWS1.PAS IMPORT 38 F╔IO {π> Okay...it works fine, but I want to somehow be able to kindo of remove tπ> Window. I'm not sure if there is any way of doing this?ππYou need to save the screen data at the location you wish to makeπa Window, then after you're done With the Window simply restoreπthe screen data back to what it was. Here's some exampleπroutines of what you can do, you must call InitWindows once atπthe begining of the Program before using the OpenWindowπProcedure, then CloseWindow to restore the screen.π}ππUsesπ Crt;ππTypeπ ShadeType = (Shading, NoShading);π ScreenBlock = Array [1..2000] of Integer;π ScreenLine = Array [1..80] of Word;π ScreenArray = Array [1..25] of ScreenLine;π WindowLink = ^WindowControlBlock;π WindowControlBlock = Recordπ X,Y : Byte; { start position }π Hight : Byte; { Menu Hight }π Width : Byte; { Menu width }π ID : Byte; { Menu number }π BackLink : WindowLink; { previous block }π MenuItem : Byte; { select item }π ScreenData : ScreenBlock; { saved screen data }π end;π String30 = String[30];π ScreenPtr = ^ScreenRec;π ScreenRec = Array [1..25,1..80] of Integer;πππVarπ Screen : ScreenPtr;π ActiveWindow : Pointer;ππProcedure InitWindows;πbeginπ If LastMode = Mono Thenπ Screen := Ptr($B000,0)π Elseπ Screen := Ptr($B800,0);π ActiveWindow := Nil;πend;ππProcedure OpenWindow(X, Y, Lines, Columns, FrameColor,π ForeGround, BackGround : Byte;π Title : String30; Shade : ShadeType);πVarπ A, X1, X2,π Y1, Y2 : Integer;π OldAttr : Integer;π WindowSize : Integer;π Block : WindowLink;πbeginπ OldAttr := TextAttr;ππ WindowSize := (Lines + 3) * (Columns + 5) * 2 +π Sizeof(WindowControlBlock) - Sizeof(ScreenBlock);ππ If MemAvail < WindowSize Thenπ beginπ WriteLn;WriteLn('Program out of memory');π Halt;π end;ππ GetMem(Block,WindowSize);π Block^.X := X - 2;π Block^.Y := Y - 1;π Block^.Hight := Lines + 3;π Block^.Width := Columns + 5;π Block^.BackLink := ActiveWindow;ππ ActiveWindow := Block;π A := 1;π For Y1 := Block^.Y to Block^.Y+Block^.Hight-1 Doπ beginπ Move(Screen^[Y1, Block^.X], Block^.ScreenData[A], Block^.Width * 2);π A := A + Block^.Width;π end;ππ TextColor(FrameColor);π If BackGround = Black Thenπ TextBackGround(LightGray) { This will keep exploding Window visable }π Elseπ TextBackground(BackGround);ππ X1 := X + Columns Div 2;π X2 := X1 + 1;π Y1 := Y + Lines Div 2;π Y2 := Y1 + 1;ππ Repeatπ Window(X1, Y1, X2, Y2);π ClrScr;π If Columns < 20 Thenπ Delay(20);π If X1 > X Thenπ Dec(X1);π If X2 < X + Columns Thenπ Inc(X2);π If Y1 > Y Thenπ Dec(Y1);π If Y2 < Y + Lines Thenπ Inc(Y2);π Until (X2 - X1 >= Columns ) And (Y2 - Y1 >= Lines);ππ Window(X - 1, Y, X + Columns, Y + Lines);π TextBackground(BackGround);π ClrScr;π TextColor(FrameColor);π Window(1, 1, 80, 24);π GotoXY(X - 2, Y - 1);π Write('┌');π For A := 1 to Columns + 2 Doπ Write('─');ππ Write('┐');π For A := 1 to Lines Doπ beginπ GotoXY(X - 2, Y + A - 1);π Write('│');π GotoXY(X + Columns + 1, Y + A - 1);π Write('│');π end;π GotoXY(X - 2, Y + Lines);π Write('└');π For A := 1 to Columns + 2 Doπ Write('─');π Write('┘');π If Shade = Shading Thenπ beginπ For A := Y to Y + Lines + 1 Doπ Screen^[A, X + Columns + 2] := Screen^[A, X + Columns + 2] And $07FF;π For A := X - 1 to X + Columns + 1 Doπ Screen^[Y + Lines + 1, A] := Screen^[Y + Lines + 1, A] And $07FF;π end;π If Title <> '' Thenπ beginπ TextColor(FrameColor);π GotoXY(X + ((Columns - Length(Title)) div 2) - 1, Y - 1);π Write(' ', Title, ' ');π end;π Window(1, 1, 80, 24);πend;ππProcedure CloseWindow;πVarπ Block : WindowLink;π A : Integer;π Y1 : Integer;π WindowSize : Integer;πbeginπ If ActiveWindow = Nil Thenπ Exit;π Block := ActiveWindow;π WindowSize := (Block^.Hight) * (Block^.Width) * 2 +π Sizeof(WindowControlBlock) - Sizeof(ScreenBlock);π A := 1;π For Y1 := Block^.Y to Block^.Y+Block^.Hight - 1 Doπ beginπ Move(Block^.ScreenData[A], Screen^[Y1, Block^.X], Block^.Width * 2);π A := A + Block^.Width;π end;π ActiveWindow := Block^.BackLink;π FreeMem(Block, WindowSize);πend;ππbeginπ InitWindows;π OpenWindow(10, 5, 10, 50, LightGreen, LightBlue, Magenta,π 'Test Window', Shading);π ReadKey;π OpenWindow(20, 6, 6, 30, Green, Yellow, Blue,π 'Test Window 2', Shading);π ReadKey;π CloseWindow;π ReadKey;π CloseWindow;π ReadKey;π GotoXY(1,24);ππend.π 5 05-28-9314:08ALL SWAG SUPPORT TEAM WINDOWS2.PAS IMPORT 37 F╔E[ Uses Crt;ππTypeππ BufferType = Array[0..3999] of Byte; { screen size }π PtrBufferType = ^BufferType; { For dynamic use }ππVarπ Screen: BufferType Absolute $B800:$0; { direct access to }π { Text screen }ππFunction CharS(Len:Byte; C: Char): String;πVarπ S: String;πbegin { This Function returns a String of }π FillChar(S, Len+1, C); { Length Len and of Chars C. }π S[0] := Chr(Len);π CharS := S;πend;ππFunction Center(X1, X2: Byte; S: String): Byte;πVarπ L, Max: Integer;πbegin { This Function is used to center }π Max := (X2 - (X1-1)) div 2; { a String between two X coordinates. }π L := Length(S);π if Odd(L) then Inc(L);π Center := X1 + (Max - (L div 2));πend;πππProcedure DrawBox(X1, Y1, X2, Y2: Integer; Attr: Byte; Title: String);πVarπ L, Y, X: Integer;π S: String;ππbeginπ X := X2 - (X1-1); { find box width }π Y := Y2 - (Y1-1); { find box height }π { draw box }π S := Concat('╔', CharS(X-2, '═'), '╗');π GotoXY(X1, Y1);π TextAttr := Attr;π Write(S);π Title := Concat('╡ ', Title,' ╞');π GotoXY(Center(X1, X2, Title), Y1);π Write(Title);π For L := 2 to (Y-1) doπ beginπ GotoXY(X1, Y1+L-1);π Write('║', CharS(X-2, ' '), '║');π end;π GotoXY(X1, Y2);π Write('╚', CharS(X-2, '═'), '╝');ππend;ππProcedure SaveBox(X1, Y1, X2, Y2: Integer; Var BufPtr: PtrBufferType);πVarπ Poff, Soff, Y, XW, YW, Size: Integer;ππbeginπ XW := X2 - (X1 -1); { find box width }π YW := Y2 - (Y1 -1); { find box height }π Size := (XW*2 ) * YW; { size needed to store background }π GetMem(BufPtr, Size); { allocate memory to buffer }π For Y := 1 to YW do { copy line by line to buffer }π beginπ Soff := (((Y1-1) + (Y-1)) * 160) + ((X1-1)*2);π Poff := ((XW * 2) * (Y-1));π Move(Screen[Soff], BufPtr^[Poff], (XW * 2)); { Write to buffer }π end;πend;ππ(*************** end of PART 1 of 2. *****************************)π(****** PART 2 of 2 ********************************)πProcedure RestoreBox(X1, Y1, X2, Y2: Integer; Var BufPtr: PtrBufferType);πVarπ Poff, Soff, X, Y, XW, YW, Size: Integer;π F: File;ππbeginπ XW := X2 - (X1-1); { once again...find box width }π YW := Y2 - (Y1-1); { find height }π Size := (XW *2) * YW; { memory size to deallocate from buffer }π For Y := 1 to YW do { move back, line by line }π beginπ Soff := (( (Y1-1) + (Y-1)) * 160) + ((X1-1)*2);π Poff := ((XW*2) * (Y-1));π Move(BufPtr^[Poff], Screen[Soff], (XW*2));π end;π FreeMem(BufPtr, Size);πend;πππProcedure Shadow(X1, Y1, X2, Y2: Byte);πVarπ Equip: Byte Absolute $40:$10;π Vert, Height, offset: Integer;ππbeginπ if (Equip and 48) = 48 then Exit;ππ For Vert := (Y1+1) to (Y2+1) doπ For Height := (X2+1) to (X2+2) doπ beginπ offset := (Vert - 1) * 160 + (Height-1) * 2 + 1;π Screen[offset] := 8;π end;π Vert := Y2 + 1;π For Height := (X1+2) to (X2+2) doπ beginπ offset := (Vert-1) * 160 + (Height-1) * 2 + 1;π Screen[offset] := 8;π end;πend;ππProcedure Hello;πVarπ BufPtr: PtrBufferType;πbeginπ { note, that if you use shadow, save an xtra 2 columnsπ and 1 line to accomadate what Shadow does }π { V V }π SaveBox(7, 7, 73, 15, BufPtr);π DrawBox(7, 7, 71, 13, $4F, 'Hello');π Shadow(7, 7, 71, 13);π GotoXY(9, 9);π Write('Hello Terry! I hope this is what you were asking For.');π GotoXY(9, 11);π Write('Press Enter');π While ReadKey <> #13 do;π RestoreBox(7, 7, 73, 14, BufPtr);πend;ππProcedure Disclaimer;πVarπ BufPtr: PtrBufferType;πbeginπ SaveBox(5, 5, 77, 21, BufPtr);π DrawBox(5, 5, 75, 20, $1F, 'DISCLAIMER');π Shadow(5, 5, 75, 20);π Window(7, 7, 73, 19);π Writeln(' Seeing as I came up With these Procedures For');π Writeln('my own future Programs (I just recently wrote these)');π Writeln('please don''t Forget who wrote them originally if you');π Writeln('decide to use them in your own. Maybe a ''thanks to Eric Miller');π Writeln('For Window routines'' somewhere in your doCs?');π Writeln;π Writeln(' Also, if anyone can streamline this source, well, I''d');π Writeln('I''d like to see it...not that too much can be done.');π Writeln;π Writeln(' Eric Miller');π Window(1,1,80,25);π Hello;π TextAttr := $1F;π GotoXY(9, 18);π Writeln('Press Enter...');π While ReadKey <> #13 do;π RestoreBox(5, 5, 77, 21, BufPtr);πend;ππbeginπ TextAttr := $3F;π ClrScr;π Disclaimer;πend.π(***** end of PART 1 of 2 ******************************)π 6 05-28-9314:08ALL SWAG SUPPORT TEAM WINDOWS3.PAS IMPORT 17 F╔+₧ DS> Like say there is a Text Window that pops up when someone makes aπDS>choice. Then they select something else and a Text Window is made thatπDS>overlaps the previous one. Then I'd like to have it so if the userπDS>were to press, say, escape, the current Text Window would be "removed"πDS>and the old Window would still be there as is was....πDS>How can this be done?? Please keep in mind that I'm still sort ofππHere's two Procedures a friend of mine wrote (David Thomas: give creditπwhree credit is due). It works great With regular Text screens.πππPut This in you Type section:ππ WindowStatus = (OnScreen, OffScreen);π WindowType = Recordπ Point : Pointer;π Status : WindowStatus;π Col,π Row,π SaveAttr : Byte;π end;ππProcedure GetWindow (Var Name : WindowType);πVarπ Size,π endOffset,π StartOffset : Integer;πbegin { GetWindow }ππ With Name Doπ beginπ Col := WhereX;π Row := WhereY;π SaveAttr := TextAttr;ππ StartOffset := 0;π endOffset := 25 * 160;π Size := endOffset - StartOffset;π GetMem (Point, Size);ππ Move (Mem[$B800:StartOffset], Point^, Size);π Status := OnScreen;π end; { With }ππend; { GetWindow }π{--------------------------------------------------------------------}πProcedure PutWindow (Var Name : WindowType);πVarπ Size,π endOffset,π StartOffset : Integer;πbegin { PutWindow }ππ With Name Doπ beginπ StartOffset := 0;π endOffset := 25 * 160;π Size := endOffset - StartOffset;ππ Move (Point^, Mem[$B800:StartOffset], Size);ππ FreeMem (Point, Size);π Status := OffScreen;ππ TextAttr := SaveAttr;π GotoXY (Col, Row);π end; { With }ππend; { PutWindow }πππVery easy to use. Just declare a Varibale of WindowType, call theπGETWindow routine, then display whatever. When you're done, call theπPUTWindow routine and it Zap, it's back to how it was. Very face, veryπnice.π 7 05-28-9314:08ALL SALIM SAMAHA WINDOWS4.PAS IMPORT 10 F╔≈∞ { SALIM SAMAHA }ππUnit Windows;ππInterfaceππUsesπ Crt;ππ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);πProcedure CloseWindow;ππImplementationππ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;ππ 8 08-27-9322:02ALL SEAN PALMER Moving Text Images IMPORT 12 F╔ {πSEAN PALMERππ>I was looking threw a Turbo C++ manual and noted someπ>Procedures that deal With the Text screen, such asπ>Get/PutTextImage. I was wondering if anyone has created oneπ>for Pascal to move/save Text images around the screen likeπ>in C++.ππCopies a rectangular section from one video buffer (any size) to anotherπ}ππProcedure moveScr(Var srcBuf; srcX, srcY, width, height, srcBufW,π srcBufH : Word; Var dstBuf; dstX, dstY, dstBufW,π dstBufH : Word); Assembler;πAsmπ cldπ push dsπ lds si, srcBuf {calc src adr}π mov ax, srcBufWπ mul srcYπ add ax, srcXπ shl ax, 1π add si, axπ les di, dstBuf {calc dst adr}π mov ax, dstBufWπ mul dstYπ add ax, dstXπ shl ax, 1π add di, axπ mov dx, height {num lines}π mov ax, SrcBufW {calc ofs between src lines}π sub ax, widthπ shl ax, 1π mov bx, dstBufW {calc ofs between dst lines}π sub bx, widthπ shl bx, 1π @L:π mov cx, widthπ rep movswπ add si, axπ add di, bxπ dec dxπ jnz @Lπ pop dsπend;ππVarπ s : Array [0..24,0..79,0..1] of Char Absolute $B800 : 0;π d : Array [0..11,0..39,0..1] of Char;π i : Integer;ππbeginπ For i := 1 to 25 * 10 doπ Write('(--)(--)');π moveScr(s,0,0,40,12,80,25,d,0,0,40,12); {copy 40x12 block to buf}π readln;π moveScr(d,0,0,38,10,40,12,s,5,5,80,25); {copy part back to screen}π readln;πend.ππ 9 11-02-9305:03ALL KIMBA DOUGHTY Shadow Boxes IMPORT 18 F╔ { Updated SCREEN.SWG on November 2, 1993 }ππ{πKIMBA DOUGHTYππ> could someone tell me how to do a shadow Window.. you know the Type thatπ> has a Window then a shadow of what is under the Window in color 8 or darkπ> gray... Either in Inline assembly or Straight Pascal...π}ππUnit shadow;ππInterfaceππUsesπ Crt, Dos;ππProcedure WriteXY(X, Y : Integer; S : String);πFunction GetCharXY(X, Y : Integer) : Char;πProcedure SHADE(PX, PY, QX, QY : Integer);πProcedure BOX(PX, PY, QX, QY : Integer);πProcedure SHADOWBOX(PX, PY, QX, QY : Integer; fg, bg : Byte);ππImplementationππProcedure menubox(x1, y1, x2, y2 : Integer; fg, bg : Byte);πVarπ count : Integer;πbeginπ TextColor(fg);π TextBackGround(bg);π Writexy(x1 + 1, y1, '╔');ππ For count := x1 + 2 to x2 - 2 doπ Writexy(count, y1, '═');ππ Writexy(x2 - 1, y1, '╗');π For count := y1 + 1 to y2 - 1 doπ Writexy(x1 + 1, count, '║');ππ Writexy(x1 + 1, y2, '╚');π For count := y1 + 1 to y2 - 1 doπ Writexy(x2 - 1, count, '║');ππ Writexy(x2 - 1, y2, '╝');π For count := x1 + 2 to x2 - 2 doπ Writexy(count, y2, '═');πend;ππProcedure WriteXY(X, Y : Integer; S : String);πVarπ SX, SY : Integer ;πbeginπ SX := WhereX;π SY := WhereY;π GotoXY(X, Y);π Write(S);π GotoXY(SX, SY);πend;ππFunction GetCharXY(X, Y : Integer) : Char;πVarπ Regs : Registers;π SX, SY : Integer;πbeginπ SX := WhereX;π SY := WhereY;π GotoXY(X, Y);π Regs.AH := $08;π Regs.BH := $00;π Intr($10, Regs);π GetCharXY := Char(Regs.AL);π GotoXY(SX, SY);πend;ππProcedure SHADE(PX, PY, QX, QY : Integer);πVarπ X, Y : Integer;πbeginπ TextColor(8);π TextBackGround(black);π For Y := PY to QY Doπ For X := PX to QX Doπ WriteXY(X, Y, GetCharXY(X, Y));πend;ππProcedure BOX(PX, PY, QX, QY : Integer);πbeginπ Window(PX, PY, QX, QY);π ClrScr;πend;ππProcedure SHADOWBOX(PX, PY, QX, QY: Integer; fg, bg : Byte);πbeginπ TextColor(fg);π TextBackGround(bg);π BOX(PX, PY, QX, QY);π Window(1, 1, 80, 25);π SHADE(PX + 2, QY + 1, QX + 2, QY + 1);π SHADE(QX + 2, PY + 1, QX + 2, QY + 1);π SHADE(QX + 1, PY + 1, QX + 1, QY + 1);π MENUBOX(PX, PY, QX, QY, fg, bg);πend;ππend.ππ 10 11-02-9305:43ALL KELLY SMALL Get TextAttr Colors IMPORT 4 F╔ {πKELLY SMALLππ>Get the foreground/background/blink attr out of TextAttr.ππAssuming you're using TP/BP:π}ππProcedure GetColor(Var f, b : Byte; Var BlinkOn : Boolean);πbeginπ f := TextAttr And $F;π b := (TextAttr Shr 4) And 7;π BlinkOn := TextAttr And $80 = $80;πend;π 11 11-21-9309:29ALL TIM SCHEMPP Text DrawLine Functions IMPORT 63 F╔ { WRITTEN BY TIM SCHEMPPπ OCTOBER 21, 1993 }ππunit drawline;ππinterfaceππ procedure horizline(x1,x2,y:integer; default:char);π procedure vertline(x,y1,y2:integer; default:char);π procedure rectlines(x1,y1,x2,y2:integer; default:char);ππ{ IF writetomemory IS SET TO TRUE, LINES WILL BE DRAWN AN AVERAGE OFπ ABOUT 15 TO 20 PERCENT FASTER THAN IF writetomemory IS SET TO FALSE.π HOWEVER, IF DATA IS WRITTEN DIRECTLY TO VIDEO MEMORY, YOU ARE STUCK WITHπ THE SCREENS CURRENT COLORS (TEXTCOLOR AND TEXTBACKGROUND HAVE NO EFFECT).π THE DEFAULT VALUE OF writetomemory IS FALSE. }ππvar writetomemory:boolean;ππimplementationπ uses crt; {for gotoxy, wherex and wherey}ππ const symbols:array[1..40] of char=π ('│','┤','╡','╢','╖','╕','╣','║','╗','╝','╜','╛','┐',π '└','┴','┬','├','─','┼','╞','╟','╚','╔','╩','╦','╠',π '═','╬','╧','╨','╤','╥','╙','╘','╒','╓','╫','╪','┘',π '┌');ππ codes:array[1..40] of string[4]=π ('1010','1011','1012','2021','0021','0012','2022','2020',π '0022','2002','2001','1002','0011','1100','1101','0111',π '1110','0101','1111','1210','2120','2200','0220','2202',π '0222','2220','0202','2222','1202','2101','0212','0121',π '2100','1200','0210','0120','2121','1212','1001','0110');ππ {THE SCREEN DIMENSIONS}π screenwidth=80; screenlength=25;ππ{******}ππ{READS A CHARACTER FROM VIDEO MEMORY AT THE GIVEN COORDINANTS}πfunction Memread(col,row:integer):char;ππ Constπ Seg = $B000; { Video memory address for color system }π Ofs = $8000; { For monochrome system, make Ofs = $0000 }π Varπ SChar : Integer;π Beginπ SChar := ((Row-1)*160) + ((Col-1)*2); { Compute starting location }π memread:=chr(Mem[Seg:Ofs + SChar]); { read character from memory}π End;ππ{******}ππ{WRITES A CHARACTER DIRECTORY TO VIDEO MEMORY AT THE GIVEN COORDINATES}π{NOTE: THE CURRENT COLORS AT THE GIVEN COORDINANTS ARE USED FOR DRAWING.}πprocedure Memwrite(col,row:integer; c:char);ππ Constπ Seg = $B000; { Video memory address for color system }π Ofs = $8000; { For monochrome system, make Ofs = $0000 }π Varπ SChar : Integer;π Beginπ SChar := ((Row-1)*160) + ((Col-1)*2); { Compute starting location }π Mem[Seg:Ofs + SChar]:=ord(c); { write character to memory}π End;ππ{******}ππ {PROCEDURE USED INTERNALLY TO CREATE A SET OF CHARACTER CODES}π function getcode(c:char; direction:byte):char;π var counter:integer;π beginπ counter:=1;π while (counter<=40) and (c<>symbols[counter]) do inc(counter);π if counter>40 then getcode:='0' else getcode:=codes[counter,direction];π end;ππ{******}ππ {PROCEDURE DRAWS A LINE IN TEXT MODE FROM (X1,Y) TO (X2,Y)}π {DEFAULT IS EITHER '1' OR '2' FOR SINGLE OF DOUBLE LINES}π procedure horizline(x1,x2,y:integer; default:char);ππ var code:string[4];π defaultchar:char;π c,index:integer;π xpos,ypos:integer;ππ beginπ xpos:=wherex; ypos:=wherey;π if x2<x1 then begin c:=x1; x1:=x2; x2:=c; end;π if default='1' then defaultchar:=symbols[18]π else defaultchar:=symbols[27];π for c:=x1 to x2 doπ beginπ code:='0000';π if y<>0 then code[1]:=getcode(memread(c,y-1),3) else code[1]:='0';π if (c=x2) and (x2=screenwidth) then code[2]:='0'π else if (c=x2) then code[2]:=getcode(memread(x2+1,y),4)π else code[2]:=default;π if y<>screenlength then code[3]:=getcode(memread(c,y+1),1)π else code[3]:='0';π if (c=x1) and (x1=1) then code[4]:='0'π elseπ if (c=x1) then code[4]:=getcode(memread(x1-1,y),2)π else code[4]:=default;π index:=1;π while (index<=40) and (code<>codes[index]) do inc(index);π if writetomemory thenπ if index>40 then memwrite(c,y,defaultchar)π else memwrite(c,y,symbols[index])π elseπ if index>40 then begin gotoxy(c,y); write(defaultchar); endπ else begin gotoxy(c,y); write(symbols[index]); end;π end; {counter}π if not writetomemory then gotoxy(xpos,ypos);π end;ππ{******}ππ {PROCEDURE DRAWS A LINE IN TEXT MODE FROM (X,Y1) TO (X,Y2)}π {DEFAULT IS EITHER '1' OR '2' FOR SINGLE OF DOUBLE LINES}π procedure vertline(x,y1,y2:integer; default:char);ππ var code:string[4];π defaultchar:char;π c,index:integer;π xpos,ypos:integer;ππ beginπ xpos:=wherex; ypos:=wherey;π if y2<y1 then begin c:=y1; y1:=y2; y2:=c; end;π if default='1' then defaultchar:=symbols[1]π else defaultchar:=symbols[8];π for c:=y1 to y2 doπ beginπ code:='0000';π if (c=y2) and (y2=screenlength) then code[3]:='0'π else if (c=y2) then code[3]:=getcode(memread(x,y2+1),1)π else code[3]:=default;π if x<>screenwidth then code[2]:=getcode(memread(x+1,c),4)π else code[1]:='0';π if x<>1 then code[4]:=getcode(memread(x-1,c),2)π else code[1]:='0';π if (c=y1) and (y1=0) then code[1]:='0'π else if (c=y1) then code[1]:=getcode(memread(x,y1-1),3)π else code[1]:=default;π index:=1;π while (index<=40) and (code<>codes[index]) do inc(index);ππ if writetomemory thenπ if index>40 then memwrite(x,c,defaultchar)π else memwrite(x,c,symbols[index])π elseπ if index>40 then begin gotoxy(x,c); write(defaultchar) endπ else begin gotoxy(x,c); write(symbols[index]); end;π end; {counter}π if not writetomemory then gotoxy(xpos,ypos);π end;ππ{******}ππ {PROCEDURE DRAWS A RECTANGLE IN TEXT MODE}π {DEFAULT IS EITHER '1' OR '2' FOR SINGLE OF DOUBLE LINES}π procedure rectlines(x1,y1,x2,y2:integer; default:char);ππ beginπ horizline(x1,x2,y1,default);π horizline(x1,x2,y2,default);π vertline(x1,y1,y2,default);π vertline(x2,y1,y2,default);π end;ππ{******}ππ beginπ writetomemory:=false;π end. {unit}πππ {------------------- DEMO PROGRAM ------------------------}π { ---------------- CUT HERE --------------------------}ππ { WRITTEN BY TIM SCHEMPPπ OCTOBER 21, 1993 }ππ {THIS PROGRAM DEMONSTARTES THE USE OF THE UNIT drawline. UNIT DRAWLINEπ WILL USE THE ASCII SET TO DRAW LINES. WHEN LINE INTERSECTIONS AREπ FOUND, THE PROCEDURES DESCIDE WHICH CHARACTER FITS BEST. THUS MAKINGπ IT VERY EASY TO CREATE VARIOUS TABLES AND OTHER SCREEN SET UPS. THEπ UNIT ALSO HAS THE ABILITY TO WRITE DIRECTORY TO VIDEO MEMORY FORπ A 15% TO 20% IMPROVEMENT IN SPEED. SEE DRAWLINE.DOC FOR MORE INFO.}ππprogram demo;ππ uses crt,drawline;ππ var counter:integer;ππ beginπ {SET THE SCREEN UP}π textbackground(black);π textcolor(white);π clrscr;ππ {THE CALL TO CLEAR SCREEN FILLED THE SCREEN WITH SPACES WITH A BLACKπ BACKGROUND AND A WHITE FOREGROUND. IF writetomemory IS SET TO TRUE,π ALL OF THE OUTPUT WILL BE WRITTEN WITH A BLACK BACKGROUND AND A WHITEπ FOREGROUND REGARDLESS OF TEXT ATTRIBUTE CHANGES.}ππ {writetomemory:=true;} { <--- ADD THIS STATEMENT AND SEE COLOR DIFFERENCE}ππ {WRITE SOME TEXT}π gotoxy(22,6);π textcolor(lightblue);π write('LINE DRAWING DEMONSTARTATION PROGRAM');π textcolor(yellow);π {DRAW A RECTANGLE WITH DOUBLE LINES}π rectlines(10,4,70,20,'2');π {DRAW SOME HORIZONTAL SINGLE LINES}π for counter:=9 to 19 doπ horizline(10,70,counter,'1');π {DRAW SOME SINGLE VERTICLE LINES}π counter:=20;π while counter<=60 doπ beginπ vertline(counter,8,20,'1');π inc(counter,10);π end; {WHILE}π {DRAW ONE LAST HORIZONTAL DOUBLE LINE}π horizline(10,70,8,'2');ππ repeat until keypressed;π end. 12 02-03-9410:59ALL DAVID DAHL Graphics Win in Text ModeIMPORT 105 F╔ {π STG>Does anyone know off hand if I can be in text mode and window in aπ STG>window and put the wondow only in graphics mode?π STG>I have a program that I need to have a graph in. Does anyone have someπ STG>code for using the PLOT procedure to plot variables. The values forπ STG>the Y axis are from 1 - 2000, and for the X axis from 1 - 24.ππ Yes, it's possible... sort of. If you have a VGA (orπEGA) you can have 2 separate character sets on screen at once.πUse one character set for text, and redefine the other for yourπgraphics window. The only problem is that your graphics windowπcan only be composed of 256 characters total. So, a 16 X 16πcharacter square would only give you a vertical resolution of 256πpixels and a horizontal resolution of 128 pixels. The followingπcode is an example of how one would do this.ππ Daveππ}ππProgram GraphicsInTextModeExample;ππ{================================================ππ Graphics In Text Mode Exampleπ Programmed by David Dahlπ 12/24/93π This program and source are PUBLIC DOMAINππ ------------------------------------------------ππ This example uses a second font as a pseudo-π graphics window. This program requires VGA.ππ ================================================}ππUses CRT;ππConst { Dimentions of The Graphics Window in Characters }π ChrSizeX = 32;π ChrSizeY = 256 DIV ChrSizeX;π { Dimentions of The Graphics Window in Pixels }π MaxX = ChrSizeX * 8;π MaxY = ChrSizeY * 16;ππ{-[ Set Character Width to 8 Pixels ]-------------------------------------}πProcedure SetCharWidthTo8; Assembler;πAsmπ { Change To 640 Horz Res }π MOV DX, $3CCπ IN AL, DXπ AND AL, Not(4 OR 8)π MOV DX, $3C2π OUT DX, ALπ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 0π OUT DX, ALπ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALπ { Switch To 8 Pixel Wide Fonts }π MOV DX, $3C4π MOV AL, 1π OUT DX, ALπ MOV DX, $3C5π IN AL, DXπ OR AL, 1π OUT DX, ALπ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 0π OUT DX, ALπ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALπ { Center Screen }π MOV DX, $3DAπ IN AL, DXπ MOV DX, $3C0π MOV AL, $13 OR 32π OUT DX, ALπ MOV AL, 0π OUT DX, ALπEnd;π{-[ Turn On Dual Fonts ]--------------------------------------------------}πProcedure SetDualFonts; Assembler;πASMπ { Set Fonts 0 & 1 }π MOV BL, 4π MOV AX, $1103π INT $10πEND;π{-[ Turn On Access To Font Memory ]---------------------------------------}πProcedure SetAccessToFontMemory; Assembler;πASMπ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 1π OUT DX, ALπ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALπ { Change From Odd/Even Addressing to Linear }π MOV DX, $3C4π MOV AL, 4π OUT DX, ALπ MOV DX, $3C5π MOV AL, 7π OUT DX, ALπ { Switch Write Access To Plane 2 }π MOV DX, $3C4π MOV AL, 2π OUT DX, ALπ MOV DX, $3C5π MOV AL, 4π OUT DX, ALπ { Set Read Map Reg To Plane 2 }π MOV DX, $3CEπ MOV AL, 4π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 2π OUT DX, ALπ { Set Graphics Mode Reg }π MOV DX, $3CEπ MOV AL, 5π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 0π OUT DX, ALπ { Set Misc. Reg }π MOV DX, $3CEπ MOV AL, 6π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 12π OUT DX, ALπEnd;π{-[ Turn On Access to Text Memory ]---------------------------------------}πProcedure SetAccessToTextMemory; Assembler;πASMπ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 1π OUT DX, ALπ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALπ { Change To Odd/Even Addressing }π MOV DX, $3C4π MOV AL, 4π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALπ { Switch Write Access }π MOV DX, $3C4π MOV AL, 2π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3 {?}π OUT DX, ALπ { Set Read Map Reg }π MOV DX, $3CEπ MOV AL, 4π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 0π OUT DX, ALπ { Set Graphics Mode Reg }π MOV DX, $3CEπ MOV AL, 5π OUT DX, ALπ MOV DX, $3CFπ MOV AL, $10π OUT DX, ALπ { Set Misc. Reg }π MOV DX, $3CEπ MOV AL, 6π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 14π OUT DX, ALπEnd;π{-[ Clear The Pseudo-Graphics Window by Clearing Font Definition ]--------}πProcedure ClearGraphicsWindow;πBeginπ SetAccessToFontMemory;π FillChar (MEM[$B800:$4000], 32 * 256, 0);π SetAccessToTextMemory;πEnd;π{-[ Turn The Cursor Off ]-------------------------------------------------}πProcedure TurnCursorOff; Assembler;πASMπ MOV DX, $3D4π MOV AL, $0Aπ OUT DX, ALπ MOV DX, $3D5π IN AL, DXπ OR AL, 32π OUT DX, ALπEnd;π{-[ Turn The Cursor On ]--------------------------------------------------}πProcedure TurnCursorOn; Assembler;πASMπ MOV DX, $3D4π MOV AL, $0Aπ OUT DX, ALπ MOV DX, $3D5π IN AL, DXπ AND AL, Not(32)π OUT DX, ALπEnd;π{-[ Set Up The Pseudo-Graphics Window ]-----------------------------------}πProcedure SetGraphicsWindow (XCoord, YCoord : Byte;π Color, BackGround : Byte);πVar CounterX,π CounterY : Byte;πBeginπ For CounterY := 0 to (ChrSizeY-1) doπ For CounterX := 0 to (ChrSizeX-1) doπ MEMW[$B800:CounterX*2 + XCoord*2 + (YCoord * 80 * 2) +π (CounterY * 80 * 2)] :=π (CounterX + CounterY * ChrSizeX) ORπ (((Color OR 8) OR ((BackGround AND 15) SHL 4)) SHL 8);πEnd;π{-[ Plot a Pixel in The Pseudo-Graphics Window ]--------------------------}πProcedure PutPixel (Xin, Yin : Word);πVar RealY,π RealX : Word;πBeginπ If (Xin < MaxX) ANDπ (Yin < MaxY)π Thenπ Beginπ RealX := (Xin DIV 8) * 32;π RealY := (Yin MOD 16) + ((Yin DIV 16) * (32 * ChrSizeX));π SetAccessToFontMemory;π MEM[$B800:$4000 + RealX + RealY] :=π MEM[$B800:$4000 + RealX + RealY] OR (128 SHR (Xin MOD 8));π SetAccessToTextMemory;π End;πEnd;π{-[ Draw A Line ]---------------------------------------------------------}π{ OCTANT DDA Subroutine converted from the BASIC listing on pages 26 - 27 }π{ from the book _Microcomputer_Displays,_Graphics,_ And_Animation_ by }π{ Bruce A. Artwick }πProcedure Line (XStart, YStart, XEnd, YEnd : Word);πVar StartX,π StartY,π EndX,π EndY : Word;π DX,π DY : Integer;π CNTDWN : Integer;π Errr : Integer;π Temp : Integer;π NotDone : Boolean;πBeginπ NotDone := True;π StartX := XStart;π StartY := YStart;π EndX := XEnd;π EndY := YEnd;π If EndX < StartX Thenπ Beginπ { Mirror Quadrants 2,3 to 1,4 }π Temp := StartX;π StartX := EndX;π EndX := Temp;π Temp := StartY;π StartY := EndY;π EndY := Temp;π End;π DX := EndX - StartX;π DY := EndY - StartY;π If DY < 0 Thenπ Beginπ If -DY > DX Thenπ Beginπ { Octant 7 Line Generation }π CntDwn := -DY + 1;π ERRR := -(-DY shr 1); {Fast Divide By 2}π While NotDone doπ Beginπ PutPixel (StartX, StartY);π Dec (CntDwn);π If CntDwn <= 0π Then NotDone := Falseπ Elseπ Beginπ Dec(StartY);π Inc(Errr, DX);π If Errr >= 0 Thenπ Beginπ Inc(StartX);π Inc(Errr, DY);π End;π End;π End;π Endπ Elseπ Beginπ { Octant 8 Line Generation }π CntDwn := DX + 1;π ERRR := -(DX shr 1); {Fast Divide By 2}π While NotDone doπ Beginπ PutPixel (StartX, StartY);π Dec (CntDwn);π If CntDwn <= 0π Then NotDone := Falseπ Elseπ Beginπ Inc(StartX);π Dec(Errr, DY);π If Errr >= 0 Thenπ Beginπ Dec(StartY);π Dec(Errr, DX);π End;π End;π End;π End;π Endπ Else If DY > DX Thenπ Beginπ { Octant 2 Line Generation }π CntDwn := DY + 1;π ERRR := -(DY shr 1); {Fast Divide By 2}π While NotDone doπ Beginπ PutPixel (StartX, StartY);π Dec (CntDwn);π If CntDwn <= 0π Then NotDone := Falseπ Elseπ Beginπ Inc(StartY);π Inc(Errr, DX);π If Errr >= 0 Thenπ Beginπ Inc(StartX);π Dec(Errr, DY);π End;π End;π End;π Endπ Elseπ { Octant 1 Line Generation }π Beginπ CntDwn := DX + 1;π ERRR := -(DX shr 1); {Fast Divide By 2}π While NotDone doπ Beginπ PutPixel (StartX, StartY);π Dec (CntDwn);π If CntDwn <= 0π Then NotDone := Falseπ Elseπ Beginπ Inc(StartX);π Inc(Errr, DY);π If Errr >= 0 Thenπ Beginπ Inc(StartY);π Dec(Errr, DX);π End;π End;π End;π End;πEnd;π{-[ Draw A Circle ]-----------------------------------------------------}π{ Algorithm based on the Pseudocode from page 83 of the book _Advanced }π{ Graphics_In_C_ by Nelson Johnson }πProcedure Circle (XCoord, YCoord, Radius : Integer);πVar d : Integer;π X, Y : Integer;π Procedure Symmetry (xc, yc, x, y : integer);π Beginπ PutPixel ( X+xc, Y+yc);π PutPixel ( X+xc, -Y+yc);π PutPixel (-X+xc, -Y+yc);π PutPixel (-X+xc, Y+yc);π PutPixel ( Y+xc, X+yc);π PutPixel ( Y+xc, -X+yc);π PutPixel (-Y+xc, -X+yc);π PutPixel (-Y+xc, X+yc);π End;πBeginπ x := 0;π y := abs(Radius);π d := 3 - 2 * y;π While (x < y) doπ Beginπ Symmetry (XCoord, YCoord, x, y);π if (d < 0) Thenπ inc(d, (4 * x) + 6)π elseπ Beginπ inc (d, 4 * (x - y) + 10);π dec (y);π End;π inc(x);π End;π If x = y thenπ Symmetry (XCoord, YCoord, x, y);πEnd;π{-[ Draw A Rectangle ]----------------------------------------------------}πProcedure Rectangle (X1, Y1, X2, Y2 : Word);πBeginπ { Draw Top Of Box }π Line (X1, Y1, X2, Y1);π { Draw Right Side Of Box }π Line (X2, Y1, X2, Y2);π { Draw Left Side Of Box }π Line (X1, Y1, X1, Y2);π { Draw Botton Of Box }π Line (X1, Y2, X2, Y2);πEnd;π{=[ Main Program ]========================================================}ππVar C : Word;π Key : Char;πBeginππ TextMode (C80);π TurnCursorOff;π SetCharWidthTo8;π SetDualFonts;π ClearGraphicsWindow;π TextColor(LightGray);π ClrScr;ππ SetGraphicsWindow (40, 0, White, Blue); {X, Y, Color, BGColor}ππ Writeln ('Graphics In Text Mode Example');π Writeln ('Programmed by David Dahl');π Writeln ('This is PUBLIC DOMAIN');π Writeln;π Writeln ('The graphics window to the right is');π Writeln ('made up of custom characters of the');π Writeln ('second font.');π Writeln;π Writeln ('There are four graphics primitives');π Writeln ('available in this example program.');π Writeln ('Circle, Line, PutPixel, and ');π Writeln ('Rectangle are avaiable for your own');π Writeln ('use.');π Writeln;ππ Randomize;π For C := 1 to 10 doπ Beginπ Line (Random(MaxX), Random(MaxY),π Random(MaxX), Random(MaxY));ππ Circle (Random(MaxX), Random(MaxY), Random(30));ππ Rectangle (Random(MaxX), Random(MaxY),π Random(MaxX), Random(MaxY));π End;ππ Writeln ('Press [RETURN] to exit.');π Readln;π TurnCursorOn;π TextMode (C80);πEnd.π 13 05-26-9407:31ALL SWAG SUPPORT TEAM Small Window Unit IMPORT 26 F╔ πunit windows;ππinterfaceπuses crt;ππprocedure sh;πprocedure sn;πprocedure Drawbox(x1,y1,x2,y2: byte);πprocedure PopWindow(x1,y1,x2,y2: byte);πprocedure CloseWindow;πprocedure Drawshadowbox(x1,y1,x2,y2: byte);πprocedure shh;πprocedure snn;ππconstπ color: boolean = true;ππtypeπ windowtype = recordπ x1,x2,y1,y2: byte;π scrsave: array[1..4096] of byte;π end;π scrarray= array[1..4096] of byte;π scrptr= ^scrarray;πconstπ screenbase: word =$B800;πvarπ numwindows: byte;π ws: array[1..3] of windowtype;π cursorpos: integer;π fileabs: array[1..20] of word;π searchdir: byte;π searchwild: string;π searchdate: string;π searchuploader: string;π searchsize: longint;π searchtext: string;π numindex: word;π sortprimary,sortsecondary: byte;π filelow: longint;π numentries: byte;ππprocedure textcolor(i: byte);πprocedure textbackground(i: byte);ππimplementationππprocedure Textcolor(i: byte);πbegin;π if color then crt.textcolor(i) else begin;π case i ofπ 0: crt.textcolor(0);π 7: crt.textcolor(7);π 11..15: crt.textcolor(15);π end;π end;πend;ππprocedure TextBackGround(i: byte);πbegin;π if color then crt.textbackground(i) else begin;π case i ofπ 0..6: crt.textbackground(0);π 7: crt.textbackground(7);π end;π end;πend;ππprocedure sh;πbegin;π if color then begin;π textcolor(blue);π textbackground(7);π end else begin;π textcolor(0);π textbackground(7);π end;πend;ππprocedure sn;πbegin;π textcolor(white);π textbackground(blue);πend;ππprocedure Drawbox(x1,y1,x2,y2: byte);πvarπ x,y: byte;πbegin;π gotoxy(x1,y1);π for x:=x1+1 to x2 do write('═');π gotoxy(x1,y2);π for x:=x1+1 to x2 do write('═');π for y:=y1+1 to y2-1 do begin;π gotoxy(x1,y);π write('│');π gotoxy(x2,y);π write('│');π end;π gotoxy(x1,y1);π write('╒');π gotoxy(x2,y1);π write('╕');π gotoxy(x1,y2);π write('╘');π gotoxy(x2,y2);π write('╛');πend;ππprocedure PopWindow(x1,y1,x2,y2: byte);πbegin;π inc(numwindows);π ws[numwindows].x1:=lo(windmin)+1;π ws[numwindows].x2:=lo(windmax)+1;π ws[numwindows].y1:=hi(windmin)+1;π ws[numwindows].y2:=hi(windmax)+1;π move(mem[screenbase:0000],ws[numwindows].scrsave,4096);π window(1,1,80,25);π drawbox(x1,y1,x2,y2);π window(x1+1,y1+1,x2-1,y2-1);πend;ππprocedure CloseWindow;πbegin;π move(ws[numwindows].scrsave,mem[screenbase:0000],4096);π window(ws[numwindows].x1,ws[numwindows].y1,ws[numwindows].x2,ws[numwindows].y2);π dec(numwindows);πend;ππprocedure Drawshadowbox(x1,y1,x2,y2: byte);πvarπ x,y: byte;πbegin;π textbackground(0);π textcolor(7);π gotoxy(x1,y1);π for x:=x1+1 to x2 do write('═');π gotoxy(x1,y2);π for x:=x1+1 to x2 do write('═');π for y:=y1+1 to y2-1 do begin;π gotoxy(x1,y);π write('│');π gotoxy(x2,y);π write('│');π end;π gotoxy(x1,y1);π write('╒');π gotoxy(x2,y1);π write('╕');π gotoxy(x1,y2);π write('╘');π gotoxy(x2,y2);π write('╛');π textcolor(7);π textbackground(0);π for y:=y1+1 to y2+1 do begin;π gotoxy(x2+1,y);π write(' ');π end;π for x:=x1+1 to x2+1 do begin;π gotoxy(x,y2+1);π write(' ');π end;πend;ππprocedure shh;πbegin;π textcolor(0);π textbackground(7);πend;ππprocedure snn;πbegin;π textcolor(7);π textbackground(0);πend;ππend.