rtlwil.~pas

传奇3 ei3 / 1.45 / 3G 版本 wil 资源编辑器源代码!

          0,
          CREATE_ALWAYS,
          FILE_ATTRIBUTE_NORMAL,
          0
          );
        if hseq <> INVALID_HANDLE_VALUE then
         begin
          SetFilePointer(hseq,bfSize + sizeof(DWORD)*(ImageS+2),0,FILE_BEGIN);
          SetEndOfFile(hseq);
          hMap:=CreateFileMapping(hseq,nil,PAGE_READWRITE,0,0,nil);
          if hMap<>0 then
           begin
            hMem:=MapViewOfFile(hMap,FILE_MAP_WRITE OR FILE_MAP_READ,0,0,0);
            if hMem<>nil then
             begin
              CopyMemory(hMem,@seqHeader[0],sizeof(DWORD)*(ImageS+2));
              CopyMemory(Pointer(DWORD(hMem)+sizeof(DWORD)*(ImageS+2)),seqImageBuf,bfSize);
              UnmapViewOfFile(hMem);
             end;
            CloseHandle(hMap);
           end;
          CloseHandle(hseq);
         end;
        freemem(seqImageBuf);
      end;
     SetLength(seqHeader,0);
   end;
end;

function TWIL.GetPrevValidImageIndex(CurrentIndex:integer):INTEGER;
var i:integer;
begin
  ReSult:=CurrentIndex;
  if ((CurrentIndex>0) and  (CurrentIndex < FImageCount)) then
   begin
     for i:=CurrentIndex-1 downto 0 do
      begin
        if OffsetOfImage[i]<>0 then
         begin
          ReSult:=i;
          break;
         end;
      end;
   end;
end;

function TWIL.GetNextValidImageIndex(CurrentIndex:integer):integer;
var i:integer;
begin
  ReSult:=CurrentIndex;
  if ((CurrentIndex>=0) and  (CurrentIndex < FImageCount)) then
   begin
     for i:=CurrentIndex+1 to FImageCount - 1 do
      begin
        if OffsetOfImage[i]<>0 then
         begin
          ReSult:=i;
          break;
         end;
      end;
   end;
end;

function TWIL.CreateSaveBitMap(Index:integer):tbitmap;
var hBm,nBm:tbitmap;
    RS:DWORD;
    tmpWILFILEIMAGEINFO:PWILFILEIMAGEINFO;
    bufBitMap:array of WORD;
    Width,High,tStart,i,j:WORD;
begin
  ReSult:=nil;
  try
  if Index < FImageCount then
   begin
     RS:=OffsetOfImageColorBuf[Index];
     if RS<>0 then begin
       tmpWILFILEIMAGEINFO:=InfoOfImage[Index];
       Width:=tmpWILFILEIMAGEINFO^.shWidth;
       High:=tmpWILFILEIMAGEINFO^.shHeight;
       ImageFromCompMemToResMem(0,0,Width,High,TARRAY(RS),Width,High,$F81F);
       hBm:=TBitMap.Create;
       hBm.Width:=Width;
       hBm.Height:=High;
       hbm.PixelFormat:=pf16bit;
       if G3 then tStart:=Width else tStart:=0;
       SetBitmapBits(hBm.Handle,Width*High*sizeof(WORD),@Image[tStart]);
       dispose(tmpWILFILEIMAGEINFO);
			 ReSult:=hBm;
     end;
   end;
  except end;
end;

procedure TWIL.ImageSaveToBmp(Index:integer;const fBmp:string);
var SBitMap:TBitMap;
begin
  SBitMap:=CreateSaveBitMap(Index);
  if SBitMap <> nil then
   begin
     SBitMap.SaveToFile(fBmp);
     SBitMap.Free;
   end;
end;

procedure TWIL.ImageClean(tWidth,tHigh:integer;Mask:WORD);
var i:integer;
begin
  for i:=0 to tWidth*tHigh - 1 do Image[i]:=Mask;
end;

