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

📄 mainunit.~pas

📁 MU仓库编辑器 (转发)
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
  try
  execute;
  result:=true;
  except
  on e:exception do begin
  application.MessageBox(pchar(e.Message),'错误',mb_ok+mb_iconerror);
  result:=false;
  end;
  end;
  end;
end;

function IsNum(const S:string):boolean; {是否是数字}
begin
  result:=StrToIntDef(S,0)=StrToIntDef(S,1);
end;

function GetItemProp(ID:string;Unique:string):itemproperty;
begin
  with frmmain.itemQuery do begin
       sql.Clear;
       sql.Add('select name,x,y from muitem where id='''+id+''' and unique='+unique+'');
       open;
       if eof and bof then
          result.Name:='miss'
       else begin
         result.Name :=fields[0].AsString;
         result.X:=fields[1].AsInteger;
         result.Y:=fields[2].AsInteger;
       end;
       close;
  end;
end;

procedure editlock();  {禁止编辑}
var i:integer;
begin
  frmmain.edtZen.Enabled:=false;
  for i:=0 to frmmain.Panel1.ControlCount -1 do begin
       frmmain.Panel1.Controls[i].Enabled:=false;

  end;
  frmmain.Label2.Enabled:=false;
  frmmain.Label17.Enabled:=false;
  for i:=0 to frmmain.Panel3.ControlCount -1 do begin
       frmmain.Panel3.Controls[i].Enabled:=false;

  end;
  for i:=0 to frmmain.GroupBox1.ControlCount  -1 do begin
       frmmain.GroupBox1.Controls[i].Enabled:=false;

  end;
  frmmain.btnExit.Enabled:=true;
  frmmain.btnHelp.Enabled:=true;
end;

procedure editunlock();  {允许编辑}
var i:integer;
begin
  frmmain.edtZen.Enabled:=true;
  frmmain.Label2.Enabled:=true;
  frmmain.Label17.Enabled:=true;
  for i:=0 to frmmain.Panel1.ControlCount -1 do begin
       frmmain.Panel1.Controls[i].Enabled:=true;

  end;
  for i:=0 to frmmain.GroupBox1.ControlCount  -1 do begin
       frmmain.GroupBox1.Controls[i].Enabled:=true;

  end;
  for i:=0 to frmmain.Panel3.ControlCount -1 do begin
       frmmain.Panel3.Controls[i].Enabled:=true;

  end;
end;

function GetTag(const I:integer):integer ;  {返回卓越属性代码给卓越checkbox的tag}
begin
 case i of
 1:result:=1;
 2:result:=2;
 3:result:=4;
 4:result:=8;
 5:result:=16;
 6:result:=32;
 end;
end;


procedure FillHexWS(item:TField); {填充某个账户的仓库}
type Tcharset=set of char;
var A:tcharset;
    itemblock:array of byte;
    sWS,sItem,sUni:string;
    wsrow,wscol,i,panelcount:integer;
    itemnow:itemproperty;
    itemoptnow:itemoption;
begin

  a:=['0'..'7'];
  with item do begin
      setlength(itemblock,datasize);
      try
      getdata(itemblock);
      {截取仓库的16进制代码}
      for i:=2 to high(itemblock) do begin
          sws:=sws+uppercase(bytetohex(itemblock[i]));
      end;
      panelcount:=0;
      for wsrow:=0 to 14 do
        for wscol:=0 to 7 do begin
            sitem:=midstr(sws,160*(wsrow)+20*(wscol)+1,20);
            if (sitem<>'FFFFFFFFFFFFFFFFFFFF') and (sitem<>'FF000000000000000000') and (sitem<>'00000000000000000000') then inc(panelcount);
        end;

      if panelcount=0 then exit;//仓库里没有物品

      for wsrow:=0 to 14 do
        for wscol:=0 to 7 do begin
          sitem:=midstr(sws,160*(wsrow)+20*(wscol)+1,20);
          warehouse[wsrow,wscol]:=sitem;
          if (sitem='FFFFFFFFFFFFFFFFFFFF') or (sitem='FF000000000000000000') or (sitem='00000000000000000000') then sitem:='';
          if sitem<>'' then begin
             if sitem[15] in a then suni:='0' else suni:='8';
             itemnow:=getitemprop(leftstr(sitem,2),suni);
             if itemnow.Name='miss' then begin
                showmessage('发现一不明物体,在仓库位置'+inttostr(wsrow)+','+inttostr(wscol));
                continue;
             end;
             itemoptnow:=getitemoption(sitem[3]+sitem[4],sitem[5]+sitem[6],sitem[15]+sitem[16],itemnow.name);


             if itemnow.Name='miss' then
                if application.MessageBox(pchar('发现仓库中不明物体。编码:'+sitem+#13+'是否加入该物品?'),'不明物体',mb_yesno+mb_iconwarning)=id_no then
                   continue;
             if intowsgrid(wsrow,wscol,itemnow,itemoptnow)=false then application.MessageBox(pchar('物品加入失败。编码:'+sitem+#13+'位置:'+inttostr(wsrow+1)+','+inttostr(wscol+1)),'警告',mb_ok+mb_iconwarning);
          end;

        end;
        
      except
      on E:exception do application.MessageBox(pchar(e.Message),'错误',mb_ok+mb_iconerror);


      end;
  end;
end;

procedure Typechange(const S:string); {物品大类变更}
var i:integer;
begin
 itemspc:=nil;
 with frmmain do begin
     try
     lblspace.Caption :='物品所占空间:0x0';
     cboitem.Items.Clear;
     itemquery.SQL.Clear;
     itemquery.SQL.Add('select name,x,y from muitem where type='''+s+'''');
     itemquery.Open;
     if not (itemquery.Eof and itemquery.Bof) then begin
        setlength(itemspc,itemquery.RecordCount);
        for i:=0 to itemquery.RecordCount-1 do begin
          cboitem.Items.Add(itemquery.Fields[0].asstring);
          itemspc[i]:=itemquery.Fields[1].AsString+'x'+itemquery.Fields[2].AsString ;
          itemquery.Next;
        end;
     end;
     cboitem.ItemIndex:=0;
     lblspace.Caption :='物品所占空间:'+itemspc[0];
     finally
     itemquery.Close ;
     end;
 end;
end;

//自定义函数结束================================================================

//自定义事件触发================================================================
procedure tfrmmain.lblClick(sender:tobject);
begin
  application.MessageBox (pchar((sender as tpanel).Hint),'物品信息',mb_ok+mb_iconinformation);
end;

procedure tfrmmain.cellClick(sender:tobject);
var sHint:string;
begin
  
  if cbox.Enabled then begin
     shint:=(sender as tspeedbutton).Hint ;
     cbox.ItemIndex:=strtoint(leftstr(shint,2))-1;
     cboy.ItemIndex:=strtoint(rightstr(shint,2))-1;
  end;
end;

procedure tfrmmain.lblmousedown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
begin
  currentitem:=midstr((sender as tpanel).Name,2,4);
end;
procedure Tfrmmain.lblMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var wsPos:string;
    iName:string;
begin
  wspos:=midstr((sender as tpanel).Name,2,4);
  iname:=(sender as tpanel).Caption ;
  edtshow.Text :=iname+':'+warehouse[strtoint(leftstr(wspos,2)),strtoint(rightstr(wspos,2))];

end;
//自定义事件触发结束============================================================

procedure TfrmMain.FormCreate(Sender: TObject);
var i:integer;
begin
 if isskin='1' then begin
 skdata.LoadFromCollection(skstore,0);
 if not skdata.Active then
    skdata.Active:=true;
 end;
 initws;
 editlock;
 muquery.ConnectionString:='Provider=MSDASQL.1;Password='+mupwd+';Persist Security Info=True;User ID='+muid+';Data Source='+mudsn+';Initial Catalog='+mudsn;
 cmtdb.ConnectionString:=muquery.ConnectionString;
 itemquery.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFilePath(Application.ExeName)+'muitem.mdb'+';Mode=ReadWrite;Persist Security Info=False';
 muquery.SQL.Add('select accountid,money from warehouse');
 muquery.Open;
 if (muquery.Eof) and (muquery.Bof) then
    application.MessageBox('无法连接到数据库'+#13+'可能是admin密码不对或没有角色','无法连接',mb_iconwarning)
 else begin
   for i:=0 to muquery.RecordCount-1 do begin
     cboid.Items.Add(muquery.Fields[0].asstring);
     muquery.Next;
   end;
  end;
  muquery.Close;
  itemquery.SQL.Add('select distinct type from muitem');
  itemquery.Open;
  while not itemquery.Eof do begin
    cbotype.Items.Add(itemquery.Fields[0].asstring);
    itemquery.Next;
  end;
  itemquery.Close;
  cbotype.ItemIndex:=0;
  typechange(cbotype.Text );
  self.Update;
end;

procedure TfrmMain.btnHelpClick(Sender: TObject);
begin

 frmsd.ShowModal;
end;


procedure TfrmMain.btnExitClick(Sender: TObject);
begin
 application.Terminate;
end;



procedure TfrmMain.zy1Click(Sender: TObject);
begin
 with (sender as Tcheckbox) do begin
   if (name<>'jn') and (name<>'xy') then begin
      if checked then tag:=gettag(strtoint(name[3])) else tag:=0;
   end;
 end;
end;

procedure TfrmMain.cboitemChange(Sender: TObject);
begin
 lblspace.Caption:='物品所占空间:'+itemspc[cboitem.itemindex];
end;

procedure TfrmMain.btnSaveClick(Sender: TObject);
begin
 if not(isnum(edtzen.Text )) then begin
    application.MessageBox('钱必须是数字哦','错误',mb_iconerror);
    exit;
 end;

 if warehousecommit then application.MessageBox('数据已保存','提示',mb_ok+mb_iconinformation) else
 application.MessageBox('数据没有保存','提示',mb_ok+mb_iconwarning);

end;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
var i,t:integer;
begin
 if application.MessageBox('确认请空仓库?','确认',mb_yesno+mb_iconwarning)=idno then exit;
 for i:=0 to 14 do begin
     for t:=0 to 7 do begin
         warehouse[i,t]:='FFFFFFFFFFFFFFFFFFFF'
     end;

 end;
 resetws;
end;





procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 freews;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
 freews;
end;

procedure TfrmMain.N1Click(Sender: TObject);
var i:integer;
begin
 i:=getlblindex('L'+currentitem);
 application.MessageBox (pchar(panel2.Controls[i].Hint),'物品信息',mb_ok+mb_iconinformation);
end;

procedure TfrmMain.N3Click(Sender: TObject);
var i,t:integer;
begin
  if application.MessageBox('确认删除该物品么?','警告',mb_yesno+mb_iconquestion)=id_no then exit;
  {清除文本标签}
  i:=getlblindex('L'+currentitem);
  frmmain.Panel2.Controls[i].Free;
  {从warehouse数组中删除物品}
  i:=strtoint(leftstr(currentitem,2));
  t:=strtoint(rightstr(currentitem,2));
  warehouse[i,t]:='FFFFFFFFFFFFFFFFFFFF';
  {释放仓库空间}
  killitem(currentitem);
end;

procedure TfrmMain.cboTypeChange(Sender: TObject);
begin
 typechange(cbotype.Text );
end;

procedure TfrmMain.btnINClick(Sender: TObject);
var sthisitem,smain,sopt,sdur,spos15,sex,sser:string;
    ixy,izj,i:integer;
    insProp:itemproperty;
    insOpt:itemoption;
begin
   if trim(cboitem.Text)='' then begin
      application.MessageBox('大哥,你还没选物品呢!','错误',mb_ok+mb_iconwarning);
      exit;
   end;
   if (isnum(edtdur.Text )=false) then begin
      application.MessageBox('耐久度必须是正整数!','错误',mb_ok+mb_iconwarning);
      exit;
   end;
   if (strtoint(edtdur.Text)>255) or (strtoint(edtdur.Text)<0) then begin
      application.MessageBox('注意:耐久度必须在0-255之间','错误',mb_ok+mb_iconwarning);
      exit;
   end;
   insprop.Name:=cboitem.Text ;
   insprop.X:=strtoint(lblspace.Caption[pos('x',lblspace.Caption)-1]);
   insprop.y:=strtoint(lblspace.Caption[pos('x',lblspace.Caption)+1]);
   itemquery.SQL.Clear;
   itemquery.SQL.Add('select id,unique,x,y from muitem where name='''+cboitem.Text +'''');
   itemquery.Open ;
   smain:=itemquery.Fields[0].AsString ;
   spos15:=itemquery.Fields[1].AsString ;
   itemquery.Close ;
   if xy.Checked then ixy:=4 else ixy:=0;
   if cboopt.ItemIndex =4 then
     begin
      izj:=0;
      if spos15='0' then spos15:='4' else spos15:='C';
     end
   else
   izj:=cboopt.ItemIndex;

   sopt:=inttohex(128*abs(strtoint(booltostr(jn.checked)))+ixy+izj+8*cbolvl.ItemIndex,2);
   sdur:=inttohex(strtoint(edtdur.Text ),2);
   sex:=inttohex(zy1.Tag+zy2.Tag+zy3.Tag+zy4.Tag+zy5.Tag+zy6.Tag,2);
   if sex[1]='0' then sex:=sex[2];
   if length(sex)=2 then begin
      spos15:=getpos15(spos15,sex[1]);
      sex:=sex[2];

   end;
   insopt:=getitemoption(sopt,sdur,spos15+sex,cboitem.Text );
   randomize;
   for i:=1 to 4 do begin
       randomize;
       sser:=sser+inttostr(random(10));

   end;
   sthisitem:=smain+sopt+sdur+'00000000'+spos15+sex+sser;
   if intowsgrid(strtoint(cbox.Text )-1,strtoint(cboy.Text )-1,insprop,insopt) then
   warehouse[strtoint(cbox.Text)-1,strtoint(cboy.Text )-1]:=sthisitem;
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
begin
 frmaccount.ShowModal;
end;

procedure TfrmMain.btnExClick(Sender: TObject);
begin
 application.MessageBox(pchar('[--]左侧为武器、项链的卓越属性,右侧为防具、盾、戒指的卓越属性'+#13+#13+
                        '魔法:杀死怪物魔法增加 +魔法值/8--金钱增加 +40%'+#13+
                        '生命:杀死怪物生命增加 +生命值/8--防御率增加 +10%'+#13+
                        '速度:攻击(魔法)速度 +7--伤害反射 +5%'+#13+
                        '2%攻击:攻击力(魔力)提升 +2%--伤害减少 +4%'+#13+
                        '/20攻击:攻击力(魔力)提升 +角色等级/20--魔法值增加 +4%'+#13+
                        '卓越攻击:卓越一击几率增加 +10%--生命值增加 +4%'),'卓越属性对照',mb_ok+mb_iconinformation);
end;

procedure TfrmMain.cboIDKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if key=vk_return then frmmain.cboIDclick(cboid);
end;

procedure TfrmMain.cboIDClick(Sender: TObject);
begin
 screen.Cursor:=-11;
 editlock;
 application.ProcessMessages;
 try
    muquery.SQL.Clear;
    muquery.SQL.Add('select money,items from warehouse where accountid='''+cboid.text+'''');
    muquery.Open ;
    if (muquery.Eof) and (muquery.Bof) then begin
       application.MessageBox('没有这个账户,检查一下是不是名字打错了?','提示',mb_ok+mb_iconerror);
       screen.Cursor:=0;
       muquery.Close;
       exit;
    end;
    resetws;
    fillhexws(muquery.Fields[1]);
    edtzen.Text :=muquery.Fields[0].AsString ;
    muquery.Close;

 editunlock;
 finally
 screen.Cursor:=0;
 end;
end;

procedure TfrmMain.BitBtn3Click(Sender: TObject);

begin
 frmitemforall:=tfrmitemforall.Create(self);
 frmitemforall.ShowModal;
end;

end.




⌨️ 快捷键说明

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