⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 传奇3 ei3 / 1.45 / 3G 版本 wil 资源编辑器源代码!
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
              edit1.Color:=clMenuHighlight;
              edit2.Color:=clMenuHighlight;
              edit3.Color:=clMenuHighlight;
              edit4.Color:=clMenuHighlight;
            end;
        end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var tmpWILINFO,tmp:PWILFILEIMAGEINFO;
    bOk:boolean;
    I:Integer;
begin
  if fOpen.Count > 0 then
  begin
  NEW(tmpWILINFO);
  if not checkbox3.Checked then
  try
    tmpWILINFO^.shPX:=STRTOINT(edit1.Text);
    tmpWILINFO^.shPY:=STRTOINT(edit2.Text);
    tmpWILINFO^.shShadowPX:=STRTOINT(edit3.Text);
    tmpWILINFO^.shShadowPY:=STRTOINT(edit4.Text);
    tmpWILINFO^.dwImageLength:=mImgLen;
    tmpWILINFO^.shWidth:=mWidth;
    tmpWILINFO^.shHeight:=mHigh;
    tmpWILINFO^.bShadow:=mShadow;
    bOk:=fOpen.Modify(crPos,tmpWILINFO);
  finally
  dispose(tmpWILINFO);
  end
  else
    begin
      for I:=0 to fOpen.Count - 1 do
        begin
          tmp:=fOpen.InfoOfImage[I];
          if tmp<>nil then
            begin
             tmp.shPX:=0;
             tmp.shPY:=0;
             tmp.bShadow:=chr(0);
             tmp.shShadowPX:=0;
             tmp.shShadowPY:=0;
             fOpen.Modify(I,tmp);
             dispose(tmp);
            end;
        end;
    end;
  end;
end;

procedure TForm1.EI3WIL1Click(Sender: TObject);
var tpe:byte;
    Pname:string;
begin
  SD.Filter:='EI3-WIL-FILE (*.Wix)|*.wix';
  SD.FileName:=OD.FileName;
  if SD.Execute then
   begin
    Pname:=SD.FileName;
    if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.WIX';
    fOpen.SaveToFile(Pname,EI3);
    tpe:=fOpen.LoadFromFile(Pname);
          if tpe = EI3 then
          begin
            TSEI.Visible:=TRUE;
            TSGT.Visible:=FALSE;
          end
          else
          begin
            TSEI.Visible:=FALSE;
            TSGT.Visible:=TRUE;
          end;
    SB.Panels.Items[0].Text:='  '+Pname;
   end;
end;

procedure TForm1.GT3WIL1Click(Sender: TObject);
var tpe:byte;
    Pname:string;
begin
  SD.Filter:='GT3-WIL-FILE (*.Wix)|*.wix';
  if SD.Execute then
   begin
    Pname:=SD.FileName;
    if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.WIX';
    fOpen.SaveToFile(SD.FileName+'.WIX',GT3);
    tpe:=fOpen.LoadFromFile(Pname);
          if tpe = EI3 then
          begin
            TSEI.Visible:=TRUE;
            TSGT.Visible:=FALSE;
          end
          else
          begin
            TSEI.Visible:=FALSE;
            TSGT.Visible:=TRUE;
          end;
    SB.Panels.Items[0].Text:='  '+Pname;
   end;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  if Opfile<>'' then  fOpen.SaveToFile(Opfile,0);
end;

procedure TForm1.N24BitBMP2Click(Sender: TObject);
var Pname:string;
begin
  SD.Filter:='16位位图 (*.bmp)|*.bmp';
  if SD.Execute then
   begin
    Pname:=SD.FileName;
    if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.bmp';
    fOpen.ImageSaveToBmp(crPos,Pname);
   end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var tBitMap:HBITMAP;
    tmp:TStream;
begin
  tmp:=TStream.Create;
  tBitMap:=CreateBitMap(250,250,1,16,nil);
  IMG.Picture.Bitmap.Handle:=tBitMap;
end;

