{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                 BMP图形文件支持单元                     ***}
{***************************************************************}
{$O+,F+,X+,I-,S-}
Unit FBmp;
Interface
Uses
  Dos,Graph,FGraph,FView,FTool,FDac,SvgaDrv,FCutgra,FWrite;

Type
  BitMapFile=record
   bfType:Integer;
   bfSize:Longint;
   Reserved1:Integer;
   Reserved2:Integer;
   bfOffset:Longint;
  end;
  BitMapInfo=record
   biSize:Longint;
   biWidth:Longint;
   biHeight:Longint;
   biPlanes:Integer;
   biBitcount:Integer;
   biCompression:Longint;
   biSizeImage:Longint;
   biXPelspermeter:Longint;
   biYPelspermeter:Longint;
   biClrused:Longint;
   biClrImportant:Longint;
  end;
  BitMapRgb=record
   Blue:Byte;
   Green:Byte;
   Red:Byte;
   Reserved:Byte;
  end;

  PBmp=^TBmp;
  TBmp=object(TView)
   Fp:file;
   Result:Word;
   FileName:PathStr;
   BmpHead:BitMapFile;
   BmpInfo:BitMapInfo;
   BmpDac:DacType;
   BmpPal:array[0..255] of BitMapRgb;
   Line:array[0..2047] of Byte;
   Height,Width,TrueWid:Integer;
   ColorNum:Integer;
   VideoMode256,VideoMode16:Word;
   TempAttr:Word;
   Center,ShowInfo,ReSetVideo,ReSetDac,BackGround:Boolean;
   InfoStr:string;
   constructor Init(AFileName:string;Intx,Inty:Integer);
   destructor Done;virtual;
   procedure SetOption(V256,V16:Word;Cen,ShIn,RV,RD,BC:Boolean);
   procedure SetPosition(x,y:Integer);
   procedure GetInfo(var Wid,Hig,Col:Integer);
   procedure ProHeader;
   procedure OpenFile;
   procedure Draw;virtual;
   procedure Creat(x,y:Integer);
  end;

Implementation
constructor TBmp.Init;
begin
  Inherited Init;
  FileName:=AFileName;
  Origin.x:=Intx;
  Origin.y:=Inty;
  SetOption($101,$12,False,False,False,False,False);
  TempAttr:=Archive;
end;

destructor TBmp.Done;
begin
  SetFAttr(Fp,TempAttr);
  {$i-}Close(Fp);{$i+}
end;

procedure TBmp.SetOption;
begin
  VideoMode256:=V256;
  VideoMode16:=V16;
  Center:=Cen;
  ShowInfo:=ShIn;
  ReSetVideo:=RV;
  ReSetDac:=RD;
  BackGround:=BC;
end;

procedure TBmp.SetPosition;
begin
  Origin.x:=x;
  Origin.y:=y;
end;

procedure TBmp.GetInfo;
begin
  Wid:=Width+1;
  Hig:=Height+1;
  Col:=ColorNum;
end;

procedure TBmp.ProHeader;
var
  DacMark:Byte;
  i:Integer;
begin
  Height:=BmpInfo.biHeight;
  Width:=BmpInfo.biWidth;
  TrueWid:=(BmpInfo.biWidth*BmpInfo.biBitCount) div 8;
  if (BmpInfo.biWidth*BmpInfo.biBitCount) mod 32<>0 then
    TrueWid:=TrueWid+4-(BmpInfo.biWidth*BmpInfo.biBitCount div 8) mod 4;
  if BmpInfo.biClrUsed=0 then
  begin
    if BmpInfo.biBitCount=1 then ColorNum:=2
    else if BmpInfo.biBitCount=4 then ColorNum:=16
    else if BmpInfo.biBitcount=8 then ColorNum:=256
    else ColorNum:=0;
  end else
    ColorNum:=BmpInfo.biClrUsed;
  BlockRead(Fp,BmpPal,ColorNum*SizeOf(BitMapRgb),Result);
  FillChar(BmpDac,SizeOf(DacType),0);
  if ColorNum=0 then Exit;
  if ColorNum<256 then
  for i:=0 to ColorNum-1 do
  begin
    BmpDac[GetDacIndex(i)*3+1]:=BmpPal[i].Red shr 2;
    BmpDac[GetDacIndex(i)*3+2]:=BmpPal[i].Green shr 2;
    BmpDac[GetDacIndex(i)*3+3]:=BmpPal[i].Blue shr 2;
  end else
  for i:=0 to 255 do
  begin
    BmpDac[i*3+1]:=BmpPal[i].Red shr 2;
    BmpDac[i*3+2]:=BmpPal[i].Green shr 2;
    BmpDac[i*3+3]:=BmpPal[i].Blue shr 2;
  end;
