📄 vga256.pas
字号:
add si, ax { SI = (YPos * 80) + XPos / 4 }
add si, cx
les di, BitMap { Point to bitmap }
and bl, 3
sub bl, 4
mov cx, 4 { 4 planes }
@Plane:
push bx
push cx { Planes to go }
mov ah, bl
and ah, 3
mov al, READ_MAP
mov dx, GC_INDEX
out dx, ax
cld
push si
mov bx, Width
shr bx, 1
shr bx, 1
mov ax, BYTES_PER_LINE
sub ax, bx { Space before next line }
mov dx, Height
@Line:
mov cx, bx
shr cx, 1
rep movsw
rcl cx, 1
rep movsb
add si, ax
dec dx
jnz @Line
pop si
pop cx { Planes }
pop bx
inc bl { Still in the same byte? }
adc si, 0
loop @Plane
pop es
pop ds
end;
end;
procedure Fill (X, Y, W, H: Integer; Attr: Integer);
{ Fills an area on the screen with Attr }
begin
asm
mov ax, VGA_SEGMENT
mov es, ax
cld
mov dx, Y
mov ax, BYTES_PER_LINE
mul dx
mov di, X
push di
shr di, 1
shr di, 1
add di, ax { DI = Y * (width / 4) + X / 4 }
add di, PageOffset
pop cx
and cx, 3 { CX = X mod 4 }
mov ah, 0Fh
shl ah, cl
and ah, 0Fh
mov si, H
or si, si
jz @End { Height 0 }
mov bh, byte ptr Attr
mov dx, W
or dx, dx
jz @End { Width 0 }
add cx, dx
mov dx, SC_INDEX
mov al, MAP_MASK
sub cx, 4
jc @2
test cl, 3h
jnz @0
sub cx, 4
@0: jc @2
out dx, ax
mov al, bh { Attr }
push si { Height }
push di
@4: stosb { Left vertical line }
add di, BYTES_PER_LINE - 1
dec si
jnz @4
pop di
inc di
pop si
push ax
mov ax, 0F00h + MAP_MASK
out dx, ax
pop ax
mov ah, al { Attr }
push cx { Width }
shr cx, 1
shr cx, 1
push si { Height }
push di
@5: push di
push cx
shr cx, 1
rep stosw { Fill middle part }
rcl cx, 1
rep stosb
pop cx
pop di
add di, BYTES_PER_LINE
dec si
jnz @5
pop di
add di, cx { Point to last strip }
pop si { Height }
pop cx { Width }
mov bh, al { Attr }
mov bl, 0Fh { Mask }
jmp @3
@2: mov bl, ah { Begin and end in one single byte }
@3: and cl, 3
mov ah, 0
@1: shl ah, 1
add ah, 1
dec cl
jnz @1
and ah, bl { Use both masks }
mov al, MAP_MASK
out dx, ax
mov al, bh { Attr }
@6: stosb { Draw right vertical line }
add di, BYTES_PER_LINE - 1
dec si
jnz @6
@End:
end;
end;
procedure SetPalette (Color, Red, Green, Blue: Byte);
begin
asm
mov dx, 03C8h { DAC Write Address Register }
mov al, Color
out dx, al
inc dx
mov al, Red
out dx, al
mov al, Green
out dx, al
mov al, Blue
out dx, al
end;
end;
procedure ReadPalette (var NewPalette);
{ Read whole palette }
begin
asm
push ds
lds si, NewPalette
mov dx, 3C8h { VGA pel address }
mov al, 0
cli
cld
out dx, al
inc dx
mov cx, 3 * 100h
@1: lodsb
out dx, al
dec cx
jnz @1
sti
pop ds
{ push es
push bp
mov ax, 1012h
xor bx, bx
mov cx, 256
les dx, NewPalette
int 10h
pop bp
pop es }
end;
end;
procedure ClearPalette; assembler;
asm
cli
mov dx, 3C8h { VGA pel address }
mov al, 0
out dx, al
inc dx
mov cx, 3 * 100h
@1: out dx, al
dec cx
jnz @1
sti
end;
function CurrentPage: Integer;
begin
CurrentPage := Page;
end;
function GetPageOffset: Word;
begin
GetPageOffset := PageOffset;
end;
procedure ResetStack;
begin
Stack[0] := PAGE_0 + PAGE_SIZE + SAFE;
Stack[1] := PAGE_1 + PAGE_SIZE + SAFE;
end;
function PushBackGr (X, Y, W, H: Integer): Word;
{ Save background (X mod 4 = 0, W mod 4 = 0) }
var
StackPointer: Word;
begin
PushBackGr := 0;
if not ((Y + H >= 0) and (Y < 200)) then
Exit;
StackPointer := Stack [Page];
asm
mov bx, PageOffset
mov di, StackPointer
push ds
push es
mov ax, VGA_SEGMENT
mov ds, ax
mov es, ax
cld
mov dx, SC_INDEX
mov ax, 0100h + MAP_MASK
out dx, ax
mov ax, X
mov [di], ax
mov ax, 0200h + MAP_MASK
out dx, ax
mov ax, Y
mov [di], ax
mov ax, 0400h + MAP_MASK
out dx, ax
mov ax, W
mov [di], ax
mov ax, 0800h + MAP_MASK
out dx, ax
mov ax, H
stosw
mov al, 'M'
stosb
mov dx, GC_INDEX
mov al, GRAPHICS_MODE
out dx, al
inc dx
in al, dx
push ax
mov al, 41h
out dx, al
mov dx, SC_INDEX
mov ax, 0F00h + MAP_MASK
out dx, ax
mov ax, READ_MAP
mov dx, GC_INDEX
out dx, ax
mov dx, Y
mov ax, BYTES_PER_LINE
mul dx
mov si, X
shr si, 1
shr si, 1
add si, ax
add si, bx
mov cx, W
shr cx, 1
shr cx, 1
mov bx, H
@1: push cx
rep
movsb { copy 4 pixels }
pop cx
add si, BYTES_PER_LINE
sub si, cx
dec bx
jnz @1
mov dx, GC_INDEX
pop ax
mov ah, al
mov al, GRAPHICS_MODE
out dx, ax
pop es
pop ds
end;
PushBackGr := Stack [Page];
Inc (Stack [Page], W * H + 8);
end;
procedure PopBackGr (Address: Word);
var
X, Y, W, H: Integer;
begin
if Address = 0 then
Exit;
asm
mov bx, PageOffset
mov si, Address
push ds
push es
mov ax, VGA_SEGMENT
mov ds, ax
mov es, ax
cld
mov dx, GC_INDEX
mov ax, 0000h + READ_MAP
out dx, ax
mov ax, [si]
mov X, ax
mov ax, 0100h + READ_MAP
out dx, ax
mov ax, [si]
mov Y, ax
mov ax, 0200h + READ_MAP
out dx, ax
mov ax, [si]
mov W, ax
mov ax, 0300h + READ_MAP
out dx, ax
lodsw
mov H, ax
lodsb
cmp al, 'M'
jz @@1
{$IFDEF DEBUG}
int 3
{$ENDIF}
jmp @End
@@1:
mov dx, GC_INDEX
mov al, GRAPHICS_MODE
out dx, al
inc dx
in al, dx
push ax
mov al, 41h
out dx, al
mov dx, SC_INDEX
mov ax, 0F00h + MAP_MASK
out dx, ax
mov ax, READ_MAP
mov dx, GC_INDEX
out dx, ax
mov dx, Y
mov ax, BYTES_PER_LINE
mul dx
mov di, X
shr di, 1
shr di, 1
add di, ax
add di, bx
mov cx, W
shr cx, 1
shr cx, 1
mov bx, H
@1: push cx
rep
movsb { copy 4 pixels }
pop cx
add di, BYTES_PER_LINE
sub di, cx
dec bx
jnz @1
mov dx, GC_INDEX
pop ax
mov ah, al
mov al, GRAPHICS_MODE
out dx, ax
@end: pop es
pop ds
end;
end;
procedure DrawBitmap (X, Y: Integer; var BitMap; Attr: Byte);
{ Bitmap starts with size W, H (Byte) }
var
W, H, PageOffset: Integer;
begin
PageOffset := GetPageOffset;
asm
push es
push ds
lds si, BitMap
mov ah, 0
cld
lodsb
mov W, ax
lodsb
mov H, ax
mov ax, VGA_SEGMENT
mov es, ax
mov bl, 0
mov cx, H
mov dx, Y
@1: push cx
mov cx, X
mov di, W
@2: push cx
push dx
or bl, bl
jnz @3
lodsb
mov bh, al
mov bl, 8
@3: dec bl
shr bh, 1
jnc @4
push si
push di
push bx
mov al, Attr
@PutPixel:
{ CX = X, DX = Y, AL = Attr }
push ax
mov ax, BYTES_PER_LINE
mul dx
push cx
shr cx, 1
shr cx, 1
add ax, cx
mov di, ax
add di, PageOffset
pop cx
and cl, 3
mov ah, 1
shl ah, cl
mov al, MAP_MASK
mov dx, SC_INDEX
out dx, ax
pop ax
stosb
pop bx
pop di
pop si
@4:
pop dx
pop cx
inc cx
dec di
jnz @2
inc dx
pop cx
dec cx
jnz @1
pop ds
pop es
end;
end;
begin
OldScreenMode := GetMode;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -