mainunit.~pas

MU仓库编辑器 （转发）

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls,strUtils, ValEdit, ExtCtrls, Buttons,dec,
  ComCtrls,account,showdata, Menus, WinSkinStore, WinSkinData,itemforall;

type
  TfrmMain = class(TForm)
    muQuery: TADOQuery;
    cboID: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    edtZen: TEdit;
    Panel1: TPanel;
    cboitem: TComboBox;
    Label4: TLabel;
    Bevel1: TBevel;
    Label5: TLabel;
    Bevel2: TBevel;
    Label6: TLabel;
    edtdur: TEdit;
    cbolvl: TComboBox;
    cboopt: TComboBox;
    xy: TCheckBox;
    GroupBox1: TGroupBox;
    zy1: TCheckBox;
    zy2: TCheckBox;
    zy3: TCheckBox;
    zy4: TCheckBox;
    zy5: TCheckBox;
    zy6: TCheckBox;
    btnIN: TBitBtn;
    itemQuery: TADOQuery;
    StatusBar1: TStatusBar;
    jn: TCheckBox;
    cmtDB: TADOCommand;
    Panel2: TPanel;
    popMenuitem: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Label3: TLabel;
    cboType: TComboBox;
    Label7: TLabel;
    Label8: TLabel;
    btnEx: TBitBtn;
    lblspace: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    cboX: TComboBox;
    cboY: TComboBox;
    Panel3: TPanel;
    btnSave: TBitBtn;
    btnHelp: TBitBtn;
    btnExit: TBitBtn;
    BitBtn1: TBitBtn;
    Label13: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    BitBtn2: TBitBtn;
    Label17: TLabel;
    SpeedButton1: TSpeedButton;
    cbSql: TCheckBox;
    SKstore: TSkinStore;
    SKdata: TSkinData;
    BitBtn3: TBitBtn;
    edtShow: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure zy1Click(Sender: TObject);
    procedure cboitemChange(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure cboTypeChange(Sender: TObject);
    procedure btnINClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure btnExClick(Sender: TObject);
    procedure cboIDKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cboIDClick(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
    procedure lblClick(sender:tobject);
    procedure cellClick(sender:tobject);
    procedure lblmousedown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lblMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  end;
type itemproperty=record
     Name:string;
     X:integer;
     Y:integer;
end;
type itemoption=record
     lvl:string;
     opt:string;
     dur:string;
     skill:string;
     lucky:string;
     ExOpt:string;
end;
var
  frmMain: TfrmMain;
  itemspc:array of string; {物品所占空间数组}
  warehouse:array[0..14,0..7] of string; {物品16进制代码数组，与虚拟仓库同步}
  wscells:array[0..14,0..7] of tspeedbutton; {组成虚拟仓库的speedbutton数组}
  currentitem:string; {跟踪当前选择的物品}
implementation

{$R *.dfm}


//自定义 Procedure&Function 开始 ===============================================


function HexToInt(Hex : string) : Cardinal;   {Hex-->Integer}
const cHex = '0123456789ABCDEF';
var mult,i,loop : integer;
begin
result := 0;
mult := 1;
for loop := length(Hex) downto 1 do begin
i := pos(Hex[loop],cHex)-1;
if (i < 0) then i := 0;
inc(result,(i*mult));
mult := mult * 16;
end;
end;


function To2Char(const I:integer):string ;   {把一位integer表示为2位string}
var S:string;
begin
  s:=inttostr(i);
  if length(s)=1 then s:='0'+s;
  result:=s;
end;

function Getbtnindex(const S:string):integer ; {循环检索speedbutton数组，返回值用于销毁动态speedbutton组件}
var i,btnindex:integer;
begin
    btnindex:=121;
    for i:=0 to frmmain.Panel2.ControlCount-1 do begin
      if leftstr(uppercase(frmmain.Panel2.Controls[i].Name),5)='C'+s then begin
         btnindex:=i;
         break;
      end;
    end;
    result:=btnindex;
end;


function Getlblindex(const S:string):integer; {循环检索panel数组，返回值用于销毁动态panel组件}
var i,lblindex:integer;
begin
  lblindex:=121;
  if s='all' then begin
    for i:=0 to frmmain.Panel2.ControlCount-1 do begin
      if lowercase(frmmain.Panel2.Controls[i].ClassName)='tpanel' then begin
         lblindex:=i;
         break;
      end;
    end;
    end
  else begin
    for i:=0 to frmmain.Panel2.ControlCount-1 do begin
      if uppercase(frmmain.Panel2.Controls[i].Name)=s then begin
         lblindex:=i;
         break;
      end;
    end;
  end;
  result:=lblindex;
end;


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 GetPos15(const org:string;const adt:string):string; {得到一件物品代码的第15位}
begin
    if org='C' then
       begin
       case strtoint(adt) of
       1:result:='D';
       2:result:='E';
       3:result:='F';
       end;
       end
     else if org='8' then
       begin
       case strtoint(adt) of
       1:result:='9';
       2:result:='A';
       3:result:='B';
       end;
       end
     else
       result:=inttostr(strtoint(org)+strtoint(adt));
    
end;

procedure ResetWS();  {复位虚拟仓库}
var i,t:integer;
begin
  for i:=0 to 14 do
      for t:=0 to 7 do begin
          wscells[i,t].Flat:=false;
          wscells[i,t].Name:='';
          warehouse[i,t]:='FFFFFFFFFFFFFFFFFFFF';


      end;
  while getlblindex('all')<>121 do
        frmmain.Panel2.Controls[getlblindex('all')].Free;

end;


procedure initWS(); {初始化虚拟仓库}
var i,t,szcell:integer;
    name1,name2:string;
begin
  szcell:=30;
  for i:=0 to 14 do
    for t:=0 to 7 do
      begin
            name1:=inttostr(i+1);
            name2:=inttostr(t+1);
            if length(name1)=1 then name1:='0'+name1;
            if length(name2)=1 then name2:='0'+name2;
            wscells[i,t]:=tspeedbutton.Create(frmmain);
            wscells[i,t].parent:=frmmain.Panel2 ;
            wscells[i,t].left:=t*szcell+1;
            wscells[i,t].top:=i*szcell+1;
            wscells[i,t].height:=szcell;
            wscells[i,t].width:=szcell;
            wscells[i,t].Name:='';
            wscells[i,t].ShowHint:=true;
            wscells[i,t].Hint:=name1+'  '+name2;
            wscells[i,t].OnClick:=frmmain.cellClick;
      end;

end;

procedure freeWs(); {销毁虚拟仓库}
var i,t:integer;
begin
  for i:=0 to 14 do
    for t:=0 to 7 do
      wscells[i,t].Free ;
end;



function GetItemOption(const part1:string;const part2:string;const part3:string;const itemName:string):itemoption; {得到物品的各种属性}
var n,x,y,z,a,b,c,p15,pex:integer;
    iserr:boolean;
    sexopt:string;
begin
  iserr:=true;
  for n:=0 to 1 do
   for x:=0 to 11 do
     for y:=0 to 1 do
       for z:=0 to 3 do begin
           if 128*n+8*x+4*y+z=hextoint(part1) then begin
              result.lvl:='物品等级：'+'+'+inttostr(x);
              result.opt:=inttostr(z*4);
              result.dur:='耐久度：'+inttostr(hextoint(part2));
              if n=1 then result.skill:='技能：有' else result.skill:='技能：无';
              if y=1 then result.lucky:='幸运：有' else result.lucky:='幸运：无';
              iserr:=false;
           end;
       end;

   if iserr=true then begin
      result.lvl :='error';
      exit;
   end;
   p15:=hextoint(part3[1]);
   if p15>=12 then begin
      result.opt:='16';
      pex:=p15-12;
      end
   else if p15>=8 then begin
      pex:=p15-8;
      end
   else if p15>=4 then begin
      result.opt:='16';
      pex:=p15-4;
      end
   else begin
      pex:=p15;
   end;
   if p15>=8 then
      if (itemname='精灵之翼') or (pos('项链',itemname)<>0) or (pos('戒指',itemname)<>0) then result.opt:='追加属性：生命自动恢复 +'+inttostr(strtoint(result.opt) div 4)+'%'
      else if itemname='天使之翼' then result.opt:='追加属性：追加魔法攻击力 +'+result.opt
      else if itemname='恶魔之翼' then result.opt:='追加属性：追加攻击力 +'+result.opt
      else if (itemname='圣灵之翼') or (itemname='暗黑之翼') or (itemname='魔魂之翼') or (itemname='飞龙之翼') then result.opt:='追加属性：追加攻击力 +'+result.opt+'（具体属性请对照卓越属性判断）'
      else result.opt:='追加属性：追加防御力 +'+result.opt
   else
         if pos('盾',itemname)<>0 then result.opt:='追加属性：追加防御率 +'+inttostr((strtoint(result.opt) div 4)*5)
         else if pos('盔',itemname)<>0 then result.opt:='追加属性：追加防御力 +'+result.opt
         else if (pos('仗',itemname)<>0) or (pos('杖',itemname)<>0) then result.opt:='追加属性：追加魔法攻击力 +'+result.opt
         else result.opt:='追加属性：追加攻击力 +'+result.opt;

   pex:=hextoint(inttostr(pex)+part3[2]);
   for a:=0 to 1 do
     for b:=0 to 1 do
       for c:=0 to 1 do
         for x:=0 to 1 do
           for y:=0 to 1 do
             for z:=0 to 1 do
               if a+2*b+4*c+8*x+16*y+32*z=pex then
                  if ((p15>=8) and ((pos('项链',itemname)=0))) or ((p15<8) and ((pos('盔',itemname)<>0) or (pos('盾',itemname)<>0) )) then begin

                      if a<>0 then sexopt:='杀死怪物时所获金增加 +40%；';
                      if b<>0 then sexopt:=sexopt+'防御成功率 +10%；';
                      if c<>0 then sexopt:=sexopt+'伤害反射 +5%；';
                      if x<>0 then sexopt:=sexopt+'伤害减少+4%；';
                      if y<>0 then sexopt:=sexopt+'最大魔法值 +4%；';
                      if z<>0 then sexopt:=sexopt+'最大生命值 +4%；';

                     end
                  else begin
                      if a<>0 then sexopt:='杀死怪物时所获魔法值增加 +魔法值/8；';
                      if b<>0 then sexopt:=sexopt+'杀死怪物时所获生命值增加 +生命值/8；';
                      if c<>0 then sexopt:=sexopt+'攻击（魔法）速度增加 +7；';
                      if x<>0 then sexopt:=sexopt+'攻击力增加 +2%；';
                      if y<>0 then sexopt:=sexopt+'攻击力增加 +等级/20；';
                      if z<>0 then sexopt:=sexopt+'卓越攻击几率增加 +10%；';
                  end;
  if sexopt='' then result.exopt:='卓越属性：无' else result.ExOpt:='卓越属性：'+sexopt;
end;           

function IntoWsGrid(const X:integer;const Y:integer;const itempropertyIn:itemproperty;const itemoptionIn:itemoption):boolean;{把一件物品放入虚拟仓库}
var i,t:integer;
    CanInsert:boolean;
    itemlabel:tpanel;
begin
  caninsert:=true;
  if ((x+itempropertyin.y-1)>14) or ((y+itempropertyin.x-1)>7) then caninsert:=false;
  if caninsert=false then begin
     application.MessageBox(pchar('无法在'+inttostr(x+1)+'，'+inttostr(y+1)+'处加入['+itempropertyin.Name +']。好像塞不下了'+#13+#13+'提示：'+itempropertyin.name+'所需空间 '+
                         inttostr(itempropertyin.X)+'x'+inttostr(itempropertyin.Y))  ,'警告',mb_ok+mb_iconwarning);
     result:=false;
     exit;
  end;
  caninsert:=true;
  for i:=x to (x+itempropertyin.y-1) do begin
      for t:=y to (y+itempropertyin.x-1) do begin
          if wscells[i,t].Flat then
             caninsert:=false;
      end;
  end;
  if caninsert=false then begin
     application.MessageBox(pchar('无法在'+inttostr(x+1)+'，'+inttostr(y+1)+'处加入['+itempropertyin.Name +']。和其他物品重叠了'+#13+#13+'提示：'+itempropertyin.name+'所需空间 '+
                         inttostr(itempropertyin.X)+'x'+inttostr(itempropertyin.Y))  ,'警告',mb_ok+mb_iconwarning);
     result:=false;
     exit;
  end;
  for i:=x to (x+itempropertyin.y-1) do
      for t:=y to (y+itempropertyin.x-1) do begin
         wscells[i,t].Name:='C'+to2char(x)+to2char(y)+to2char(i)+to2char(t);
         wscells[i,t].Flat:=true;
      end;
  itemlabel:=tpanel.Create(frmmain);
  itemlabel.Parent:=frmmain.Panel2;
  itemlabel.Name:='L'+to2char(x)+to2char(y);
  itemlabel.BevelOuter:=bvlowered;
  itemlabel.BevelInner:=bvnone;
  itemlabel.Color:=clteal;
  itemlabel.Font.Name:='宋体';
  itemlabel.Font.Size:=9;
  itemlabel.Font.Color:=clwhite;
  itemlabel.Left:=y*30;
  itemlabel.Top :=x*30;
  itemlabel.Caption :=itempropertyin.Name;
  itemlabel.Width:=itempropertyin.X*30;
  itemlabel.Height:=itempropertyin.Y*30;
  itemlabel.Cursor:=crhandpoint;
  itemlabel.PopupMenu:=frmmain.popMenuitem;
  itemlabel.ShowHint:=false;
  itemlabel.Hint:='物品名称：'+itempropertyin.Name+#13+itemoptionin.lvl+#13
                            +itemoptionin.opt+#13+itemoptionin.dur +#13+itemoptionin.skill
                            +#13+itemoptionin.lucky+#13+itemoptionin.ExOpt;
  itemlabel.OnMouseDown:=frmmain.lblmousedown;
  itemlabel.OnClick:=frmmain.lblClick;
  itemlabel.OnMouseMove:=frmmain.lblMouseMove;
  result:=true;
end;

procedure killitem(const itemflag:string); {删除一件物品}
begin
  while getbtnindex(itemflag)<>121 do begin
    (frmmain.Panel2.Controls[getbtnindex(itemflag)] as tspeedbutton).Flat:=false;
    frmmain.Panel2.Controls[getbtnindex(itemflag)].Name:='';
  end;
end;


function warehouseCommit():boolean;  {提交更改}
var sSql,sSqlSub:string;
    i,t:integer;
begin
  screen.Cursor:=-11;
  application.ProcessMessages;
  ssql:='update warehouse set money='+frmmain.edtZen.Text+',items=0x';
  for i:=0 to 14 do begin
      for t:=0 to 7 do ssqlsub:=ssqlsub+warehouse[i,t];
  end;
  ssql:=ssql+ssqlsub+' where accountid='''+frmmain.cboID.Text+'''' ;
  if frmmain.cbsql.Checked then begin
    if application.MessageBox(pchar(ssql),'信息',mb_yesno+mb_iconinformation)=mrno then begin
       screen.Cursor:=0;
       result:=false;
       exit;
    end;
  end;
  screen.Cursor:=0;
  with frmmain.cmtDB do begin
  commandtext:=ssql;