end;

procedure TBmp.OpenFile;
begin
  IsValid:=False;
  Assign(Fp,FileName);
  GetFAttr(Fp,TempAttr);
  SetFAttr(Fp,Archive);
  {$i-}Reset(Fp,1);{$i+}
  if IOResult<>0 then
  begin
    Writecs(10,10,'Open File '+FileName+' Error!',15);
    Exit;
  end;
  BlockRead(Fp,BmpHead,SizeOf(BitMapFile),Result);
  blockread(Fp,BmpInfo,SizeOf(BitMapInfo),Result);
  if BmpHead.bfType<>$4D42 then Exit;
  if BmpInfo.biCompression<>0 then Exit;
  if not (BmpInfo.biBitCount in [1,4,8]) then Exit;
  ProHeader;
  IsValid:=True;
end;

procedure TBmp.Draw;
  procedure SetCenter;
  begin
    if Center then
    begin
      Origin.x:=0;
      Origin.y:=0;
      if Maxx>Width then
      Origin.X:=(Maxx-Width) div 2;
      if Maxy>Height then
      Origin.Y:=(Maxy-Height) div 2;
    end;
  end;

  procedure Draw_Bmp2;
  var
    i,j,k:Integer;
  begin
    if ReSetVideo then SetVideoMode(VideoMode16);
    SetCenter;
    if ReSetDac then Dac.SetNewDac(BmpDac);
    for i:=Height-1 downto 0 do
    begin
      BlockRead(Fp,Line,TrueWid,Result);
      for j:=0 to TrueWid-1 do
      begin
        for k:=0 to 7 do
        if j*8+k<Width then
        if Line[j] and (1 shl (7-k))<>0 then
          PutPixel4(Origin.x+j*8+k,Origin.y+i,1)
        else
          PutPixel4(Origin.x+j*8+k,Origin.y+i,0);
      end;
    end;
  end;

  procedure Draw_Bmp16;
  var
    i,j:Integer;
  begin
    if ReSetVideo then SetVideoMode(VideoMode16);
    SetCenter;
    if ReSetDac then Dac.SetNewDac(BmpDac);
    for i:=Height-1 downto 0 do
    begin
      BlockRead(Fp,Line,TrueWid,Result);
      for j:=0 to TrueWid-1 do
      begin
        if j*2<Width then
          PutPixel4(Origin.x+j*2,Origin.y+i,(line[j] and $F0) shr 4);
        if j*2+1<Width then
          PutPixel4(Origin.x+j*2+1,Origin.y+i,Line[j] and $0F);
      end;
    end;
  end;

  procedure Draw_Bmp256;
  var
    i,j:Integer;
  begin
    if ReSetVideo then SetVideoMode(VideoMode256);
    SetCenter;
    if ReSetDac then Dac.SetNewDac(BmpDac);
    for i:=Height-1 downto 0 do
    begin
      BlockRead(Fp,Line,TrueWid,Result);
{      PutLine8(Origin.x,Origin.y+i,Seg(Line),Ofs(Line),Width);}
      for j:=0 to TrueWid-1 do
      if j<Width then
      if (Origin.x+j<=Maxx)and(Origin.y+i<=Maxy) then
      if not ((Line[j]=0)and BackGround) then
        PutPixel8(Origin.x+j,Origin.y+i,Line[j]);
    end;
  end;
begin
  if not IsValid then Exit;
  GetVideoMode;
  Seek(Fp,BmpHead.bfOffset);
  if BmpInfo.biBitCount=1 then Draw_Bmp2
  else if BmpInfo.biBitCount=4 then Draw_Bmp16
  else if BmpInfo.biBitCount=8 then Draw_Bmp256;
  if ShowInfo then
  begin
    SvgaDrv.SetColor(GetLightColor(DacRegsType(BmpDac)));
    SvgaDrv.MoveTo(Maxx div 2 - 70,Maxy-20);
    InfoStr:=Intstr(Width)+'*'+Intstr(Height)+' '+Intstr(ColorNum)+'Color';
    SvgaDrv.OutText(InfoStr);
  end;
end;

procedure TBmp.Creat;
  procedure ConvertDac;
  var
    i:Integer;
  begin
   if ColorNum=0 then Exit;
   if ColorNum<256 then
   for i:=0 to ColorNum-1 do
   begin
     BmpPal[i].Red:=BmpDac[GetDacIndex(i)*3+1] shl 2;
     BmpPal[i].Green:=BmpDac[GetDacIndex(i)*3+2] shl 2;
     BmpPal[i].Blue:=BmpDac[GetDacIndex(i)*3+3] shl 2;
     BmpPal[i].Reserved:=0;
   end
   else
   for i:=0 to 255 do
   begin
     BmpPal[i].Red:=BmpDac[i*3+1] shl 2;
     BmpPal[i].Green:=BmpDac[i*3+2] shl 2;
     BmpPal[i].Blue:=BmpDac[i*3+3] shl 2;
     BmpPal[i].Reserved:=0;
   end;
  end;

  procedure WriteBmp16;
  var
    i,j:Integer;
  begin
   for i:=Height-1 downto 0 do
   begin
    for j:=0 to TrueWid-1 do
    begin
      if j*2<Width then
      Line[j]:=Byte(GetPixel(Origin.x+j*2,Origin.y+i) shl 4);
      if j*2+1<Width then
      Line[j]:=Line[j] or Byte(GetPixel(Origin.x+j*2+1,Origin.y+i) and $0F);
    end;
    BlockWrite(Fp,Line,TrueWid,Result);
   end;
  end;

  procedure WriteBmp256;
  var
    i,j:Integer;
  begin
   for i:=Height-1 downto 0 do
   begin
    for j:=0 to TrueWid-1 do
    if j<Width then
    Line[j]:=GetPixel8(Origin.x+j,Origin.y+i);
    BlockWrite(Fp,Line,TrueWid,Result);
   end;
  end;

var i:Integer;
begin
  GetVideoMode;
  Assign(Fp,FileName);
  {$i-}ReWrite(Fp,1);{$i+}
  if IOResult<>0 then Exit;
  Width:=x;
  Height:=y;
  BmpHead.bfType:=$4D42;
  BmpHead.Reserved1:=0;
  BmpHead.Reserved2:=0;
  BmpInfo.biSize:=40;
  BmpInfo.biWidth:=Width;
  BmpInfo.biHeight:=Height;
  BmpInfo.biPlanes:=1;
  for i:=1 to 24 do
  if MaxColor shr i=1 then
  BmpInfo.biBitCount:=i;
  TrueWid:=(BmpInfo.biWidth*BmpInfo.biBitCount) div 8;
  if (BmpInfo.biWidth*BmpInfo.biBitCount) mod 32<>0 then
  TrueWid:=TrueWid+4-(BmpInfo.biWidth*BmpInfo.biBitCount div 8) mod 4;
  BmpInfo.biCompression:=0;
  BmpInfo.biSizeImage:=TrueWid*Height;
  BmpInfo.biXPelspermeter:=Maxx;
  BmpInfo.biYPelspermeter:=Maxy;
  BmpInfo.biClrused:=0;
  BmpInfo.biClrImportant:=0;
  if MaxColor>256 then
    ColorNum:=0
  else
    ColorNum:=MaxColor;
  BmpHead.bfOffset:=54+ColorNum*4;
  BmpHead.bfSize:=54+ColorNum*4+TrueWid*Height;
  BlockWrite(Fp,BmpHead,SizeOf(BitMapFile),Result);
  BlockWrite(Fp,BmpInfo,SizeOf(BitMapInfo),Result);
  Dac.GetDac(BmpDac);
  ConvertDac;
  BlockWrite(Fp,BmpPal,ColorNum*SizeOf(BitMapRgb),Result);
  if BmpInfo.biBitCount=4 then WriteBmp16
  else if BmpInfo.biBitCount=8 then WriteBmp256;
end;

end.