procedure TForm1.KEN2Click(Sender: TObject);
var Pname:string;
begin
  SD.Filter:='专用资源文件 (*.TPE)|*.TPE';
  if SD.Execute then
   begin
    Pname:=SD.FileName;
    if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.TPE';
    fOpen.ImageSaveToSeq(crPos,1,Pname);
   end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if ((CheckBox1.Checked) and (fOpen.Count > 0)) then
   begin
     T1.Enabled:=TRUE;
   end
  else
   begin
     T1.Enabled:=FALSE;
   end;
end;

procedure TForm1.T1Timer(Sender: TObject);
begin
  if CheckBox2.Checked then Button3.Click
  else Button4.Click;
  if ((CrPos=0) or (CrPos=fOpen.Count - 1) or (cRpOS=fOpen.GetNextValidImageIndex(crPos))) then
   begin
    CheckBox1.Checked:=FALSE;
    T1.Enabled:=False;
   end;
end;

procedure TForm1.N9Click(Sender: TObject);
var tId:DWORD;
begin
  if fOpen.Count > 0 then
  begin
  ImOrOut:=0;
  DL.Edit4.Text:=IntToStr(crPos);
  DL.BG.Caption:='导出信息设置';
  DL.Show;
  end;
end;

procedure TForm1.N8Click(Sender: TObject);
var Pname:string;
    tId:DWORD;
begin
  if fOpen.Count > 0 then
  begin
   OD.Filter:='专用资源文件 (*.TPE)|*.TPE';
   if OD.Execute then
   begin
    b3:=Button3.Handle;
    b4:=Button4.Handle;
    Infseq:=Od.FileName;
    ImOrOut:=1;
    o_Pos:=crPos;
    bImp:=False;
    DL.Edit4.Text:=IntToStr(crPos);
    DL.BG.Caption:='导入信息设置';
    DL.Show;
    ResetEvent(hEvent);
    CloseHandle(CreateThread(
    nil,0,
    @TForm1.ImThreadProc,nil,0,tId
    ));
   end;
  end;
end;

procedure TForm1.KEN1Click(Sender: TObject);
var Pname:string;
    aBitMap:TBITMAP;
begin
  OD.Filter:='专用资源文件 (*.TPE)|*.TPE';
  if OD.Execute then
   begin
    Pname:=OD.FileName;
    if fOpen.ImportFromSeq(crPos,1,Pname) then
    begin
     if crPos=0 then
      begin
        IMG.Picture.Bitmap.FreeImage;
        aBitMap:=fOpen.IndexOfBitMap[crPos];
        if aBitMap <> nil then begin
        IMG.Picture.Bitmap:=aBitMap;
        IMG.Repaint;
        IMG.Refresh;
        end;
      end
     else
      begin
       edit7.Text:=IntToStr(crPos);
       crPos:=0;
       Button4.Click;
      end;
    end;
   end;
end;

procedure TForm1.N12Click(Sender: TObject);
var Pname:string;
begin
  if fOpen.Count > 0 then
   begin
   OD.Filter:='专用资源文件 (*.TPE)|*.TPE';
   if OD.Execute then
   begin
    Pname:=OD.FileName;
    if fOpen.ImportFromSeq(fOpen.Count,1,Pname) then
     begin
       mImage := fOpen.Count;
       crPos:= fOpen.Count - 2;
       edit7.Text:=IntToStr(fOpen.Count - 1);
       Button4.Click;
     end;
   end;
   end;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
  close;
end;

function SaveMemToFile(fP:Pointer;size:DWORD;const fstr:string):DWORD;
var hfstr,hMap:Cardinal;
    hMem:Pointer;
