Sunday, 21 October 2012

Menampilkan BMP menggunakan Turbo Pascal

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.


No comments:

Post a Comment