wilimage.pas

尚未完成的传奇3资源编辑器,需要就下吧

unit WilImage;

interface
uses windows,Classes,SysUtils,tList32,ExtCtrls,Dialogs,Graphics,ComCtrls;

const
      gnErrors            = 5;
      gnSpaceSize         = 1;


type  OpenMode = (NrmMode,ReBMode);


type  PWILFILEHEADER = ^WILFILEHEADER;
      WILFILEHEADER = packed record
            shComp  :WORD;
            szTitle :array[1..20] of char;
            shVer   :WORD;
            nImageCount:integer;
end;

type  PWILIMAGEINFO =^WILIMAGEINFO;
      WILIMAGEINFO = packed record
            shWidth :smallint;
            shHeight:smallint;
            shPX    :smallint;
            shPY    :smallint;
            bShadow :CHAR;
            shShadowPX:smallint;
            shShadowPY:smallint;
            dwImageLength:DWORD;
end;


type  PWHOLEWILIMAGEINFO =^WHOLEWILIMAGEINFO;
      WHOLEWILIMAGEINFO = packed record
            shWidth :smallint;
            shHeight:smallint;
            shPX    :smallint;
            shPY    :smallint;
            bShadow :CHAR;
            shShadowPX:smallint;
            shShadowPY:smallint;
            dwImageLength:DWORD;
            bValid  :boolean;
            pData   :Pointer;
            nFrom,nTo:Integer;
            nOffset : Integer;
end;

type  PWIXIMAGEINFO = ^WIXIMAGEINFO;
      WIXIMAGEINFO = packed record
            szTitle :array[1..20] of CHAR;
            nIndexCount:INTEGER;
            pnPosition  :array of integer;
end;

type
TWilImageData = class(TThread)
  protected
    m_bIsMemMapped    : boolean;
    m_pbStartData     : pointer;
    m_nCurrImageIdx   : integer;
    m_bIsCompressed   : boolean;
    m_ImgContainer    : List32;
    m_WilFileSize     : dword;
    m_ErrorImages     : integer;

    m_bBreak          : boolean;

    m_BreakTimer      : TTimer;

    m_nWidthEnd       : dword;

    m_nWilNeedSpace   : dword;
    m_nWixNeedSpace   : dword;

    m_nOpenMode       : OpenMode;              // 1:普通模式，2:重建模式


    procedure Execute; override;

  public
    m_stWixImgaeInfo          : WIXIMAGEINFO;
    m_lpstCurrWilImageInfo    : PWILIMAGEINFO;
    m_pbCurrImage             : Pointer;
    m_sWilFileName            : string;
    m_sWixFileName            : string;
    m_nCalLen                 : integer;
    m_nErrors                 : array[0..gnErrors-1] of Integer;

    StatusBar                 : TStatusBar;
    m_bRebuilding             : boolean;
    
    constructor Create(bSusp:boolean = true);
    destructor  Destroy;override;

    procedure   Clear;     //彻底清理，包括内存释放。
    procedure   InstClear; //临时清理,这里只是释放掉Load函数载入的内存、磁盘映射等。

    procedure   Init;                                                         //初始化
    function    Load(const szWilFile:string;nOpenMode:OpenMode = NrmMode;bComp:boolean = false):boolean;
    function    SetIndex(nIndex:integer):boolean;                             //指针
    function    DrawWithImageForCompMemToMem(pDst:Pointer = nil):boolean;     //模拟渲染过程，计算资源实际长度。


    function    ReBuilt:boolean;                                              //把资源重建到m_ImgContainer，包括错误侦测:资源长度、越界等。
    function    LoadBMP(nIndex:integer;nDstMaxWidth:integer = 0;nDstMaxHeight:integer = 0):TBitMap;
    procedure   SaveFile(bComp:boolean = false);
    procedure   ImportFromFile(nIndex:integer;const szBmp:string);

    
    procedure   GetScaleSize(var DstWidth,DstHeigh:integer;SrcWidth,SrcHeigh:integer);

  private


    function    OpenFile(const szWilFile:string;bComp:boolean = false):boolean;
    function    SetIndexEx(nIndex:integer):boolean;                           //指向容器里面的资源。
    procedure   SaveFileFromContainer(bComp:boolean = false);                              //资源保存。
    procedure   SaveFileFromMapping(bComp:boolean = false);
    procedure   ImportImage(Src:TBitMap;var DstBuf:Pointer;var nLength:dword);
    
    function    CheckImageLenError:boolean;
    procedure   CopyImageInfo(Wi:PWILIMAGEINFO;WWi:PWHOLEWILIMAGEINFO;bReverse:boolean = false);
    procedure   BreakTimerTimer(Sender: TObject);

end;

implementation

procedure TWilImageData.Execute;
begin
  try
    m_bRebuilding:=true;
    ReBuilt;
    m_nOpenMode := ReBMode;
    InstClear;
    if StatusBar<>nil then StatusBar.Panels[1].Text:='资源重建完毕,进入编辑状态...';
    m_bRebuilding:=false;
  except
  end;
end;

procedure TWilImageData.ImportFromFile(nIndex:integer;const szBmp:string);
var TempBmp:TBitMap;
    pwwmi:PWHOLEWILIMAGEINFO;
begin
  if szBmp<>'' then begin
  try
    TempBmp:=TBitMap.Create;
    TempBmp.LoadFromFile(szBmp);
    case m_nOpenMode of
      ReBMode:begin
        pwwmi:=PWHOLEWILIMAGEINFO(m_ImgContainer.Objects[nIndex]);
        if pwwmi<>nil then begin
         ImportImage(TempBmp,pwwmi.pData,pwwmi.dwImageLength);
         if pwwmi.dwImageLength>0 then pwwmi.bValid:=true;
         pwwmi.shWidth:=TempBmp.Width;
         pwwmi.shHeight:=TempBmp.Height;
        end;
      end;
    end;
  finally
    TempBmp.FreeImage;
    TempBmp.Free;
  end;
  end;

end;

procedure TWilImageData.ImportImage(Src:TBitMap;var DstBuf:Pointer;var nLength:dword);
var pBits:array of word;
    _Src:TBitMap;
    nWidth,nHeight,TempWidth:integer;
    pDst:array of word;
    i,nPos,nRowPos,nRowPos2,nCount:integer;
begin
  nWidth  :=Src.Width;
  nHeight :=Src.Height;

  setlength(pBits, nWidth * nHeight);
  
  if Src.PixelFormat<>pf16bit then begin
    _Src:=TBitMap.Create;
    _Src.Width:=nWidth;
    _Src.Height:=nHeight;
    _Src.PixelFormat:=pf16bit;
    _Src.Canvas.Draw(0,0,TGraphic(Src));
    gETBitmapBits(_Src.Handle, nWidth * nHeight * sizeof(word), pBits);
    _Src.FreeImage;
    _Src.Free;
  end else gETBitmapBits(Src.Handle, nWidth * nHeight * sizeof(word), pBits);

  SetLength(pDst,(((nWidth div 2) + 1)*5 + 2)*nHeight); //最坏空间复杂度，让其有足够空间。

  nPos:=0;
  for i:= 0 to nHeight - 1 do begin
    TempWidth:=0;
    nRowPos:=nPos + 1;
    while TempWidth < nWidth do begin
      if pBits[i*nWidth + TempWidth]=$F818 then begin
        Inc(TempWidth);
        nCount:=1;
        while ((pBits[i*nWidth + TempWidth]=$F818) and (TempWidth<nWidth)) do begin
          Inc(TempWidth);
          Inc(nCount);
        end;
        pDst[nRowPos]:=$c0;
        Inc(nRowPos);
        pDst[nRowPos]:=nCount;
        Inc(nRowPos);
      end else begin
        nRowPos2:=nRowPos + 1;

        pDst[nRowPos]:=$c1;
        nRowPos:=nRowPos + 2;
        pDst[nRowPos]:=pBits[i*nWidth + TempWidth];
        Inc(nRowPos);

        Inc(TempWidth);
        nCount:=1;

        while ((pBits[i*nWidth + TempWidth]<>$F818) and (TempWidth<nWidth)) do begin
          pDst[nRowPos]:=pBits[i*nWidth + TempWidth];
          Inc(nRowPos);
          Inc(TempWidth);
          Inc(nCount);
        end;
        pDst[nRowPos2]:=nCount;
      end;
    end;
    pDst[nPos]:=nRowPos - nPos;
    nPos:=nRowPos;
    Inc(nPos);
  end;

  nLength:=nRowPos * sizeof(word);
  if DstBuf<>nil then try FreeMem(DstBuf) except end;
  GetMem(DstBuf,nLength );
  CopyMemory(DstBuf, @pDst[0],nLength);
  SetLength(pDst,0);
  SetLength(pBits,0);
end;

procedure TWilImageData.SaveFileFromMapping(bComp:boolean);
begin
end;

procedure TWilImageData.SaveFile(bComp:boolean);
begin
  case m_nOpenMode of
    NrmMode:SaveFileFromMapping(bComp);
    ReBMode:SaveFileFromContainer(bComp);
  end;
end;

procedure TWilImageData.GetScaleSize(var DstWidth,DstHeigh:integer;SrcWidth,SrcHeigh:integer);
var DstLen:integer;
    Y:integer;
begin
  Y:= trunc((DstWidth/SrcWidth) * SrcHeigh);
  if Y<=DstHeigh then begin
    DstHeigh:=Y;
  end else begin
    DstWidth:=trunc((DstHeigh/SrcHeigh) * SrcWidth);
  end;
end;

function  TWilImageData.LoadBMP(nIndex:integer;nDstMaxWidth,nDstMaxHeight:integer):TBitMap;
var bmp,ScaleBmp:TBitMap;
    bSet:boolean;
    pBits:array of word;
    TempWidth,TempHeight:integer;
    X,Y:integer;
    rc:TRECT;
    i:integer;
begin

  ReSult:=nil;

  if not SetIndex(nIndex) then Exit;
  try
    SetLength(pBits, m_lpstCurrWilImageInfo.shWidth * m_lpstCurrWilImageInfo.shHeight);

    for i:=0 to m_lpstCurrWilImageInfo.shWidth * m_lpstCurrWilImageInfo.shHeight - 1 do pBits[i]:=$F81F;
    //ZeroMemory(@pBits[0], sizeof(word) * m_lpstCurrWilImageInfo.shWidth * m_lpstCurrWilImageInfo.shHeight);
    if not DrawWithImageForCompMemToMem(pBits) then begin
      bmp:=TBitMap.Create;
      bmp.Width:=m_lpstCurrWilImageInfo.shWidth;
      bmp.Height:=m_lpstCurrWilImageInfo.shHeight;
      bmp.PixelFormat:=pf16bit;
      SetBitmapBits(bmp.Handle, m_lpstCurrWilImageInfo.shWidth * m_lpstCurrWilImageInfo.shHeight * sizeof(word) , @pBits[0]);
      if ((nDstMaxWidth>0) and (nDstMaxHeight>0)) then begin
        X:=nDstMaxWidth;
        Y:=nDstMaxHeight;
        GetScaleSize(X,Y,m_lpstCurrWilImageInfo.shWidth, m_lpstCurrWilImageInfo.shHeight);
        ScaleBmp:=TBitMap.Create;
        ScaleBmp.Width:=X;
        ScaleBmp.Height:=Y;
        ScaleBmp.PixelFormat:=pf16bit;
        rc.TopLeft:=Point(0,0);
        rc.BottomRight:=Point(X,Y);
        with ScaleBmp.Canvas do            //调整适合的显示大小
         begin
          Pen.Style := psDash;
          Brush.Style := bsClear;
          Rectangle(0, 0, X, Y);
          StretchDraw(rc, TGraphic(bmp));
        end;
        bmp.Free;
        ReSult:=ScaleBmp;
      end else ReSult:=bmp;
    end;
  finally
    SetLength(pBits,0);
  end;
  
end;

procedure TWilImageData.BreakTimerTimer(Sender: TObject);
begin
  try
    m_bBreak:=true;
  finally
    m_BreakTimer.Enabled:=false;
  end;
end;

procedure TWilImageData.CopyImageInfo(Wi:PWILIMAGEINFO;WWi:PWHOLEWILIMAGEINFO;bReverse:boolean);
begin
  if not bReverse then begin
    WWi.shWidth      := Wi.shWidth;
    WWi.shHeight     := Wi.shHeight;
    WWi.shPX         := Wi.shPX;
    WWi.shPY         := Wi.shPY;
    WWi.bShadow      := Wi.bShadow;
    WWi.shShadowPX   := Wi.shShadowPX;
    WWi.shShadowPY   := Wi.shShadowPY;
    WWi.dwImageLength:= Wi.dwImageLength;    
  end else begin
    Wi.shWidth      := WWi.shWidth;
    Wi.shHeight     := WWi.shHeight;
    Wi.shPX         := WWi.shPX;
    Wi.shPY         := WWi.shPY;
    Wi.bShadow      := WWi.bShadow;
    Wi.shShadowPX   := WWi.shShadowPX;
    Wi.shShadowPY   := WWi.shShadowPY;
    Wi.dwImageLength:= WWi.dwImageLength;  
  end;
end;

function  TWilImageData.CheckImageLenError:boolean;
begin
  m_bBreak:=false;
  m_BreakTimer.Enabled:=true;  //如果计算超过5秒,则认为下面这个子程序进入了死循环,所以把图片置无效.
  ReSult:= DrawWithImageForCompMemToMem();
  m_BreakTimer.Enabled:=false;
end;

function TWilImageData.DrawWithImageForCompMemToMem(pDst:Pointer):boolean;
var nWidth,nHeight,nXOffset,nYOffset,nStartX,nStartY,nEndX,nEndY:integer;
    nWidthStart,nWidthEnd,nCurrWidth,nCntCopyWord,nYCnt,nLastWidth:integer;
    x:integer;
    rc:TRECT;
    nX, nY, nXSize, nYSize, nDstXSize,nDstYSize,nSize:integer;
    pwSrc:Cardinal;
    pwDst:array of word;
begin

  nX:=0;
  nY:=0;
  nXSize:=m_lpstCurrWilImageInfo.shWidth;
  nYSize:=m_lpstCurrWilImageInfo.shHeight;
  nDstXSize:=nXSize;
  nDstYSize:=nYSize;

	nWidth		:= nXSize;
	nHeight		:= nYSize;
	nXOffset	:= 0;
	nYOffset	:= 0;
	nStartX		:= 0;
	nStartY		:= 0;
	nEndX		  := nDstXSize - 1;
	nEndY		  := nDstYSize - 1;

  nWidthStart	 := 0;
	nWidthEnd	   := 0;
	nCurrWidth   := 0;
	nCntCopyWord := 0;
	nYCnt        := 0;
	nLastWidth   := 0;

  nSize:= nXSize*nYSize * 2;

  ReSult:=false;
  m_nCalLen:=0;

	if (m_pbCurrImage<>nil) then begin

    pwSrc:=dword(m_pbCurrImage);
    pwDst:=pDst;

		if (nX<nStartX) then begin
			nXOffset	:= nStartX - nX;
			nWidth		:= nXSize - nXOffset;
		end;

		if ((nX+nXSize-1)>nEndX) then nWidth := nEndX - nX - nXOffset + 1;

		if (nY<nStartY) then begin
			nYOffset	:= nStartY - nY;
			nHeight		:= nYSize - nYOffset;
		end;

		if ((nY+nYSize-1)>nEndY) then nHeight	:= nEndY - nY - nYOffset + 1;

		if ((nWidth > 0) and (nHeight> 0)) then begin

			rc.left		:= nXOffset;
			rc.right	:= nXOffset+nWidth;
			rc.top		:= nYOffset;
			rc.bottom	:= nYOffset+nHeight;

			for nYCnt:=0 to rc.top -1 do begin
				nWidthEnd   :=  nWidthEnd + PWORD(pwSrc + nWidthStart + nWidthStart)^;
				nWidthStart :=  nWidthStart +1 ;
				nWidthEnd   :=  nWidthEnd+1;
				nWidthStart	:=  nWidthEnd;
        if m_bBreak then begin
          ReSult:=True;
          Exit;
        end;
			end;

			for nYCnt:=rc.top to rc.bottom -1 do begin

        if m_bBreak then begin
          ReSult:=True;
          Exit;
        end;

				nWidthEnd := nWidthEnd + PWORD(pwSrc + nWidthStart + nWidthStart)^;
				nWidthStart:= nWidthStart + 1;

        x:= nWidthStart;
				while x < nWidthEnd do begin

          if m_bBreak then begin
            ReSult:=True;
            Exit;
          end;

					if (PWORD(pwSrc + x + x )^ = $C0) then begin
						x:=x +1;
						nCntCopyWord := PWORD(pwSrc + x + x)^;
						x:=x + 1;
						nCurrWidth := nCurrWidth + nCntCopyWord;