begin
  ReSult:=0;
  hfstr:=CreateFile(
        pchar(fstr),
        GENERIC_READ + GENERIC_WRITE,
        FILE_SHARE_WRITE or FILE_SHARE_READ,
        0,
        OPEN_ALWAYS,
        FILE_ATTRIBUTE_NORMAL,
        0
        );
  if hfstr<>INVALID_HANDLE_VALUE then
    begin
      SetFilePointer(hfstr,size,0,FILE_BEGIN);
      SetEndOfFile(hfstr);
      hMap:=CreateFileMapping(hfstr,nil,PAGE_READWRITE,0,0,nil);
      if hMap<>0 then
        begin
         hMem:=MapViewOfFile(hMap,FILE_MAP_READ or FILE_MAP_WRITE,0,0,0);
         if hMem<>nil then
           begin
             CopyMemory(hMem,fP,size);
             UnmapViewOfFile(hMem);
           end;
         CloseHandle(hMap);
        end;
      CloseHandle(hfstr);
    end;
end;

function LoadFileToMem(var fP:Pointer;const fstr:string):DWORD;
var hfstr,hMap:Cardinal;
    hMem:Pointer;
begin
  hfstr:=CreateFile(
        pchar(fstr),
        GENERIC_READ OR GENERIC_WRITE,
        FILE_SHARE_WRITE or FILE_SHARE_READ,
        0,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL,
        0
        );
  if hfstr<>INVALID_HANDLE_VALUE then
    begin
      hMap:=CreateFileMapping(hfstr,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
             ReSult:=GetFileSize(hfstr,0);
             GetMem(fP,ReSult);
             CopyMemory(fP,hMem,ReSult);
             UnmapViewOfFile(hMem);
           end;
         CloseHandle(hMap);
        end;
      CloseHandle(hfstr);
    end;
end;

procedure TForm1.N16Click(Sender: TObject);
var buf:Pointer;
    ptmp,ptmp2:DWORD;
    bfWidth,bfHight:WORD;
    I:INTEGER;
    A:array[0..255] of BYTE;
    B:array[0..255] of smallint;
    C:array[0..255] of Integer;
    bfIndex:Byte;
    bfTitlecs:WORD;
    fz,nCount:DWORD;
    bObj1Ani,bObj2Ani:Byte;
    wObj1: WORD;
    wObj2: WORD;
begin
  if OD2.Execute then
   begin
     nCount:=0;
     fz:=LoadFileToMem(buf,OD2.FileName);
     bfWidth:=PDWORD(DWORD(buf)+22)^;
     bfHight:=PDWORD(DWORD(buf)+24)^;
     for I:=0 to  bfWidth*(bfHight div 4)-1 do
      begin
        ptmp:=$1c+ DWORD(buf) + I*3;
        bfIndex:=PByte(ptmp)^;
        bfTitlecs:=PWORD(ptmp+1)^;
        if ((bfIndex>=$2D) and (bfIndex<=$37) and (bfTitlecs<>65535)) then
         begin
           if ((bfIndex<>$31) and (bfIndex<>$32)) then
            begin
              bfIndex:=bfIndex-$2D;
              bfTitlecs:=bfTitlecs+Value[bfIndex];
              PByte(ptmp)^:=bfIndex;
              PWORD(ptmp+1)^:=bfTitlecs;
            end;
         end;
      end;
     for I:=0 to  bfWidth*bfHight-1 do
       begin
        ptmp2:=$1c + DWORD(buf) + bfWidth*(bfHight div 4)*3+14*I;
        bfIndex:=Pbyte(ptmp2+4)^;
        if ((bfIndex>=$2D) and (bfIndex<=$37)) then
          begin
            bfIndex:=bfIndex-$2D;
            Pbyte(ptmp2+4)^:=bfIndex;
            PWord(ptmp2+5)^:=PWord(ptmp2+5)^+Value[bfIndex];
          end;
        bfIndex:=Pbyte(ptmp2+3)^;
        if ((bfIndex>=$2D) and (bfIndex<=$37)) then
          begin
            bfIndex:=bfIndex-$2D;
            Pbyte(ptmp2+3)^:=bfIndex;
            PWord(ptmp2+7)^:=PWord(ptmp2+7)^+Value[bfIndex];
          end;
        end;
     SaveMemToFile(buf,fz,Od2.FileName);
     freemem(buf);
   end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -