www.pudn.com > object pascal±àÒëÆ÷Ô´Âë.rar > bmp.pas

unit bmp;
interface 
type 
bitmapfileheader=packed record 
      	 bftype:array [1..2] of char; 
         bfsize:integer; 
         res1:array[0..3] of char; 
         bfoffbits:integer; 
      end;   
      TBitmapInfoHeader = record 
        biSize: integer; 
        biWidth: integer; 
        biHeight: integer; 
        biPlanes: Word; 
        biBitCount: Word; 
        biCompression: integer; 
        biSizeImage: integer; 
        biXPelsPerMeter: integer; 
        biYPelsPerMeter: integer; 
        biClrUsed: integer; 
        biClrImportant: integer; 
      end; 
      TRGBQuad = record 
        rgbBlue: Byte; 
        rgbGreen: Byte; 
        rgbRed: Byte; 
        rgbReserved: Byte; 
      end; 
 
      TBitmapInfo = record 
   	bmiHeader: TBitmapInfoHeader; 
   	{bmiColors: array[0..255] of TRGBQuad;} 
      end; 
 
      bmpfile=packed record 
             fileheader: bitmapfileheader; 
      	     filedata:tbitmapinfo; 
      end; 
      pbmpfile=^bmpfile;
      image(minplane,maxplane,minrow,maxrow,mincol,maxcol:integer)=array[minplane..maxplane,minrow..maxrow,mincol..maxcol]of byte;
      pimage=^image;
implementation
type  
	imageline(mincol,maxcol,minplane,maxplane:integer)=array[mincol..maxcol,minplane..maxplane] of byte; 
procedure initbmpheader(var header:bmpfile;var im:image);
begin
end;

 
procedure storebmpfile(s:string;var im:image) ; 
type line=array[0..4000,0..2] of byte;
var f:file; fsize,i,index,j,k,m,row,res:integer;  pf:pbmpfile;	la: ^imageline;b:byte;
begin 
	new (pf);
	initbmpheader(pf^,im);
        assign(f,s); 
	rewrite(f); 
        blockwrite(f,pf^,sizeof(bmpfile),res); 
        with pf^.filedata.bmiheader do begin 	new(la  ,0,biwidth-1,0,2 ); 
                for i:= biheight-1 downto 0 do begin 
                  for k:=0 to biwidth-1 do 
                  for m:=0 to 2 do begin 
		      b:=im[m,i,k];	
                      la^[k,m]:=b;
 
                  end; 

                  blockwrite(f,la^[0,0],3*biwidth,res); 
                end ; 
 		dispose(la);
                close(f); 
        end; 
	dispose(pf);
end; 


function loadbmpfile(s:string;var im:pimage):boolean ; 
var f:file; fsize,i,index,j,k,m,row,res:integer; 
	la: ^imageline; pf:pbmpfile;
begin 
        assign(f,s); 
        {$i-} 
	reset(f); 
        if ioresult <>0 then begin  loadbmpfile:=false;  end
	else begin 
	        fsize:=filesize(f); 
	        new(pf);
		i:=sizeof(bmpfile);
	        blockread(f,pf^,i,res); 
	        with pf^.filedata.bmiheader do begin 
	                new(im,0,2,0,biheight-1,0,biwidth-1);
			new(la,0,biwidth-1,0,2); 
	                if bibitcount=8 then loadbmpfile:=false
	                else if bibitcount=24 then begin 
		                for i:=0 to biheight-1 do begin 
		                  if i