itemforall.pas

MU仓库编辑器 （转发）

unit itemForAll;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ValEdit, ExtCtrls, StdCtrls, ComCtrls, ADODB, DB, dec,
  strUtils;

type
  TfrmItemForAll = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    StatusBar1: TStatusBar;
    btnStart: TButton;
    btnBack: TButton;
    lblInfo: TLabel;
    Panel3: TPanel;
    Label4: TLabel;
    Label5: TLabel;
    Bevel2: TBevel;
    cboID: TComboBox;
    btnInID: TButton;
    btnOutID: TButton;
    LBID: TListBox;
    muQuery: TADOQuery;
    cmtDB: TADOCommand;
    itemQuery: TADOQuery;
    btnIDAll: TButton;
    btnIDAllOut: TButton;
    Bevel1: TBevel;
    btnIn: TButton;
    btnOut: TButton;
    cboItem: TComboBox;
    cboType: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    VLitem: TValueListEditor;
    mLog: TMemo;
    Label6: TLabel;
    edtZen: TEdit;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure cboTypeChange(Sender: TObject);
    procedure btnInIDClick(Sender: TObject);
    procedure btnOutIDClick(Sender: TObject);
    procedure btnIDAllClick(Sender: TObject);
    procedure btnIDAllOutClick(Sender: TObject);
    procedure btnOutClick(Sender: TObject);
    procedure btnInClick(Sender: TObject);
    procedure btnBackClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type IDINFO=record
     Exist:boolean;
     Money:string;
     IDWS:array[0..14,0..7] of string;
end;
type itemSPC=record
     X:integer;
     Y:integer;
end;
var
  frmItemForAll: TfrmItemForAll;
implementation

{$R *.dfm}

function bytetohex(src: byte): string;   {byte-->hex}
begin
  setlength(result, 2);
  asm
  mov edi, [result]
  mov edi, [edi]
  mov al, src
  mov ah, al // 保存至 ah
  shr al, 4 // 输出高4位
  add al, '0'
  cmp al, '9'
  jbe @@outcharlo
  add al, 'a'-'9'-1
@@outcharlo:
  and ah, $f
  add ah, '0'
  cmp ah, '9'
  jbe @@outchar
  add ah, 'a'-'9'-1
@@outchar:
  stosw
  end;
end;


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


procedure Typechange(const S:string); {物品大类变更}
var i:integer;
begin
 with frmitemforall do begin
     try

     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
        for i:=0 to itemquery.RecordCount-1 do begin
          cboitem.Items.Add(itemquery.Fields[0].asstring);
          itemquery.Next;
        end;
     end;
     cboitem.ItemIndex:=0;
     finally
     itemquery.Close ;
     end;
 end;
end;


function GetIDInfo(const ID:string):IDINFO ;
var itemblock:array of byte;
    sitem,sWarehouse:string;
    i,t,iItemBlock:integer;
