Пользователь
Сообщения: 95
Благодарности: 0
|
Профиль
|
Сайт
|
Отправить PM
| Цитировать
Предложение, если у кого то есть старые исходники - кинуть сюда, вместе посмеемся :-) сейчас я маленький кусочек найду :-)
вот основная программа
Цитата:
Uses Crt,key,GraphLib;
Var x,s,y: LongInt;
Time : LongInt;
Timer : LongInt absolute $40:$6c;
Procedure movelka;
Begin
s:=1;
x:=150;
y:=100;
Repeat
Time:=Timer;
Repeat Until Timer-Time>1;
ClrVid2(0);
PrintD('“ç¨ *áª*«ì - ®â®¬áâ¨èì!  ',1,1,3);
ShowPicTransD(x,y,s);
ShowDouble;
If pressed [scLeft] then
Begin
dec(x,4);
inc(s);
if s>2 then s:=1;
End else
If pressed [scRight] then
Begin
inc(x,4);
inc(s);
if s>2 then s:=1;
End else s:=1;
Until pressed [scEsc];
End;
BEGIN
GrInit;
Install_Handler;
ClrVid2(0);
ReadPicture('1.img');
ReadPicture('2.img');
TrCol:=$FF;
movelka;
GrDone;
Restore_Handler;
END.
|
и сама библиотека графическая:
Цитата:
Unit GraphLib;
{$L rus}
{$L mouse}
Interface
Uses Dos;
Type TPalette = Array[0..255] of record R,G,B : Byte; End; { *«¨âà* }
Const
VGA256 = $13;
TextMode = 3;
PalMask = $36C;
PalRegR = $3C7;
PalRegW = $3C8;
PalData = $3C9;
fcFriend = 15;
fcEnemy = 40;
colGreen = 28;
colYellow = 8;
colRed = 40;
fr=0;
en=64;
FadeSpeed : LongInt = 20; { ‘ª®à®áâì £*è¥*¨ï/¯à®ï¢«¥*¨ï íªà*** }
Type TVidBuf = Array[1..65100] of Byte;
TSpr = Array[0..15,0..15] of byte;
TFont = Array[128..239,1..8] of byte;
TMouseBuf = Array[1..16,1..16] of byte;
Var SegDB : Word;
GetBack : Byte;
Fnt : ^TFont;
Int1CSave : Pointer;
MouseVis : Boolean;
MouseX,MouseY : Integer;
MouseBuf : ^TMouseBuf;
MouseFile : File of TSpr;
MouseSpr : ^TSpr;
DoubleBuf : ^TVidBuf;
FrameColor : Byte;
Pic : Array[1..100] of record
W,H : Word;
Spr : Pointer;
End;
LastP : Integer;
TrCol : Byte;
Pal : TPalette;
Procedure SetPalette(Pal : TPalette);
Procedure FadePal(Pal : TPalette);
Procedure LightPal(Pal : TPalette);
Procedure ReadPicture(FileName : String);
Procedure FreePicture(PicN : Byte);
Procedure ShowPicture(X,Y,PicN : Integer);
Procedure ShowPictureD(X,Y,PicN : Integer);
Procedure ShowPicTrans(X,Y,PicN : Integer);
Procedure ShowPicTransD(X,Y,PicN : Integer);
Procedure VRT;
Procedure ReadMouseState(Var XMo,YMo : Integer;Var Lb,Mb,Rb : Boolean);
Procedure DrawLeft(A : Word;P : Pointer);
Procedure DrawRight(A : Word;P : Pointer);
Procedure ShowFrame(X1,Y1,W,H : Word);
Procedure Pixel(x,y : Word; Color : Byte);
Procedure PixelD(x,y : Word; Color : Byte);
Procedure SetMode(Mode : Byte);
Procedure SetPalReg(index,Red,Green,Blue : Byte);
Procedure ClrVid(color : Byte);
Procedure ClrVid2(color : Byte);
Procedure Print(S : String;x,y : Word; color : Byte);
Procedure PrintD(S : String;x,y : Word; color : Byte);
Procedure ShowImage(x,y : Word;w,h : Word;Spr : Pointer);
Procedure ShowTrans(x,y : Word;w,h : Word;Spr : Pointer);
Procedure ShowImageD(x,y : LongInt;w,h : Word;Spr : Pointer);
Procedure ShowTransD(x,y : Word;w,h : Word;Spr : Pointer);
Procedure ShowSprD(x,y : Word;w,h : Word;Spr : Pointer;col : Byte);
Procedure ShowEnergy(x,y : LongInt;len,col : Byte);
{Procedure DrawSprite16(Spr : TSpr;x,y : Word);}
Procedure DrawSpriteD(Spr : TSpr;x,y : Word);
Procedure DrawSpriteT(Spr : TSpr;x,y : Word);
Procedure ReadUnderMouse;
Procedure ShowUnderMouse;
Procedure ShowMous;
Procedure ShowMous2;
Procedure ShowDouble;
Procedure ShowMouse;
Procedure HideMouse;
Procedure GrInit;
Procedure GrDone;
Implementation
Procedure RusFont; far; external;
Procedure MouseSp; far; external;
Procedure FadePal(Pal : TPalette);
Var A,B : LongInt;
P : TPalette;
T : LongInt;
Begin
For B:=FadeSpeed downto 0 do
Begin
For A:=0 to 255 do
Begin
P[A].R:=Trunc(Pal[A].R*B/FadeSpeed);
P[A].G:=Trunc(Pal[A].G*B/FadeSpeed);
P[A].B:=Trunc(Pal[A].B*B/FadeSpeed);
End;
SetPalette(P);
T:=MemL[$40:$6c];
Repeat Until MemL[$40:$6c]-T>=1;
End;
End;
Procedure LightPal(Pal : TPalette);
Var A,B : LongInt;
P : TPalette;
T : LongInt;
Begin
For B:=0 to FadeSpeed do
Begin
For A:=0 to 255 do
Begin
P[A].R:=Trunc(Pal[A].R*B/FadeSpeed);
P[A].G:=Trunc(Pal[A].G*B/FadeSpeed);
P[A].B:=Trunc(Pal[A].B*B/FadeSpeed);
End;
SetPalette(P);
T:=MemL[$40:$6c];
Repeat Until MemL[$40:$6c]-T>=1;
End;
End;
Procedure ReadPicture(FileName : String);
Var F : File;
W,H : Word;
Begin
Assign(F,FileName);
ReSet(F,1);
BlockRead(F,W,2);
BlockRead(F,H,2);
Inc(LastP);
GetMem(Pic[LastP].Spr,W*H);
Pic[LastP].W:=W;
Pic[LastP].H:=H;
BlockRead(F,Pic[LastP].Spr^,W*H);
BlockRead(F,Pal,SizeOf(Pal));
Close(F);
For W:=0 to 255 do SetPalReg(W,Pal[W].R,Pal[W].G,Pal[W].B);
End;
Procedure FreePicture(PicN : Byte);
Begin
FreeMem(Pic[PicN].Spr,Pic[PicN].W*Pic[PicN].H);
End;
Procedure ShowPicture(X,Y,PicN : Integer);
Begin
ShowImage(X,Y,Pic[PicN].W,Pic[PicN].H,Pic[PicN].Spr);
End;
Procedure ShowPicTrans(X,Y,PicN : Integer);
Begin
ShowTrans(X,Y,Pic[PicN].W,Pic[PicN].H,Pic[PicN].Spr);
End;
Procedure ShowPicTransD(X,Y,PicN : Integer);
Begin
ShowTransD(X,Y,Pic[PicN].W,Pic[PicN].H,Pic[PicN].Spr);
End;
Procedure ShowPictureD(X,Y,PicN : Integer);
Begin
ShowImageD(X,Y,Pic[PicN].W,Pic[PicN].H,Pic[PicN].Spr);
End;
Procedure ReSetMouse;
Var R : Registers;
Begin
R.ax:=0;
Intr($33,R);
End;
Procedure ReadMouseState(Var XMo,YMo : Integer;Var Lb,Mb,Rb : Boolean);
Var R : Registers;
Begin
R.ax:=3;
Intr($33,R);
XMo:=R.cx;
YMo:=R.dx;
Lb:=R.bx and 1=1;
Rb:=R.bx and 2=2;
Mb:=R.bx and 4=4;
End;
Procedure SetMode(Mode : Byte); assembler;
Asm
Mov AH,0
Mov AL,Mode
Int 10h
End;
Procedure Pixel(x,y : Word; Color : Byte); assembler;
Asm
Mov ax,SegA000
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
Mov al,Byte Ptr color
Mov es : [di],al
End;
Procedure PixelD(x,y : Word;Color : Byte); assembler;
Asm
Mov ax,SegDB
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
Mov al,Byte Ptr color
Mov es : [di],al
End;
Procedure SetPalReg(index,Red,Green,Blue : Byte);
Begin
Port[PalMask]:=$FF;
Port[PalRegW]:=index;
Port[PalData]:=Red;
Port[PalData]:=Green;
Port[PalData]:=Blue;
End;
Procedure SetPalette(Pal : TPalette);
Var I : Byte;
Begin
For I:=0 to 255 do SetPalReg(I,Pal[i].R,Pal[i].G,Pal[i].B);
End;
Procedure ShMo;
Begin
DrawSpriteD(MouseSpr^,MouseX,MouseY);
End;
Procedure RdMo; assembler;
Asm
Push ds
Les di,MouseBuf
Mov si,MouseY
Shl si,6
Mov bx,si
Shl si,2
Add si,bx
Add si,MouseX
Push si
Mov ax,SegDB
Mov ds,ax
Pop si
Mov cx,16
Cld
@m1 :
Push cx
Mov cx,8
Rep MovsW
Pop cx
Add si,304
Loop @m1
Pop ds
End;
Procedure ShowDouble; assembler;
Asm
Mov dl,MouseVis
Push dx
Mov MouseVis,0
Cmp dl,1
Jne @dal1
Call RdMo
Call ShMo
@dal1 :
Push ds
Mov ax,SegA000
Mov es,ax
Mov di,0
Mov cx,32000
Mov ax,SegDB
Mov ds,ax
Mov si,0
Cld
Rep MovsW
Pop ds
Pop dx
Mov MouseVis,dl
End;
Procedure ShowFrame(X1,Y1,W,H : Word); assembler;
Asm
mov ax,SegDB
mov es,ax
Mov di,y1
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x1
mov cx,W
mov al,FrameColor
rep stosb
add di,320
sub di,w
mov cx,h
sub cx,2
@Met1:
mov es:[di],al
add di,w
dec di
mov es:[di],al
inc di
add di,320
sub di,w
loop @Met1
mov cx,w
rep stosb
End;
Procedure ClrVid(color : Byte); assembler;
Asm
Mov ax,SegA000
Mov es,ax
Mov di,0
Mov cx,32000
Mov ah,color
Mov al,ah
Cld
Rep StosW
Mov GetBack,al
End;
Procedure ClrVid2(color : Byte); assembler;
Asm
Mov ax,SegDB
Mov es,ax
Mov di,0
Mov cx,32000
Mov ah,color
Mov al,ah
Cld
Rep StosW
Mov GetBack,al
End;
Procedure Print(S : String;x,y : Word; color : Byte);
Var i,x1,y1,Off : Word;
Procedure Prt(Ch : Char;x,y,off : Word; color : Byte);
Var WrkSeg,WrkOff,x2,y2,TOff : Word;
BitMask,O : Byte;
Begin
If Ord(Ch)<128 then
Begin
TOff:=Off;
WrkSeg:=$F000;
WrkOff:=$FA6E+(Ord(Ch) shl 3);
For y:=0 to 7 do
Begin
BitMask:=$80;
For x:=0 to 7 do
Begin
If Mem[WrkSeg:WrkOff] and BitMask<>0 then Mem[SegA000 TOff+x)]:=color
else Mem[SegA000TOff+x)]:=GetBack;
BitMask:=BitMask shr 1;
End;
Inc(TOff,320);
Inc(WrkOff);
End;
End else
Begin
TOff:=Off;
O:=Ord(CH);
For y:=1 to 8 do
Begin
BitMask:=$80;
For x:=0 to 7 do
Begin
If Fnt^[o,y] and BitMask<>0 then Mem[SegA000TOff+x)]:=color
else Mem[SegA000TOff+x)]:=GetBack;
BitMask:=BitMask shr 1;
End;
Inc(TOff,320);
End;
End;
End;
Begin
x1:=x;y1:=y;
Off:=(y shl 8)+(y shl 6)+x;
For i:=1 to length(s) do
Begin
Prt(s[i],x1,y1,off,color);
Inc(x1,8);
Inc(off,8);
End;
End;
Procedure PrintD(S : String;x,y : Word; color : Byte);
Var Segm,i,x1,y1,Off : Word;
Procedure PrtD(Ch : Char;x,y,off : Word; color : Byte);
Var WrkSeg,WrkOff,x2,y2,TOff : Word;
BitMask,O : Byte;
Begin
If Ord(Ch)<128 then
Begin
TOff:=Off;
WrkSeg:=$F000;
WrkOff:=$FA6E+(Ord(Ch) shl 3);
For y:=0 to 7 do
Begin
BitMask:=$80;
For x:=0 to 7 do
Begin
If Mem[WrkSeg:WrkOff] and BitMask<>0 then Mem[SegmTOff+x)]:=color
else Mem[SegmTOff+x)]:=GetBack;
BitMask:=BitMask shr 1;
End;
Inc(TOff,320);
Inc(WrkOff);
End;
End else
Begin
TOff:=Off;
O:=Ord(CH);
For y:=1 to 8 do
Begin
BitMask:=$80;
For x:=0 to 7 do
Begin
If Fnt^[o,y] and BitMask<>0 then Mem[SegmTOff+x)]:=color
else Mem[SegmTOff+x)]:=GetBack;
BitMask:=BitMask shr 1;
End;
Inc(TOff,320);
End;
End;
End;
Begin
x1:=x;y1:=y;
Off:=(y shl 8)+(y shl 6)+x;
Segm:=SegDB;
For i:=1 to length(s) do
Begin
PrtD(s[i],x1,y1,off,color);
Inc(x1,8);
Inc(off,8);
End;
End;
Procedure ShowImage(x,y : Word;w,h : Word;Spr : Pointer); assembler;
Asm
Mov ax,SegA000
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
mov cx,h
mov bx,w
lds si,spr
@Met1 :
push cx
mov cx,bx
rep movsb
pop cx
add di,320
sub di,bx
Loop @Met1
Pop ds
End;
Procedure ShowTrans(x,y : Word;w,h : Word;Spr : Pointer); assembler;
Asm
Mov ax,SegA000
Mov es,ax
mov dl,TrCol
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
mov cx,h
mov bx,w
lds si,spr
@Met1 :
push cx
mov cx,bx
@Met2 :
mov al,ds:[si]
cmp al,dl
jz @Met3
mov es:[di],al
@Met3:
inc di
inc si
loop @Met2
pop cx
add di,320
sub di,bx
Loop @Met1
Pop ds
End;
Procedure ShowImageD_a(x,y : Word;w,h : Word;Spr : Pointer); assembler;
Asm
Mov ax,SegDB
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
mov cx,h
mov bx,w
lds si,spr
@Met1 :
push cx
mov cx,bx
rep movsb
pop cx
add di,320
sub di,bx
Loop @Met1
Pop ds
End;
Procedure ShowICD_a(x,y,w,h,adr,wa : Word;Spr : Pointer); assembler;
Asm
Mov ax,SegDB
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
mov cx,h
mov bx,w
mov dx,wa
lds si,spr
add si,adr
@Met1 :
push cx
mov cx,bx
rep movsb
pop cx
add di,320
sub di,bx
add si,dx
Loop @Met1
Pop ds
End;
Procedure ShowImageD(x,y : LongInt;w,h : Word;Spr : Pointer);
Var A,B,C,D : LongInt;
Begin
If (X<=-W) or (Y<=-H) or (X>319) or (Y>199) then exit;
If (X>=0) and (Y>=0) and (X<321-W) and (Y<=201-H) then
ShowImageD_a(X,Y,W,H,Spr) else
Begin
A:=0; B:=0; C:=W-1; D:=H-1;
If X<0 then Begin A:=-X; X:=0; End;
If Y<0 then Begin B:=-Y; Y:=0; End;
If X>320-W then C:=319-X;
If Y>200-H then D:=199-Y;
if (c-a+1<=0) or (d-b+1<=0) then
a:=a;
ShowICD_a(x,y,c-a+1,d-b+1,b*w+a,w-c+a-1,spr);
End;
End;
Procedure ShowTransD(x,y : Word;w,h : Word;Spr : Pointer); assembler;
Asm
Mov ax,SegDB
mov dl,TrCol
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
mov cx,h
mov bx,w
lds si,spr
@Met1 :
push cx
mov cx,bx
@Met2 :
mov al,ds:[si]
cmp al,dl
jz @Met3
mov es:[di],al
@Met3:
inc di
inc si
loop @Met2
pop cx
add di,320
sub di,bx
Loop @Met1
Pop ds
End;
Procedure ShowSprD(x,y : Word;w,h : Word;Spr : Pointer;Col : Byte); assembler;
Asm
Mov ax,SegDB
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
mov cx,h
mov bx,w
lds si,spr
@Met1 :
push cx
mov cx,bx
@Met2 :
mov al,ds:[si]
cmp al,14
jz @Met3
cmp al,12
jnz @Met4
mov al,col
@Met4:
mov es:[di],al
@Met3:
inc di
inc si
loop @Met2
pop cx
add di,320
sub di,bx
Loop @Met1
Pop ds
End;
Procedure ShowEnergy(x,y : LongInt;len,col : Byte);
Var A,B : LongInt;
Begin
If (X<-len) or (X>319) then Exit else
Begin
For A:=0 to len-1 do
For B:=0 to 1 do
If (X+A>=0) and (X+A<320) and (Y+B>0) and (Y+B<200) then
PixelD(X+A,Y+B,col);
End;
End;
{Procedure DrawSprite16(Spr : TSpr;x,y : Word); assembler;
Asm
Mov ax,SegA000
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
lds si,spr
mov cx,16
@Met1 :
push cx
mov cx,8
rep movsw
pop cx
add di,304
Loop @Met1
Pop ds
End;}
Procedure DrawLeft(A : Word;P : Pointer); assembler;
Asm
mov ax,SegDB
cld
mov es,ax
push ds
mov bx,A
mov ax,320
sub ax,bx
mov dx,ax
xor di,di
lds si,P
mov cx,200
@M1:
add si,bx
push cx
mov cx,dx
rep movsb
add di,bx
pop cx
loop @M1
pop ds
End;
Procedure DrawRight(A : Word;P : Pointer); assembler;
Asm
mov ax,SegDB
cld
mov es,ax
push ds
mov bx,A
mov ax,320
sub ax,bx
mov dx,ax
xor di,di
lds si,P
mov cx,200
@M1:
add di,dx
push cx
mov cx,bx
rep movsb
add si,dx
pop cx
loop @M1
pop ds
End;
Procedure DrawSpriteT(Spr : TSpr;x,y : Word); assembler;
Asm
Mov ax,SegA000
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
lds si,spr
mov cx,16
@Metk1 :
push cx
mov cx,16
@metk2 :
Mov al,[si]
Cmp al,0
Je @metk3
Mov es:[di],al
@metk3 :
Inc si
Inc di
Loop @metk2
pop cx
add di,304
Loop @Metk1
Pop ds
End;
Procedure DrawSpriteD(Spr : TSpr;x,y : Word); assembler;
Asm
Mov ax,SegDB
Mov es,ax
Mov di,y
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,x
push ds
lds si,spr
mov cx,16
@Me1 :
push cx
mov cx,16
@Me2 :
Mov al,[si]
Cmp al,0
Je @Me3
Mov es:[di],al
@Me3 :
Inc di
Inc si
Loop @Me2
pop cx
add di,304
Loop @Me1
Pop ds
End;
Procedure ReadUnderMouse; assembler;
Asm
Push ds
Les di,MouseBuf
Mov si,MouseY
Shl si,6
Mov bx,si
Shl si,2
Add si,bx
Add si,MouseX
Mov ax,SegA000
Mov ds,ax
Mov cx,16
Cld
@m1 :
Push cx
Mov cx,8
Rep MovsW
Pop cx
Add si,304
Loop @m1
Pop ds
End;
Procedure ShowUnderMouse; assembler;
Asm
Push ds
Mov ax,SegA000
Mov es,ax
Mov di,MouseY
Shl di,6
Mov bx,di
Shl di,2
Add di,bx
Add di,MouseX
Lds si,MouseBuf
Cld
Mov cx,16
@mm1 :
Push cx
Mov cx,8
Rep MovsW
Pop cx
Add di,304
Loop @mm1
Pop ds
End;
Procedure ShowMous;
Begin
DrawSpriteT(MouseSpr^,MouseX,MouseY);
End;
Procedure ShowMous2;
Begin
DrawSpriteD(MouseSpr^,MouseX,MouseY);
End;
Procedure ShowMouse;
Var Lb,Mb,Rb : Boolean;
Begin
ReadMouseState(MouseX,MouseY,Lb,Mb,Rb);
MouseX:=MouseX Shr 1;
MouseVis:=True;
ReadUnderMouse;
ShowMous;
End;
Procedure HideMouse;
Begin
MouseVis:=False;
ShowUnderMouse;
End;
procedure VRT; assembler;
asm
mov dx,3DAh
@VRT1:
in al,dx
test al,8
jnz @VRT1
@VRT2:
in al,dx
test al,8
jz @VRT2
end;
{$F+,S-,W-}
procedure TimerHandler; interrupt;
Var xm,ym : Integer;
Lb,Rb,Mb : Boolean;
begin
{ Timer ISR }
If MouseVis then
Begin
ReadMouseState(xm,ym,Lb,Mb,Rb);
If (xm Shr 1<>MouseX) or (ym<>MouseY) then
Begin
ShowUnderMouse;
MouseX:=Xm Shr 1;
MouseY:=Ym;
If MouseX>304 then MouseX:=304;
If MouseY>184 then MouseY:=184;
ReadUnderMouse;
ShowMous;
End;
End;
end;
{$F-,S+}
Procedure GrInit;
Var a,b,c : Longint;
F : File of Byte;
Lb,Rb,Mb : Boolean;
S,O : Word;
Begin
LastP:=0;
MouseSpr:=@MouseSp;
New(MouseBuf);
MouseVis:=False;
ResetMouse;
GetIntVec($1C,Int1CSave);
SetIntVec($1C,@TimerHandler);
New(DoubleBuf);
SegDB:=Seg(DoubleBuf^)+1;
SetMode(VGA256);
{ MakePal;}
GetBack:=0;
End;
Procedure GrDone;
Begin
{ Dispose(DoubleBuf);}
Release(HeapOrg);
SetMode(TextMode);
SetIntVec($1C,Int1CSave);
End;
var a,b,c : longint;
s,o : Word;
Begin
New(Fnt);
S:=Seg(RusFont);
O:=Ofs(RusFont);
c:=0;
For a:=128 to 239 do
For b:=1 to 8 do
Begin
Fnt^[a,b]:=Mem[S:O+c];
Inc(c);
End;
LastP:=0;
End.
|
Добавлено:
мля :-) малость переборщил :р |
