DP Tool Club 16

home *** CD-ROM | disk | FTP | other *** search

/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / maj / swag / textwndw.swg < prev next >

Wrap

Text File | 1994-08-29 | 86KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00015 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. 14 08-24-9417:54ALL GRANT BEATTIE Complete WINDOW unit SWAG9408 K¥6≤ 181 F╔ UNIT Win; { Win.Pas }ππ{$S-}{$I-}{$R-}ππINTERFACEππUSES Crt, Cursor, FadeUnit;ππTYPEπ PTitleStr = ^TitleStr;π TitleStr = STRING [63];ππ PFrame = ^TFrame;π TFrame = ARRAY [1..8] OF CHAR;ππ TVertFrameChars = ARRAY [1..3] OF CHAR;ππ { Text color attr type }ππ PTextAttr = ^TTextAttr;π TTextAttr = BYTE;ππ { Window rectangle type }ππ PRect = ^TRect;π TRect = RECORDπ Left, Top, Right, Bottom : BYTEπ END;ππ PWinState = ^TWinState;π TWinState = RECORDπ WindMin,π WindMax : WORD;π WHEREX,π WHEREY : BYTE;π TextAttr : TTextAttrπ END;ππ PWinRec = ^TWinRec;π TWinRec = RECORDπ Next : PWinRec;π State : TWinState;π Title : PTitleStr;π TitleColor,π FrameColor : TTextAttr;π Size : WORD;π Buffer : POINTERπ END;ππ PWindowStruct = ^TWindowStruct;π TWindowStruct = RECORDπ Rect : TRect;π TitleColor,π FrameColor : TTextAttr;π Title : TitleStrπ END;ππCONSTπ None = '';ππ VertFrame : TVertFrameChars = '│║█';ππ { Display combination codes returned by the GetDisplay function }ππ gdNoDisplay = $00; { No display }π gdMono = $01; { Monochrome adapter w/ monochrome display }π gdCGA = $02; { CGA w/ color display }π gdEGA = $04; { EGA w/ color display }π gdEGAMono = $05; { EGA w/ monochrome display }π gdPGA = $06; { PGA w/ color display }π gdVGAMono = $07; { VGA w/ monochrome analog display }π gdVGA = $08; { VGA w/ color analog display }π gdMCGADig = $0A; { MCGA w/ digital color display }π gdMCGAMono = $0B; { MCGA w/ monochrome analog display }π gdMCGA = $0C; { MCGA w/ color analog display }π gdUnknown = $FF; { Unknown display type }ππ { Window frame classes }ππ SingleFrame : TFrame = '┌─┐││└─┘';π DoubleFrame : TFrame = '╔═╗║║╚═╝';π SingleDoubleFrame : TFrame = '╓─╖║║╙─╜';π DoubleSingleFrame : TFrame = '╒═╕││╘═╛';π BarFrame : TFrame = '█▀████▄█';ππ { Window frame constants }ππ frNone = 0; { Window has no frame }π frSingle = 1; { Window has single frame }π frSingleDouble = 2; { Window has single (horiz) and double (vert) frames }π frDouble = 3; { Window has double frame }π frDoubleSingle = 4; { Window has double (horiz) and single (vert) frames }π frBar = 5; { Window has a rectangular bar frame }ππ { Shadow color attributes }ππ winShadowAttr : TTextAttr = $07;ππ FontOpenReg : ARRAY [1..10] OF BYTE =π ($02, $04, $04, $07, $05, $00, $06, $04, $04, $02);π FontCloseReg : ARRAY [1..10] OF BYTE =π ($02, $03, $04, $03, $05, $10, $06, $0E, $04, $00);ππ FadeDelay = 10; { Fade screen delay time forπ SaveDosScreen and RestoreDosScreen functions }ππVARπ WinShadow : BOOLEAN;π WinCount : INTEGER;π TopWindow : PWinRec;π WinExplodeDelay, ScreenHeight, WinFrame : BYTE;π ScreenWidth : WORD;π Screen : POINTER;ππFUNCTION GetDisplay : BYTE;πPROCEDURE SetTextFont (VAR Font; StartChar, BytePerChar, CharCount : BYTE);πFUNCTION GetTextFont (FontCode : BYTE) : POINTER;πPROCEDURE WriteStr (X, Y : BYTE; S : STRING; Color : TTextAttr);πPROCEDURE WriteStrV (X, Y : BYTE; S : STRING; Color : TTextAttr);πPROCEDURE WriteChar (X, Y, Count : BYTE; Ch : CHAR; Color : TTextAttr);πPROCEDURE FillWin (Ch : CHAR; Color : TTextAttr);πPROCEDURE ReadWin (VAR Buf);πPROCEDURE WriteWin (VAR Buf);πFUNCTION WinSize : WORD;πPROCEDURE SaveWin (VAR W : TWinState);πPROCEDURE RestoreWin (VAR W : TWinState);πPROCEDURE GetFrame (FrameNum : BYTE; VAR Frame : TFrame);πPROCEDURE FrameWin (Title : TitleStr;π Frame : TFrame; TitleColor, FrameColor : TTextAttr);πPROCEDURE UnFrameWin;πFUNCTION ScrReadChar (X, Y : BYTE) : CHAR;πPROCEDURE ScrWriteChar (X, Y : BYTE; Ch : CHAR);πFUNCTION ScrReadAttr (X, Y : BYTE) : TTextAttr;πPROCEDURE ScrWriteAttr (X, Y : BYTE; Color : TTextAttr);πPROCEDURE WindowIndirect (Rect : TRect);πFUNCTION PtInRect (X, Y : BYTE; Rect : TRect) : BOOLEAN;πPROCEDURE GetWindowRect (VAR Rect : TRect);πPROCEDURE GetWindowRectExt (X1, Y1, X2, Y2 : BYTE; VAR Rect : TRect);πPROCEDURE ClearWin (X1, Y1, X2, Y2 : BYTE; Color : TTextAttr);πPROCEDURE ShadowWin (X1, Y1, X2, Y2 : BYTE);πPROCEDURE CreateWin (X1, Y1, X2, Y2 : BYTE;π TitleColor, FrameColor : TTextAttr; Title : TitleStr);πPROCEDURE CreateWinIndirect (WS : TWindowStruct);πFUNCTION OpenWin (X1, Y1, X2, Y2 : BYTE;π TitleColor, FrameColor : TTextAttr; Title : TitleStr) : BOOLEAN;πFUNCTION OpenWinIndirect (WS : TWindowStruct) : BOOLEAN;πFUNCTION CloseWin : BOOLEAN;πFUNCTION MoveWin (Left, Top : BYTE) : BOOLEAN;πFUNCTION SaveDOSScreen (UseFade, RestoreScreen : BOOLEAN) : BOOLEAN;πFUNCTION RestoreDOSScreen (UseFade : BOOLEAN) : BOOLEAN;πPROCEDURE SetBlink (BlinkOn : BOOLEAN);ππIMPLEMENTATIONππ{$L win.obj}ππVAR OldCursor : WORD;ππFUNCTION MakeWord (HI, LO : BYTE) : WORD; assembler;πAsmπ MOV AH, HIπ MOV AL, LOπEND; { MakeWord }ππFUNCTION GetDisplay; assembler;πAsmπMOV AX, 1A00hπ INT 10hπ MOV AL, BLπEND; { GetDisplay }ππPROCEDURE SetRegisters; near; assembler;πasmπ MOV AX, SEG @Dataπ MOV DS, AXπ MOV CX, 0002hπ MOV DX, 03C4hπ CALL @@1π MOV CX, 0003hπ MOV DL, 0CEhπ@@1 :π LODSBπ OUT DX, ALπINC DXπ LODSBπOUT DX, ALπ DEC DXπ LOOP @@1πEND; { SetRegisters }ππPROCEDURE SetTextFont; assembler;πAsmπ MOV BX, SegA000π PUSH DSπ MOV AX, WORD PTR [Font + 2]π MOV DS, AXπ XOR AX, AXπ MOV AL, StartCharπ MOV DI, AXπ MOV SI, WORD PTR [Font]π MOV AX, BXπ MOV BL, BytePerCharπXOR BH, BHπ PUSH ESπMOV ES, AXπ MOV CL, 5π SHL DI, CLπ PUSH SIπ PUSH DSπ CLIπ MOV SI, OFFSET FontOpenRegπ CALL SetRegistersπ POP DSπ POP SIπ MOV AX, DIπ@@1 :π MOV DI, AXπ MOV CX, BXπ REP MOVSBπ ADD AX, 0020hπ DEC CharCountπJNE @@1π MOV SI, OFFSET FontCloseRegπCALL SetRegistersπ STIπ POP ESπ POP DSπEND; { SetTextFont }ππFUNCTION GetTextFont; assembler;πAsmπ MOV AX, 1130hπ MOV BH, FontCodeπ INT 10hπ MOV AX, BPπ MOV DX, ESπEND; { GetTextFont }ππPROCEDURE WriteStr (X, Y : BYTE; S : STRING; Color : TTextAttr); EXTERNAL;ππPROCEDURE WriteStrV (X, Y : BYTE; S : STRING; Color : TTextAttr);πVAR Index : INTEGER;πBEGINπ FOR Index := 1 TO LENGTH (S) DOπ WriteChar (X, PRED (Y + Index), 1, S [Index], Color)πEND; { WriteStrV }ππPROCEDURE WriteChar (X, Y, Count : BYTE; Ch : CHAR; Color : TTextAttr);πEXTERNAL;ππPROCEDURE FillWin (Ch : CHAR; Color : TTextAttr); EXTERNAL;πPROCEDURE WriteWin (VAR Buf); EXTERNAL;πPROCEDURE ReadWin (VAR Buf); EXTERNAL;πFUNCTION WinSize : WORD; EXTERNAL;ππPROCEDURE SaveWin (VAR W : TWinState);πBEGINπ W.WindMin := WindMin;π W.WindMax := WindMax;πW.WHEREX := WHEREX;π W.WHEREY := WHEREY;πW.TextAttr := TextAttrπEND; { SaveWin }ππPROCEDURE RestoreWin (VAR W : TWinState);πBEGINπ WindMin := W.WindMin;π WindMax := W.WindMax;π GOTOXY (W.WHEREX, W.WHEREY);π TextAttr := W.TextAttrπEND; { RestoreWin }ππPROCEDURE GetFrame (FrameNum : BYTE; VAR Frame : TFrame);πBEGINπ CASE FrameNum OFπ frSingle : Frame := SingleFrame;π frDouble : Frame := DoubleFrame;π frSingleDouble : Frame := SingleDoubleFrame;πfrDoubleSingle : Frame := DoubleSingleFrame;π frBar : Frame := BarFrame;πELSE FILLCHAR (Frame, SIZEOF (Frame), BYTE ( - 1) )π ENDπEND; { GetFrame }ππPROCEDURE FrameWin (Title : TitleStr;π Frame : TFrame; TitleColor, FrameColor : TTextAttr);ππVAR W, H, Y : WORD;ππBEGINπW := LO (WindMax) - LO (WindMin) + 1;πH := HI (WindMax) - HI (WindMin) + 1;πWriteChar (1, 1, 1, Frame [1], FrameColor);πWriteChar (2, 1, W - 2, Frame [2], FrameColor);πWriteChar (W, 1, 1, Frame [3], FrameColor);πIF LENGTH (Title) > W - 2 THEN Title [0] := CHR (W - 2);πWriteStr ( (W - LENGTH (Title) ), 1, Title, TitleColor);ππFOR Y := 2 TO H - 1 DOπBEGINπWriteChar (1, Y, 1, Frame [4], FrameColor);π WriteChar (W, Y, 1, Frame [5], FrameColor)πEND;π WriteChar (1, H, 1, Frame [6], FrameColor);π WriteChar (2, H, W - 2, Frame [7], FrameColor);π WriteChar (W, H, 1, Frame [8], FrameColor);π INC (WindMin, $0101);π DEC (WindMax, $0101)πEND; { FrameWin }ππPROCEDURE UnFrameWin;πBEGINπ DEC (WindMin, $0101);π INC (WindMax, $0101)πEND; { UnFrameWin }ππFUNCTION ScrReadChar; assembler;πAsmπ LES DI, Screenπ XOR AH, AHπ MOV AL, YπDEC AXπ MUL ScreenWidthπ SHL AX, 1π XOR DH, DHπ MOV DL, Xπ SHL DX, 1π DEC DXπ DEC DXπ ADD AX, DXπ MOV DI, AXπ MOV AL, BYTE PTR [ES : DI]π {ScrReadChar := Char(Ptr(Seg(Screen^),π (Y - 1) * ScreenWidth * 2 + (X * 2) - 2)^)}πEND; { ScrReadChar }ππPROCEDURE ScrWriteChar; assembler;πAsmπ LES DI, Screenπ XOR AH, AHπMOV AL, Yπ DEC AXπ MUL ScreenWidthπ SHL AX, 1π XOR DH, DHπ MOV DL, Xπ SHL DX, 1π DEC DXπ DEC DXπ ADD AX, DXπ MOV DI, AXπ MOV AL, Chπ MOV BYTE PTR [ES : DI], ALπ {Char(Ptr(Seg(Screen^),π (Y - 1) * ScreenWidth * 2 + (X * 2) - 2)^) := Ch}πEND; { ScrWriteChar }ππFUNCTION ScrReadAttr; assembler;πAsmπLES DI, Screenπ XOR AH, AHπ MOV AL, Yπ DEC AXπ MUL ScreenWidthπ SHL AX, 1π XOR DH, DHπ MOV DL, Xπ SHL DX, 1π DEC DXπ ADD AX, DXπ MOV DI, AXπ MOV AL, BYTE PTR [ES : DI]π {ScrReadAttr := TTextAttr(Ptr(Seg(Screen^),π (Y - 1) * ScreenWidth * 2 + (X * 2) - 1)^)}πEND; { ScrReadAttr }ππPROCEDURE ScrWriteAttr; assembler;πAsmπLES DI, Screenπ XOR AH, AHπ MOV AL, Yπ DEC AXπ MUL ScreenWidthπ SHL AX, 1π XOR DH, DHπ MOV DL, Xπ SHL DX, 1π DEC DXπ ADD AX, DXπ MOV DI, AXπ MOV AL, Colorπ MOV BYTE PTR [ES : DI], ALπ {TTextAttr(Ptr(Seg(Screen^),π(Y - 1) * ScreenWidth * 2 + (X * 2) - 1)^) := Color}πEND; { ScrWriteAttr }ππPROCEDURE WindowIndirect (Rect : TRect);πBEGINπ WITH Rect DO WINDOW (Left, Top, Right, Bottom)πEND; { WindowIndirect }ππFUNCTION PtInRect (X, Y : BYTE; Rect : TRect) : BOOLEAN;πBEGINπ WITH Rect DOπ PtInRect := (X IN [Left..Right]) AND (Y IN [Top..Bottom])πEND; { PtInRect }ππPROCEDURE GetWindowRect (VAR Rect : TRect); assembler;πAsmπ LES DI, Rectπ MOV AX, WindMinπ MOV BX, WindMaxπINC ALπ INC AHπ INC BLπ INC BHπMOV [ES : DI] (TRect) .Left, ALπ MOV [ES : DI] (TRect) .Top, AHπ MOV [ES : DI] (TRect) .Right, BLπ MOV [ES : DI] (TRect) .Bottom, BHπEND; { GetWindowRect }ππPROCEDURE GetWindowRectExt (X1, Y1, X2, Y2 : BYTE; VAR Rect : TRect); assembler;πAsmπ LES DI, Rectπ MOV AL, X1π MOV AH, Y1π MOV BL, X2π MOV BH, Y2π MOV [ES : DI] (TRect) .Left, ALπ MOV [ES : DI] (TRect) .Right, BLπMOV [ES : DI] (TRect) .Top, AHπ MOV [ES : DI] (TRect) .Bottom, BHπEND; { GetWindowRectExt }ππPROCEDURE ClearWin (X1, Y1, X2, Y2 : BYTE; Color : TTextAttr); assembler;πAsmπ MOV AX, 0600hπ MOV BH, Colorπ MOV CL, X1π DEC CLπ MOV CH, Y1π DEC CHπ MOV DL, X2π DEC DLπ MOV DH, Y2π DEC DHπ INT 10hπEND; { ClearWin }ππPROCEDURE ShadowWin;πVAR P, I : BYTE;πBEGINπ I := Y2 + 1;πFOR P := X1 + 2 TO X2 + 2 DOπ ScrWriteAttr (P, I, ScrReadAttr (P, I) AND WinShadowAttr);π I := X2 + 1;π FOR P := Y1 + 1 TO Y2 + 1 DOπ BEGINπ ScrWriteAttr (I, P, ScrReadAttr (I, P) AND WinShadowAttr);π ScrWriteAttr (I + 1, P, ScrReadAttr (I + 1, P) AND WinShadowAttr)π ENDπEND; { ShadowWin }ππPROCEDURE CreateWin (X1, Y1, X2, Y2 : BYTE;π TitleColor, FrameColor : TTextAttr; Title : TitleStr);πVARπW, H : WORD;πDX, DY : BYTE;πF : TFrame;πBEGINπIF WinFrame <> frNone THENπBEGINπGetFrame (WinFrame, F);πIF WinExplodeDelay <> 0 THENπBEGINπDX := X1 + 2;πDY := Y1 + 2;πREPEATπIF WinShadow = TRUE THENπShadowWin (X1, Y1, DX, DY);πWINDOW (X1, Y1, DX, DY);πFrameWin (Title, F, TitleColor, FrameColor);πClearWin (X1 + 1, Y1 + 1, DX - 1, DY - 1, FrameColor);π IF DX < X2 THEN INC (DX, 2);π IF DX > X2 THEN DX := X2;πIF DY < Y2 THEN INC (DY);πDELAY (WinExplodeDelay)πUNTIL (DX = X2) AND (DY = Y2)πEND;πIF WinShadow = TRUE THEN ShadowWin (X1, Y1, X2, Y2);πWINDOW (X1, Y1, X2, Y2);πFrameWin (Title, F, TitleColor, FrameColor);πClearWin (SUCC (X1), SUCC (Y1), PRED (X2), PRED (Y2), FrameColor)π END;π WINDOW (X1, Y1, X2, Y2);π IF WinShadow THEN INC (WindMax, $0102)πEND; { CreateWin }ππPROCEDURE CreateWinIndirect;πBEGINπ WITH WS, WS.Rect DOπ CreateWin (Left, Top, Right, Bottom, TitleColor, FrameColor, Title)πEND; { CreateWinIndirect }ππFUNCTION OpenWin (X1, Y1, X2, Y2 : BYTE;π TitleColor, FrameColor : TTextAttr; Title : TitleStr) : BOOLEAN;πVAR W : PWinRec;πBEGINπ OpenWin := FALSE;π IF MAXAVAIL > SIZEOF (TWinRec) THENπBEGINπ NEW (W);π W^.Next := TopWindow;π SaveWin (W^.State);π IF MAXAVAIL > LENGTH (Title) + 1 THENπ BEGINπ GETMEM (W^.Title, LENGTH (Title) + 1);π W^.Title^ := Title;π W^.TitleColor := TitleColor;π W^.FrameColor := FrameColor;π WINDOW (X1, Y1, X2, Y2);π IF WinShadow = TRUE THEN INC (WindMax, $0102);π IF MAXAVAIL > WinSize THENπ BEGINπW^.Size := WinSize;πGETMEM (W^.Buffer, W^.Size);πReadWin (W^.Buffer^);πCreateWin (X1, Y1, X2, Y2, TitleColor, FrameColor, Title);π TopWindow := W;πINC (WinCount);πOpenWin := TRUEπ ENDπ ENDπ ENDπEND; { OpenWin }ππFUNCTION OpenWinIndirect;πBEGINπ WITH WS, WS.Rect DO OpenWinIndirect := OpenWin (Left,π Top, Right, Bottom, TitleColor, FrameColor, Title)πEND; { OpenWinIndirect }ππFUNCTION CloseWin : BOOLEAN;πVAR W : PWinRec;πBEGINπ CloseWin := FALSE;π IF Assigned (TopWindow) AND (WinCount > 0) THENπ BEGINπW := TopWindow;π WITH W^ DOπ BEGINπ WriteWin (Buffer^);π FREEMEM (Buffer, W^.Size);π FREEMEM (Title, LENGTH (Title^) + 1);π RestoreWin (State);π TopWindow := Nextπ END;π DISPOSE (W);π DEC (WinCount);π CloseWin := TRUEπ ENDπEND; { CloseWin }ππFUNCTION MoveWin;πVAR W : PWinRec;πBEGINπ MoveWin := FALSE;πIF (MAXAVAIL > SIZEOF (TWinRec) ) AND Assigned (TopWindow) THENπ BEGINπ NEW (W);π IF MAXAVAIL > WinSize THENπ BEGINπ SaveWin (W^.State);π W^.State.WindMin := MakeWord (Top, Left) - $0101;π W^.State.WindMax := W^.State.WindMin + WindMax - WindMin;ππ IF WinShadow THEN DEC (WindMax, $0102);π W^.Size := WinSize;ππ GETMEM (W^.Buffer, W^.Size);π ReadWin (W^.Buffer^);ππIF WinShadow THEN INC (WindMax, $0102);π WriteWin (TopWindow^.Buffer^);ππ RestoreWin (W^.State);πReadWin (TopWindow^.Buffer^);ππ IF WinShadow THEN DEC (WindMax, $0102);π WriteWin (W^.Buffer^);π IF WinShadow THENπ BEGINπShadowWin (Left, Top, SUCC (LO (WindMax) ), SUCC (HI (WindMax) ) );πINC (WindMax, $0102)π END;π FREEMEM (W^.Buffer, W^.Size);π MoveWin := TRUEπ END;π DISPOSE (W)π ENDπEND; { MoveWin }ππFUNCTION SaveDOSScreen;πBEGINπ IF NOT GetDisplay IN [gdEGA..gdMCGA] THEN UseFade := FALSE;ππ OldCursor := GetCursorType;π SetCursor (CursorOff);ππ IF UseFade THEN FadeOut (FadeDelay);ππ asmπ PUSH WORD PTR [WinShadow]π MOV WinShadow, FALSEπ END;ππ SaveDOSScreen := OpenWin (1, 1,π ScreenWidth, ScreenHeight, Black, Black, None);ππ asmπPOP WORD PTR [WinShadow]π END;ππ IF RestoreScreen THEN WriteWin (TopWindow^.Buffer^);ππ IF UseFade THEN FadeIn (0)ππEND; { SaveDOSScreen }ππFUNCTION RestoreDOSScreen;πBEGINπ IF NOT GetDisplay IN [gdEGA..gdMCGA] THEN UseFade := FALSE;ππ WINDOW (1, 1, ScreenWidth, ScreenHeight);π asmπ MOV WinShadow, FALSEπ END;π IF UseFade THEN SetBrightness (0);π RestoreDOSScreen := CloseWin;ππ IF UseFade THEN FadeIn (FadeDelay);ππ SetCursorType (OldCursor);πSetCursor (CursorOn)πEND; { RestoreDOSScreen }ππPROCEDURE SetBlink (BlinkOn : BOOLEAN);πCONST PortVal : ARRAY [0..4] OF BYTE = ($0C, $08, $0D, $09, $09);πVARπ PortNum : WORD;π Index, PVal : BYTE;πBEGINπ IF LastMode = Mono THENπ BEGINπ PortNum := $3B8;π Index := 4π END ELSEπ IF GetDisplay IN [gdEGA..gdMCGA] THENπBEGINπ INLINE (π$8A / $5E / < BlinkOn / { MOV BL, [BP+<BlinkOn] }π$B8 / $03 / $10 / { MOV AX, $1003 }π$CD / $10); { MOV $10 }π EXITπ END ELSEπ BEGINπPortNum := $3D8;πCASE LastMode OFπ 0..3 : Index := LastMode;π ELSE EXITπENDπ END;π PVal := PortVal [Index];π IF BlinkOn THENπ PVal := PVal OR $20;π Port [PortNum] := PValπEND; { SetBlink }ππFUNCTION HeapFunc (Size : WORD) : INTEGER; far; assembler;πAsmπ MOV AX, 1πEND; { HeapFunc }ππBEGINπ HeapError := @HeapFunc;π WinCount := 0;π WinShadow := TRUE;π WinFrame := frSingle;π WinExplodeDelay := 10; { set no explode }π TopWindow := NIL;π IF LastMode = Mono THENπ Screen := PTR (SegB000, 0) ELSEπ BEGINπ Screen := PTR (SegB800, 0);π IF (LastMode AND Font8x8) <> 0 THENπScreenHeight := Mem [Seg0040 : $0084] ELSE ScreenHeight := 25πEND;πScreenWidth := MemW [Seg0040 : $004A];πInitCol; { Save original palette }πSetBlink (TRUE) { Set blinking }πEND. { Win.Pas }ππ{-------------------------------- XX3402 CODE ---------------------}π{ CUT OUT THE FOLLOWING AND USE XX3402 TO DECODE TO OBTAIN WIN.OBJ }ππ* XX3402 - 000678 - 090894 - - 72 - - 85 - 53801 - - - - - - - - - WIN.OBJ - - 1 - OF - - 1πU + Y + - rRdPWt - IooHW0 + + + + + QJ5JmMawUELBnNKpWP4Jm60 - KNL7nOKxi61AiAda61k - + uTBNπ0Fo5RqZi9Y3HHKe6 + k - + uImK + U + + O6U1 + 20VZ7M4 + + F2EJF - FdU5 + 2U + + + 6 - + FKK - U + 2Eox2πFIKM - k + cEE21 + E5mX - s + 0IB6FIB9IotDJk + 5JoZCF2p7HU + 5JoZCF2p - K + - gY + w + + + 66Jp77πJ2JLGIsh + + 0lY + s + + + 65FYZAH3R7HWA + + 04E2 + + + + UZLIYZIFIB6EJ6H + + 0NY + w + + + 66Jp77πJ2JHJ36 + + + 1HY + s + + + 65JoZCIoZOFH6 - + DqE1U + + + URGFI32JoZC8 + + + 7sU2 + 20W + N4UFE20π+ + - JWyn2LUUaWUyyJE1ckE - RmUc + JMjgWYs8jbg + u92 + LQc8 + 9tv + Cg6jdc + ukCyeU - JWyknπmMgK + + 081U + + 8gd - IJ7Ku9o + LZdNzgMuBU2 + RixRmUE + 5cda - gJq02Nm3em9qCmc + LLvyimcπ+ LHvWwCfyy9g5wCgey9w5wC8FUW8NUNm36jMv8U - RTjuv8U - RDi9kujvsiz1wuj15UMTWzT2πTUPc2E07TUMTklv3RUPc - E07RUMTkr6JfMjMv8U - RTjuv8U - RDi9kujvsin1wuL1WZMCzgc0π3U + + QZMu3U + + Rp08RUnynU6q + E - mFHcq + E - rDn9hsniU + + + ekjv + CgVm + cf6i2 + + Xg08lWPqπ7Yc + AjM1kh5UWzWs + 9UaU1t7 + + Rp + fGkXg0uqUDwU1s + + + 5ztgCV + + + f - U + + - E2 - xiHFsAjaπb2k + l + dI + gEOJ + 9273E0l0ZI + gEiJ + 92BkM - + gEv - U21l2o4 + ED2pkM - + gHR - U21lCU4 + E92πvUM - + wHr - U21lGk4 + E53AkM - + wIr - U20Gcc0 + + - oπ* * * * * END OF BLOCK 1 * * * * *πππ{-------------------------------- ASSEMBLY CODE ---------------------}π{ COMPILE THE FOLLOWING WITH TASM }ππ; {*** WIN.ASM ***}ππ TITLE WINππ LOCALS @@π P286ππ; Coordinate RECORDππX EQU (BYTE PTR 0)πY EQU (BYTE PTR 1)ππ; BIOS workspace equatesππCrtMode EQU (BYTE PTR 49H)πCrtWidth EQU (BYTE PTR 4AH)ππDATA SEGMENT WORD PUBLICππ; Externals from CRT UNITππ EXTRN CheckSnow : BYTE, WindMin : WORD, WindMax : WORDππDATA ENDSππCODE SEGMENT BYTE PUBLICππ ASSUME CS : CODE, DS : DATAππ; PROCEDURE WriteStr (X, Y : BYTE; S : STRING; Attr : BYTE);ππ PUBLIC WriteStrππWriteStr :ππ PUSH BPπMOV BP, SPπ LES BX, [BP + 8]π MOV CL, ES : [BX]π MOV SI, OFFSET CS : CrtWriteStrπ CALL CrtWriteπ POP BPπ RETF 10ππ; PROCEDURE WriteChar (X, Y, Count : BYTE; Ch : CHAR; Attr : BYTE);ππ PUBLIC WriteCharππWriteChar :ππ PUSH BPπ MOV BP, SPπ MOV CL, [BP + 10]π MOV SI, OFFSET CS : CrtWriteCharπCALL CrtWriteπ POP BPπ RETF 10ππ; PROCEDURE FillWin (Ch : CHAR; Attr : BYTE);ππ PUBLIC FillWinππFillWin :ππ MOV SI, OFFSET CS : CrtWriteCharπ JMP SHORT CommonWinππ; PROCEDURE ReadWin (VAR Buf);ππ PUBLIC ReadWinππReadWin :ππ MOV SI, OFFSET CS : CrtReadWinπ JMP SHORT CommonWinππ; PROCEDURE WriteWin (VAR Buf);ππ PUBLIC WriteWinππWriteWin :ππ MOV SI, OFFSET CS : CrtWriteWinππ; Common FillWin / ReadWin / WriteWin routineππCommonWin :ππ PUSH BPπ MOV BP, SPπXOR CX, CXπ MOV DX, WindMinπ MOV CL, WindMax.Xπ SUB CL, DLπ INC CXπ@@1 : PUSH CXπ PUSH DXπ PUSH SIπ CALL CrtBlockπ POP SIπ POP DXπ POP CXπ INC DHπ CMP DH, WindMax.Yπ JBE @@1π POP BPπ RETF 4ππ; WRITE STRING TO screenππCrtWriteStr :ππ PUSH DSπ MOV AH, [BP + 6]π LDS SI, [BP + 8]π INC SIπ JC @@4π@@1 : LODSBπ MOV BX, AXπ@@2 : IN AL, DXπ TEST AL, 1π JNE @@2π CLIπ@@3 : IN AL, DXπ TEST AL, 1π JE @@3πMOV AX, BXπ STOSWπ STIπ LOOP @@1π POP DSπ RETπ@@4 : LODSBπ STOSWπ LOOP @@4π POP DSπ RETππ; WRITE characters TO screenππCrtWriteChar :ππ MOV AL, [BP + 8]π MOV AH, [BP + 6]πJC @@4π MOV BX, AXπ@@1 : IN AL, DXπ TEST AL, 1π JNE @@1π CLIπ@@2 : IN AL, DXπ TEST AL, 1π JE @@2π MOV AX, BXπ STOSWπ STIπ LOOP @@1π RETπ@@4 : REP STOSWπ RETππ; READ WINDOW buffer from screenππCrtReadWin :ππ PUSH DSπ PUSH ESπ POP DSπ MOV SI, DIπ LES DI, [BP + 6]π CALL CrtCopyWinπ MOV [BP + 6], DIπ POP DSπ RETππ; WRITE WINDOW buffer TO screenππCrtWriteWin :ππ PUSH DSπLDS SI, [BP + 6]π CALL CrtCopyWinπ MOV [BP + 6], SIπ POP DSπ RETππ; WINDOW buffer COPY routineππCrtCopyWin :ππ JC @@4π@@1 : LODSWπ MOV BX, AXπ@@2 : IN AL, DXπ TEST AL, 1π JNE @@2π CLIπ@@3 : IN AL, DXπTEST AL, 1π JE @@3π MOV AX, BXπ STOSWπ STIπ LOOP @@1π RETπ@@4 : REP MOVSWπ RETππ; DO screen operationπ; IN CL = Buffer LENGTHπ; SI = WRITE PROCEDURE POINTERπ; BP = Stack frame POINTERππCrtWrite :ππ MOV DL, [BP + 14]πDEC DLπ ADD DL, WindMin.Xπ JC CrtExitπ CMP DL, WindMax.Xπ JA CrtExitπ MOV DH, [BP + 12]π DEC DHπ ADD DH, WindMin.Yπ JC CrtExitπ CMP DH, WindMax.Yπ JA CrtExitπ XOR CH, CHπ JCXZ CrtExitπ MOV AL, WindMax.Xπ SUB AL, DLπ INC ALπ CMP CL, ALπ JB CrtBlockπMOV CL, ALππ; DO screen operationπ; IN CL = Buffer LENGTHπ; DX = CRT coordinatesπ; SI = PROCEDURE POINTERππCrtBlock :ππ MOV AX, 40Hπ MOV ES, AXπ MOV AL, DHπ MUL ES : CrtWidthπ XOR DH, DHπ ADD AX, DXπ SHL AX, 1π MOV DI, AXπ MOV AX, 0B800HπCMP ES : CrtMode, 7π JNE @@1π MOV AH, 0B0Hπ@@1 : MOV ES, AXπ MOV DX, 03DAHπ CLDπ CMP CheckSnow, 1π JMP SIππ; EXIT from screen operationππCrtExit :ππ RETππ; FUNCTION WinSize : WORD;ππ PUBLIC WinSizeππWinSize :ππMOV AX, WindMaxπSUB AX, WindMinπADD AX, 101HπMUL AHπSHL AX, 1πRETFππCODE ENDSππENDπππ 15 08-24-9417:55ALL JENS LARSSON FAST Windowing Routines SWAG9408 å└φ┼ 62 F╔ {πOk, here comes my window routines. They should be quite fast, and hopefullyπnot too hard to understand. No range-checking on the screen coordinates isπdone (I don't think it's necessary).ππThe ColorAttr variable is the color-attribute :-). It's used as in theπvideomemory. If you want to call the procedure with a separate foregroundπand background color (why?), drop me a note and I'll fix it if you can'tπdo it yourself.ππIt'll run on a 8086, and I don't want copies optimized with 286 code!ππ(if this message gets chopped for you -- too bad. Get it from a friend orπtell someone to upload it to a BBS in the US if you want it. Use goodπmailing software!)ππ--------------------------------------------------->8-------------------------ππ{ Window routines by Jens Larsson (Fido address, 2:201/2120.3), Sweden, PD. }π{ Feel free to use it in your own programs. But do credit me, will you? :-) }π{ Put it in SWAG if you like... }ππ{$M 1024,0,0}πUses Crt;ππ{ The following variable should be assigned at startup to the correct segment }π{ address (b800h or b000h). I've posted a source for doing this before, thus }π{ it's not included here. }ππ Const TextVidSeg : Word = $b800;ππ Var ScrBuf, Pdwns : Word;ππ Function AllocMemory(Paragraphs : Word) : Word; Assembler;π Asmπ mov ax,4800hπ mov bx,Paragraphs { Number of 16-byte chunks }π int 21hπ jnc @Done { Ok? }π mov ax,4c00hπ int 21h { If not, halt program! }π@Done:π End;ππ Procedure PullDown(x1, y1, x2, y2 : Word;π FrameType,π ColorAttr : Byte;π PDName : String); Assembler;ππ Var DeltaX, DeltaY, AddDI : Word;ππ Asmπ jmp @CodeBegin { Jump to the actual code }ππ{ Ok Pascal-lovers... I'm sorry, but I declared the data like below... }π{ Somehow it seemed easier to me (I guess I've used assembler too much) }ππ@Frame:ππ{ This is all the ASCII codes for all the possible types of frames }ππ db 020h,020h,020h,020h,020h,020h { ' ' }π db 0dah,0c4h,0bfh,0b3h,0c0h,0d9h { '┌─┐│└┘' }π db 0c9h,0cdh,0bbh,0bah,0c8h,0bch { '╔═╗║╚╝' }π db 0d6h,0c4h,0b7h,0bah,0d3h,0bdh { '╓─╖║╙╜' }π db 0d5h,0cdh,0b8h,0b3h,0d4h,0beh { '╒═╕│╘╛' }ππ@FrameOfs:ππ{ And this is the offsets to the above structures }ππ db 000h,006h,00ch,012h,018hππ@CodeBegin:π cmp Pdwns,16 { Max pulldowns = 16 (16 * 4096 = 65536) }π jz @Doneππ cldππ{ Calculate start offset }ππ mov di,y1π dec diπ mov ax,diπ mov cl,5π shl di,clπ mov cl,7π shl ax,clπ add di,axπ mov ax,x1π dec axπ add ax,axπ add di,axππ mov dx,diπ add dx,4 { This is the offset for the PutName part later }ππ mov ax,x2π sub ax,x1π dec axπ mov DeltaX,axπ add ax,2π mov bx,80π sub bx,axπ sub bx,2π add bx,bxπ mov AddDI,bxπ mov ax,y2π sub ax,y1π dec axπ mov DeltaY,axππ push dsπ push diππ mov si,diπ mov di,Pdwnsπ mov cl,12π shl di,cl { Calculate offset in save segment }π mov es,ScrBuf { Save segment -> ES }π mov ds,TextVidSegπ mov es:[di],si { Store offset to screen }π mov bx,DeltaXπ add bx,4π mov es:[di+2],bx { Store DeltaX }π mov cx,DeltaYπ add cx,3π mov es:[di+4],cx { Store DeltaY }π mov ax,AddDIπ mov es:[di+6],ax { Store AddDI }π add di,8π@SaveScreen:π push cxπ mov cx,bxπ rep movsw { Save line }π add si,axπ pop cxπ dec cxπ jnz @SaveScreenππ pop diπ pop dsππ mov es,TextVidSegππ xor bh,bhπ mov bl,FrameTypeπ lea si,@FrameOfsπ add si,bxπ mov bl,cs:[si] { Get offset within frame data }π lea si,@Frameπ add si,bx { SI points to frame }ππ mov ah,ColorAttrπ mov al,cs:[si]π stosw { Print upper-left corner }π mov al,cs:[si+1]π mov cx,DeltaXπ rep stosw { Print horisontal line }π mov al,cs:[si+2]π stosw { Print upper-right corner }π add di,AddDIπ add di,4ππ push dsππ xchg dx,di { Save DI }π mov bx,si { Save SI }π lds si,PDNameπ mov cl,[si] { Get length of string }π xor ch,chπ mov ah,ColorAttrπ inc siπ@PutName:π lodsb { Get next char }π stosw { Print next name-char }π dec cxπ jnz @PutNameπ mov di,dxπ mov si,bxππ pop dsππ mov cx,DeltaYπ@PutWindow:π push cxπ mov al,cs:[si+3] { Get horisontal-line char }π stosw { Print... }π mov al,20hπ mov cx,DeltaXπ rep stosw { Print some spaces }π mov al,cs:[si+3]π stoswπ mov al,08h { Shadow attribute (Bkgr = 0 Frgr = 8) }π inc diπ stosb { Print first shaded char... }π inc diπ stosb { ... and second }π add di,AddDIπ pop cxπ dec cxπ jnz @PutWindowππ mov al,cs:[si+4]π stosw { Print lower-left corner }π mov al,cs:[si+1]π mov cx,DeltaXπ rep stoswπ mov al,cs:[si+5]π stosw { Print lower-right corner }π mov al,08hπ inc diπ stosbπ inc diπ stosbπ add di,AddDIπ add di,5ππ mov cx,DeltaXπ add cx,2π@PutLastShadowLine:π stosbπ inc diπ dec cxπ jnz @PutLastShadowLineππ inc Pdwnsπ@Done:π End;ππ Procedure RestoreScreen; Assembler;π Asmπ cmp Pdwns,0 { If no pulldowns then exit }π jz @Doneπ cldπ dec Pdwnsπ mov si,Pdwnsπ mov es,TextVidSegπ push dsπ mov ds,ScrBufπ mov cl,12π shl si,clπ mov di,[si] { Load offset to screen }π mov bx,[si+2] { Load DeltaX }π mov cx,[si+4] { ... DeltaY }π mov dx,[si+6] { ... AddDI }π add si,8π@PutText:π push cxπ mov cx,bxπ rep movsw { Restore line }π add di,dxπ pop cxπ dec cxπ jnz @PutTextπ pop dsπ@Done:π End;ππ{ Short example program }ππ Beginπ ScrBuf := AllocMemory(4096);π TextBackground(4);π ClrScr;π PullDown(10,5,70,20,1,$1f,' Window #1 ');π ReadKey;π PullDown(5,10,60,22,2,$4e,' Window #2 ');π ReadKey;π RestoreScreen;π ReadKey;π RestoreScreen;π End.ππ