begin
  with frmitemforall.muQuery do begin
    sql.Clear;
    sql.Add('select money,items from warehouse where accountid='''+id+'''');
    open;
    if eof and bof then begin
       result.Exist:=false;
       close;
       exit;
    end;
    result.Exist:=true;
    result.Money:=fields[0].AsString;
    if result.Money='' then result.Money:='0';
    setlength(itemblock,fields[1].DataSize);
    fields[1].GetData(itemblock);
    close;
  end;

    for iitemblock:=2 to high(itemblock) do begin
        swarehouse:=swarehouse+uppercase(bytetohex(itemblock[iitemblock]));
    end;
    for i:=0 to 14 do
      for t:=0 to 7 do begin
        sitem:=midstr(swarehouse,160*(i)+20*(t)+1,20);
        if (sitem<>'FFFFFFFFFFFFFFFFFFFF') and (sitem<>'FF000000000000000000') and (sitem<>'00000000000000000000') then
           result.IDWS[i,t]:=sitem +'0'    //这里每个仓库格子用21位代码，最后一位表示该位置有没有被占，初始化为没有被占
        else
           result.IDWS[i,t]:='FFFFFFFFFFFFFFFFFFFF0';  //同上
      end;
  
end;

function GetiSPC(const sName:string):itemspc ;
begin
  with frmitemforall.itemQuery do begin
    sql.Clear;
    sql.Add('select x,y from muitem where name='''+sname+'''');
    open;
    if eof and bof then begin
      result.X:=-1;
      result.Y:=-1;
      close;
      exit;
      end
    else begin
      result.X :=fields[0].AsInteger ;
      result.Y :=fields[1].AsInteger;
    end;
    close;
  end;
end;

function GetExistItemSpc(const S:string):itemspc ;
type Tcharset=set of char;
var A:tcharset;
    spos15:string;
begin
  a:=['0'..'7'];
  if s[15] in a then spos15:='0' else spos15:='8';
  with frmitemforall.itemQuery do begin
       sql.Clear;
       sql.Add('select x,y from muitem where id='''+leftstr(s,2)+''' and unique='+spos15);
       open;
       if eof and bof then begin
          result.X:=-1;
          result.Y:=-1;
          close;
          exit;
       end
       else begin
          result.X :=fields[0].AsInteger ;
          result.Y :=fields[1].AsInteger;
       end;
      close;
  end;
end;


function DBCommit(const cType:integer;const sDetail:string;const ID:string):boolean ;
var ssql:string;
begin
 if ctype=0 then
    ssql:='update warehouse set money='+sdetail+' where accountid='''+id+''''
 else
    ssql:='update warehouse set items=0x'+sdetail+' where accountid='''+id+'''';
 frmitemforall.cmtDB.CommandText:=ssql;
 frmitemforall.cmtDB.Execute;
 result:=true;
end;


/////////////////////////////////////////////////////
/////////////////////////////////////////////////////
/////////////////////////////////////////////////////
/////////////////////////////////////////////////////
/////////////////////////////////////////////////////

procedure TfrmItemForAll.FormCreate(Sender: TObject);
var i:integer;
begin
 muquery.ConnectionString:='Provider=MSDASQL.1;Password='+mupwd+';Persist Security Info=True;User ID='+muid+';Data Source='+mudsn+';Initial Catalog='+mudsn;
 cmtdb.ConnectionString:=muquery.ConnectionString;
 muquery.SQL.Add('select accountid from warehouse');
 itemquery.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFilePath(Application.ExeName)+'muitem.mdb'+';Mode=ReadWrite;Persist Security Info=False';
 muquery.Open;
 if (muquery.Eof) and (muquery.Bof) then
    application.MessageBox('无法连接到数据库'+#13+'可能是admin密码不对或没有角色','无法连接',mb_iconwarning)
 else begin
   lblinfo.Caption:='共有账户：'+inttostr(muquery.RecordCount)+'个  ';
   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;
  self.Update;

end;

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

procedure TfrmItemForAll.btnInIDClick(Sender: TObject);
begin
 if trim(cboid.Text)<>'' then
 lbid.Items.Add(cboid.Text);
end;

procedure TfrmItemForAll.btnOutIDClick(Sender: TObject);
begin
 if lbid.ItemIndex<>-1 then
    lbid.Items.Delete(lbid.ItemIndex );
end;

procedure TfrmItemForAll.btnIDAllClick(Sender: TObject);
var i:integer;
begin
 if cboid.Items.Count<>0 then begin
    lbid.Items.Clear;
    for i:=0 to cboid.Items.Count -1 do
        lbid.Items.Add(cboid.Items.Strings[i] ); 
 end;
end;

procedure TfrmItemForAll.btnIDAllOutClick(Sender: TObject);
begin
 lbid.Items.Clear;
end;

procedure TfrmItemForAll.btnOutClick(Sender: TObject);
begin
 if vlitem.Keys[vlitem.Row]<>'' then
 vlitem.DeleteRow(vlitem.Row );
 if vlitem.Keys[1]='' then vlitem.Enabled:=false;
end;

procedure TfrmItemForAll.btnInClick(Sender: TObject);
begin
 if cboitem.Text ='' then exit;
 vlitem.InsertRow(cboitem.Text,'',true);
 vlitem.Enabled:=true;
end;

procedure TfrmItemForAll.btnBackClick(Sender: TObject);
begin
 self.Close;
end;

procedure TfrmItemForAll.btnStartClick(Sender: TObject);
var i,t,m,n,a,b,c,d:integer;
    IDNow:idinfo;
    iSPC,iExtSPC:itemspc;
    tagX,tagY:integer;
    IDALL,IDDONE,IDMISS:integer;
    IDMoney:integer;
    IDHouse:string;
    WSchanged:boolean;
    moneychanged:boolean;
    thispos:boolean;
    label posFound;
begin

 if application.MessageBox('一定注意物品代码是否正确，确定开始？','注意',mb_yesno+mb_iconwarning)=id_no then exit;
 if lbid.Items.Count=0 then begin
    showmessage('没账户阿，给谁加阿');
    exit;
 end;
 if vlitem.Keys[1]='' then begin
    showmessage('加什么啊,我猜不到');
    exit;
 end;
 for i:=1 to vlitem.RowCount-1 do begin
     if (vlitem.Cells[1,i]='') or (length(vlitem.Cells[1,i])<>20) then begin
        showmessage('发现物品代码错误，第 '+inttostr(i)+' 行。空或不足20位');
        exit;
     end;
 end;
 if not isnum(edtzen.Text) then begin
    showmessage('钱要是数字哦，正负都可以');
    exit;
 end;

 if strtoint(edtzen.Text)<>0 then moneychanged:=true else moneychanged:=false;
 wschanged:=false;
 mlog.Lines.Clear;
 mlog.Lines.Add('物品添加开始');
 mlog.Lines.Add('============');
 idall:=lbid.Items.Count;
 iddone:=0;
 idmiss:=0;
 screen.Cursor:=-11;
 for i:=0 to lbid.Items.Count-1 do begin
   idhouse:='';
   mlog.Lines.Add('');
   mlog.Lines.Add('');
   mlog.Lines.Add('');
   mlog.Lines.Add('账户：'+lbid.Items.Strings[i]);
   mlog.Lines.Add('**********************');
   idnow:=getidinfo(lbid.Items.Strings[i]);
   inc(iddone);
   if idnow.Exist then begin
      mlog.Lines.Add('账户原有金币：'+idnow.Money);
      mlog.Lines.Add('增加金币：'+edtzen.Text );
      idmoney:=strtoint(idnow.Money)+strtoint(edtzen.Text );
      mlog.Lines.Add('账户现有金币：'+inttostr(idmoney));
      {重新为该账户仓库计算空间，也就是改写仓库格子第21位代码}
      for c:=0 to 14 do
        for d:=0 to 7 do begin
            if leftstr(idnow.idws[c,d],20)<>'FFFFFFFFFFFFFFFFFFFF' then begin
               iextspc:=getexistitemspc(idnow.idws[c,d]);
               a:= c+iextspc.Y-1;
               b:= d+iextspc.X-1;
               for m:=c to a do
                 for n:=d to b do begin
                     idnow.IDWS[m,n][21]:='1';
                 end;
            end;
        end;

      {完毕}
      for t:=1 to vlitem.RowCount-1 do begin
      
          ispc:=getispc(vlitem.Cells[0,t]);
          tagx:=-1;  //假定没空间
          tagy:=-1;
          {开始计算有没有空间}
          for m:=0 to 14 do
            for n:=0 to 7 do begin
              thispos:=true;

              if idnow.IDWS[m,n]='FFFFFFFFFFFFFFFFFFFF0' then begin
                 a:=m+ispc.Y -1;
                 b:=n+ispc.X -1;
                 if (a>14) or (b>7) then continue;
                 for c:=m to a do
                   for d:=n to b do begin
                       if idnow.IDWS[c,d]<>'FFFFFFFFFFFFFFFFFFFF0' then
                          thispos:=false;
                   end;
              end
              else thispos:=false;

              if thispos=true then begin
                 tagx:=m;
                 tagy:=n;
                 goto posfound;
              end;

            end;
          {结束}
          posfound:
          if tagx=-1 then
             mlog.Lines.Add(vlitem.Cells[0,t]+'：该物品添加失败，仓库空间不够')
          else begin
             mlog.Lines.Add(vlitem.Cells[0,t]+'：该物品已经添加');
             //不要忘了计算刚刚加入的这件物品所占空间
             for m:=tagx to tagx+ispc.Y-1 do
               for n:=tagy to tagy+ispc.X-1 do begin
                 idnow.IDWS[m,n][21]:='1';
               end;
             idnow.IDWS[tagx,tagy]:=vlitem.Cells[1,t]+'1';
             wschanged:=true;
          end;
      end;

      if wschanged then begin
         for c:=0 to 14 do
           for d:=0 to 7 do idhouse:=idhouse+leftstr(idnow.idws[c,d],20);
      end;
      mlog.Lines.Add('---数据提交---');
      {提交钱币}
      if moneychanged then begin
         if dbcommit(0,inttostr(idmoney),lbid.Items.Strings[i]) then
            mlog.Lines.add('金币：成功提交')
         else
            mlog.Lines.add('金币：没有提交。原因：向数据库更新数据失败');
      end
      else
        mlog.Lines.Add('金币：没有提交。原因：没有变化');
      {提交仓库}
      if wschanged then begin
         if dbcommit(1,idhouse,lbid.Items.Strings[i]) then
            mlog.Lines.add('物品：成功提交')
         else
            mlog.Lines.add('物品：没有提交。原因：向数据库更新数据失败');
      end
      else
        mlog.Lines.Add('物品：没有提交。原因：没有变化');
      {提交结束}
   end
   else begin
        mlog.Lines.Add('该帐户不存在');
        inc(idmiss);
   end;
   mlog.Lines.Add('**********************');
   with self.StatusBar1 do begin
        panels[1].Text :='需处理账户：'+inttostr(idall);
        panels[2].Text :='已处理账户：'+inttostr(iddone);
        panels[3].Text :='无效账户：'+inttostr(idmiss);
   end;
   application.ProcessMessages;
 end;
 mlog.Lines.Add('');
 mlog.Lines.Add('');
 mlog.Lines.Add('');
 mlog.Lines.Add('物品添加结束');
 mlog.Lines.Add('============');
 screen.Cursor:=0;
end;


procedure TfrmItemForAll.Button1Click(Sender: TObject);
var i:integer;
begin
 for i:=1 to vlitem.RowCount-1 do
     showmessage(vlitem.Cells[0,i]+'  '+vlitem.Cells[1,i]);
end;

procedure TfrmItemForAll.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
 action:=cafree;
end;

end.