function TWIL.CreatBitMap(Index:integer):tbitmap;
var hBm,nBm:tbitmap;
    RS,nWidth,nHigh:DWORD;
    tmpWILFILEIMAGEINFO:PWILFILEIMAGEINFO;
    bufBitMap:array of WORD;
    Width,High,tStart,i,j:WORD;
    rc:TRECT;
begin
  hBm:=nil;
  nBm:=nil;
  try
  if Index < FImageCount then
   begin
     RS:=OffsetOfImageColorBuf[Index];
     if RS<>0 then begin
       tmpWILFILEIMAGEINFO:=InfoOfImage[Index];
       Width:=tmpWILFILEIMAGEINFO^.shWidth;
       High:=tmpWILFILEIMAGEINFO^.shHeight;
       ImageFromCompMemToResMem(0,0,Width,High,TARRAY(RS),Width,High,0);
       hBm:=TBitMap.Create;
       hBm.Width:=Width;
       hBm.Height:=High;
       hbm.PixelFormat:=pf16bit;
       if G3 then tStart:=Width else tStart:=0;
       SetBitmapBits(hBm.Handle,Width*High*sizeof(WORD),@Image[tStart]);
       dispose(tmpWILFILEIMAGEINFO);
       if (Width > 255) or (High>255) then
       begin
         if ((Width > 255) and (High>255)) then
          begin
           if Width >= High then
            begin
              nWidth:=255;
              nHigh:=Round(High*255/Width);
            end
           else
            begin
              nHigh:=255;
              nWidth:=Round(nWidth*255/High);
            end;
          end
         else if Width > 255 then
          begin
            nWidth:=255;
            nHigh:=Round(High*255/Width);
          end
         else
          begin
             nHigh:=255;
             nWidth:=Round(nWidth*255/High);
          end;
         rc.TopLeft:=Point(0,0);
         rc.BottomRight:=Point(nWidth,nHigh);
         nbm:=TBitMap.Create;
         nbm.Width:=nWidth;
         nbm.Height:=nHigh;
         with nbm.Canvas do            //调整适合的显示大小
           begin
            Pen.Style := psDash;
            Brush.Style := bsClear;
            Rectangle(0, 0, nbm.Width, nbm.Height);
            StretchDraw(rc, TGraphic(hBm));
           end;
         ReSult:=nBm;
         hBm.Free;
       end
       else ReSult:=hBm;
     end;
   end;
  except
   if nBm<>nil then nBm.Free;
   ReSult:=hBm;
  end;
end;

function TWIL.GetImageDataBuf(Index:integer):DWORD;
var RS:DWORD;
begin
  if Index < FImageCount then
   begin
     RS:=OffsetOfImage[Index];
     if RS <> 0 then
      begin
       RS := RS + PWIL + sizeWILINFO;
//       if G3 then RS:=RS+4;
      end;
   end;
  RESULT:=RS;
end;

function TWIL.ImageFromCompMemToResMem(nX,nY,nXSize,nYSize:integer;pwSrc:array of WORD;nDstXSize,nDstYSize:integer;MaskColor:WORD):boolean;
var rc:TRECT;
    x,nWidth,nHeight,nXOffset,nYOffset,nStartX,nStartY,nEndX,nEndY:integer;
    nWidthStart,nWidthEnd,nCurrWidth,nCntCopyWord,nYCnt,nLastWidth:integer;
    tmp,tmp2,i,j:DWORD;
    tempColor:PtagColor;
    TC:DWORD;
    G3T:Integer;
begin
  if G3 then G3T:=0 else G3T:=1;
  SetLength(Image,nDstXSize*nDstYSize*2);
  ImageClean(nDstXSize+1,nDstYSize+1,MaskColor);
  ReSult:=FALSE;
  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;
  if @Image<>nil then
   begin
    NEW(tempColor);
    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 - GT3  do
       begin
				nWidthEnd := nWidthEnd + pwSrc[nWidthStart];
				Inc(nWidthStart);
				Inc(nWidthEnd);
				nWidthStart	:= nWidthEnd;
       end;
      for nYCnt:=rc.Top to rc.Bottom  - GT3  do
       begin
				nWidthEnd := nWidthEnd + pwSrc[nWidthStart];
				Inc(nWidthStart);
        X:=nWidthStart;
        WHILE X < nWidthEnd do
         begin
					if ( pwSrc[x] = $C0 ) then
					 begin
						Inc(X);
						nCntCopyWord := pwSrc[x];
						Inc(X);
						nCurrWidth := nCurrWidth +nCntCopyWord;
           end
          else if (pwSrc[x] = $C1) or (pwSrc[x]=$C2) or (pwSrc[x]=$C3) then
           begin
						INC(x);
						nCntCopyWord := pwSrc[x];
						INC(x);
						nLastWidth := nCurrWidth;
						nCurrWidth := nCurrWidth +nCntCopyWord;
            if ( rc.left > nCurrWidth) or (rc.right < nLastWidth ) then
             begin
              x := x +  nCntCopyWord;
             end
            else
             begin
							if ( (nLastWidth < rc.left) and (rc.left <= nCurrWidth) ) then
							 begin
								x := x + (rc.left-nLastWidth);
								copymemory(@Image[((nYCnt+nY) * nDstXSize) + (rc.left+nX)], @pwSrc[x], sizeof(WORD)*(nCurrWidth-rc.left));
								x := x + (nCurrWidth-rc.left);
							 end
							else if ( (nLastWidth <= rc.right) and (rc.right < nCurrWidth )) then
							 begin
								copymemory(@Image[((nYCnt+nY) * nDstXSize) + (nLastWidth+nX)], @pwSrc[x], sizeof(WORD)*(rc.right-nLastWidth));
								x := x +  nCntCopyWord;
							 end
              else
               begin
								copymemory(@Image[((nYCnt+nY) * nDstXSize) + (nLastWidth+nX)], @pwSrc[x], sizeof(WORD)*nCntCopyWord);
								x := x + nCntCopyWord;
               end;
             end;
           end
         end;
				INC(nWidthEnd);
				nWidthStart	:= nWidthEnd;
				nCurrWidth := 0;
       end;
     end;
//   ImageAdjust(nDstXSize,nDstYSize);
   ReSult:=TRUE;
   end;
end;

procedure TWIL.Bit16To24Bit(dscolor:PtagColor;rscolor:WORD);
begin
  dscolor^.B:=BYTE((rscolor and $001F) SHL 3);
  dscolor^.G:=BYTE((rscolor and $07E0) SHR 3);
  dscolor^.R:=BYTE((rscolor and $F800) SHR 8);
end;

function TWIL.Bit24To16Bit(Pcolor:PtagColor):WORD;
begin
  ReSult:=((WORD(Pcolor^.R) and $00F8) SHL 8)+((WORD(Pcolor^.G) and $00FC) SHL 3)+((WORD(Pcolor^.B)) SHR 3)
end;

function IsCtype(VL:WORD):Boolean;
begin
  ReSult:=FALSE;;
  if ((VL=$C1) or (VL=$C2) or (VL=$C3)) then ReSult:=TRUE;
end;

procedure  TWIL.SetWilSize(nSize:DWORD);
begin
  FSize:=nSize;
end;

procedure TWIL.SetOffset(Index:integer;Offset:DWORD);
begin
  if Index < FImageCount then PDWORD(POffsetIndex+Index*4)^:=Offset;
end;

procedure TWIL.Adjust;         //优化
var i:integer;
    BitDataOffset,BitMapLength,ImageOffset,nSize:DWORD;
    BitMapInfo:array[1..sizeWILINFO] of BYTE;
    ImageHeader:array[1..sizeWILHEADER] of BYTE;
    BitMapHigh,tmp:WORD;
    PBitMap,PImage,npAdImage:Pointer;
    adT:BYTE;
begin
  try
  if FImageCount > 0 then
   begin
    if G3 then adT:=GT3 else adT:=EI3;
    GetMem(PImage,FSize);
    Zeromemory(PImage,FSize);
    CopyMemory(@ImageHeader,Pointer(PWIL),sizeWILHEADER);
    PWILFILEHEADER(@ImageHeader)^.nImageCount := FImageCount;
    CopyMemory(PImage,@ImageHeader,sizeWILHEADER);
    ImageOffset:=sizeWILHEADER;