Uses graph,crt;
{$f+}
function detectvga256:integer;
var vid:integer;
begin
vid:=2;
detectvga256:=vid;
if vid=0 then
end;
{$f-}
procedure vklop(mode:integer);
var autodetect:pointer;gd,gm:integer;
begin
autodetect:=@detectvga256;
gd:=installuserdriver('svga256',autodetect);
gd:=detect;gm:=mode;
initgraph(gd,gm,'');
putpixel(0,200,0);
end;
Procedure Pal(Col,R,G,B : Byte); assembler;
{ This sets the Red, Green and Blue values of a certain color }
asm
mov dx,3c8h
mov al,[col]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
end;
Procedure LoadBMP256(x,y:Integer;ime:String);
Var f:file;
bmp_x, bmp_y: Word;
bmp_p: Pointer;ph,pl:Word;
i,x1,y1:integer;
r,g,b,n:Byte;
Begin
Assign(f, ime);
Reset(f,1);
seek(f,18);blockread(f,bmp_x,2);
seek(f,22);blockread(f,bmp_y,2);
GetMem(bmp_p,bmp_x+40);ph:=seg(bmp_p^);pl:=ofs(bmp_p^);
mem[ph:pl]:=(bmp_x-2) mod $ff;mem[ph:pl+1]:=(bmp_x-2) div $ff;mem[ph:pl+2]:=0;mem[ph:pl+3]:=0;
seek(f,54);
for i:=0 to 255 do
begin
blockread(f,b,1);blockread(f,g,1);blockread(f,r,1);blockread(f,n,1);
pal(i,r div 4,g div 4,b div 4);
end;
seek(f,1078);
for i:=1 To bmp_y Do
Begin
blockread(f,mem[ph:pl+4],bmp_x+2);
{for x1:=0 to bmp_x-1 do putpixel(x+x1,y+bmp_y-i,mem[ph:pl+4+x1]);}
putimage(x,y+bmp_y-i,bmp_p^,normalput);
End;
FreeMem(bmp_p,bmp_x+40);
Close(f);
End;
Var i:integer;
Begin
vklop(2);
setcolor(14);
for i:=0 to 255 do begin setcolor(i);line(i,0,i,10);end;
setcolor(30);outtextxy(0,15,'256 barv');
LoadBMP256(100,30,'img256.bmp');
readkey;
closegraph;
End.
{$f+}
function detectvga256:integer;
var vid:integer;
begin
vid:=2;
detectvga256:=vid;
if vid=0 then
end;
{$f-}
procedure vklop(mode:integer);
var autodetect:pointer;gd,gm:integer;
begin
autodetect:=@detectvga256;
gd:=installuserdriver('svga256',autodetect);
gd:=detect;gm:=mode;
initgraph(gd,gm,'');
putpixel(0,200,0);
end;
Procedure Pal(Col,R,G,B : Byte); assembler;
{ This sets the Red, Green and Blue values of a certain color }
asm
mov dx,3c8h
mov al,[col]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
end;
Procedure LoadBMP256(x,y:Integer;ime:String);
Var f:file;
bmp_x, bmp_y: Word;
bmp_p: Pointer;ph,pl:Word;
i,x1,y1:integer;
r,g,b,n:Byte;
Begin
Assign(f, ime);
Reset(f,1);
seek(f,18);blockread(f,bmp_x,2);
seek(f,22);blockread(f,bmp_y,2);
GetMem(bmp_p,bmp_x+40);ph:=seg(bmp_p^);pl:=ofs(bmp_p^);
mem[ph:pl]:=(bmp_x-2) mod $ff;mem[ph:pl+1]:=(bmp_x-2) div $ff;mem[ph:pl+2]:=0;mem[ph:pl+3]:=0;
seek(f,54);
for i:=0 to 255 do
begin
blockread(f,b,1);blockread(f,g,1);blockread(f,r,1);blockread(f,n,1);
pal(i,r div 4,g div 4,b div 4);
end;
seek(f,1078);
for i:=1 To bmp_y Do
Begin
blockread(f,mem[ph:pl+4],bmp_x+2);
{for x1:=0 to bmp_x-1 do putpixel(x+x1,y+bmp_y-i,mem[ph:pl+4+x1]);}
putimage(x,y+bmp_y-i,bmp_p^,normalput);
End;
FreeMem(bmp_p,bmp_x+40);
Close(f);
End;
Var i:integer;
Begin
vklop(2);
setcolor(14);
for i:=0 to 255 do begin setcolor(i);line(i,0,i,10);end;
setcolor(30);outtextxy(0,15,'256 barv');
LoadBMP256(100,30,'img256.bmp');
readkey;
closegraph;
End.
No comments:
Post a Comment