fmain.pas

来自「千年源代码,只缺少控件,可以做二次开发用,好不容易得来的」· PAS 代码 · 共 1,212 行 · 第 1/3 页

procedure TFrmM.PaintLabelClick(Sender: TObject);
var
   key : word;
   cHit : TCHit;
   CL : TCharClass;
   CLAtt : TCharClass;
   UserFlag : Boolean;  // 荤恩牢瘤 酒囱瘤 备喊蔼
   AttactFlag : Boolean;

   iID : integer;
begin
   UserFlag := FALSE;
   AttactFlag := FALSE;
   if (ssShift in KeyShift) then begin
      UserFlag := FALSE;
      AttactFlag := TRUE;
   end;
   if (ssCtrl in KeyShift) then begin
      UserFlag := TRUE;
      AttactFlag := TRUE;
   end;
   // ankudo 020213 shift 老版快 阁胶磐父 啊瓷 Ctrl老 版快 荤恩父 啊瓷 唱赣柳 促 利侩
   if AttactFlag then begin
      if mmAnsTick < HitTick+200 then exit;
      if boShiftAttack = FALSE then exit;
      HitTick := mmAnsTick;
      Cl := CharList.GetChar (CharCenterId);
      if Cl = nil then exit;
      if Cl.Feature.rfeaturestate = wfs_die then exit;

      if SelectedChar <> 0 then begin
         CLAtt := CharList.GetChar (SelectedChar);
         if CLAtt = nil then exit;
         if UserFlag and (CLAtt.Feature.rrace = RACE_MONSTER) then exit;
         if not UserFlag and (CLAtt.Feature.rrace = RACE_HUMAN) then exit;
      end;

      MouseCellX := (BackScreen.Cx - BackScreen.SWidth div 2 + Mousex) div UNITX;
      MouseCellY := (BackScreen.Cy - BackScreen.SHeight div 2 + Mousey) div UNITY;

      cHit.rmsg := CM_HIT;
      cHit.rkey := GetMouseDirection;
      cHit.rtid := SelectedChar;
      cHit.rtx := MouseCellX;
      cHit.rty := MouseCellY;
      Frmlogon.SocketAddData (sizeof(cHit), @cHit);

      if cHit.rkey <> Cl.dir then CL.ProcessMessage (SM_TURN, cHit.rkey, cl.x, cl.y, cl.feature, 0);
      if (Cl.Feature.rHitMotion <> 5) and (Cl.Feature.rHitMotion <> 6) then
         CL.ProcessMessage (SM_MOTION, cHit.rkey, cl.x, cl.y, cl.feature, Cl.Feature.rhitmotion);
      exit;
   end;

   iID := 0;
   ClickTick := mmAnsTick;
   FillChar (GrobalClick, sizeof(GrobalClick), 0);
   key := GetMouseDirection;

   if SelectedChar <> 0 then iID := SelectedChar;
   if SelectedItem <> 0 then iID := SelectedItem;
   GrobalClick.rmsg := CM_CLICK;
   GrobalClick.rwindow := WINDOW_SCREEN;
   GrobalClick.rclickedId := iID;
   GrobalClick.rShift := KeyShift;
   GrobalClick.rkey := key;
end;

procedure TFrmM.PaintLabelDblClick(Sender: TObject);
var
   iID : integer;
begin
   ClickTick := mmAnsTick;
   FillChar (GrobalClick, sizeof(GrobalClick), 0);

   iID := 0;
   if SelectedChar <> 0 then iID := SelectedChar;
   if SelectedItem <> 0 then iID := SelectedItem;

   GrobalClick.rmsg := CM_DBLCLICK;
   GrobalClick.rwindow := WINDOW_SCREEN;
   GrobalClick.rclickedId := iID;
   GrobalClick.rShift := KeyShift;
   GrobalClick.rkey := GetMouseDirection;
end;

procedure TFrmM.PaintLabelDragDrop(Sender, Source: TObject; X, Y: Integer);
var cDragDrop : TCDragDrop;
begin
   if Source = nil then exit;

   with Source as TDragItem do begin
      case SourceID of
         WINDOW_ITEMS:;
         WINDOW_SCREEN:;
         else exit;
      end;
      cDragDrop.rmsg := CM_DRAGDROP;
      cDragDrop.rsourId := DragedId;

      cDragDrop.rdestId := 0;
      if SelectedDynamicItem <> 0 then cDragDrop.rdestId := SelectedDynamicItem;
      if Selecteditem <> 0 then cDragDrop.rdestId := SelectedItem;
      if SelectedChar <> 0 then cDragDrop.rdestId := SelectedChar;
      cdragdrop.rsx := sx;
      cdragdrop.rsy := sy;
      cdragdrop.rdx := mouseCellx;
      cdragdrop.rdy := mouseCelly;

      cDragDrop.rsourwindow := SourceId;
      cDragDrop.rdestwindow := WINDOW_SCREEN;
      case SourceId of
         WINDOW_ITEMS: cDragDrop.rsourkey := Selected;
         WINDOW_WEARS: cDragDrop.rsourkey := Selected;
      end;
      cDragDrop.rdestkey := TA2ILabel(Sender).tag;
      FrmLogOn.SocketAddData (sizeof(cDragDrop), @cDragDrop);
   end;
end;

procedure TFrmM.PaintLabelDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
   Cl : TCharClass;
   IT : TItemClass;
   AIT : TDynamicObject;
begin
   mouseX := x;
   mousey := y;

   MouseCellX := (BackScreen.Cx - BackScreen.SWidth div 2 + Mousex) div UNITX;
   MouseCellY := (BackScreen.Cy - BackScreen.SHeight div 2 + Mousey) div UNITY;

   CharList.MouseMove (BackScreen.Cx + (Mousex-BackScreen.SWidth div 2), BackScreen.Cy + (Mousey-BackScreen.SHeight div 2));
   if (SelectedChar = 0) and(SelectedItem = 0) then MouseInfoStr := '';
   if SelectedChar <> 0 then begin
      Cl := CharList.GetChar (SelectedChar);
      if Cl <> nil then MouseInfoStr := Cl.Name;
   end;
   if SelectedItem <> 0 then begin
      IT := CharList.GetItem (SelectedItem);
      MouseInfoStr := IT.ItemName;
   end;
   if SelectedDynamicItem <> 0 then begin          // aniItem add by 001217
      AIT := CharList.GetDynamicObjItem (SelectedDynamicItem);
      MouseInfoStr := AIT.DynamicObjName;
   end;

   Accept := FALSE;
   if Source <> nil then begin
      with Source as TDragItem do begin
         if SourceID = WINDOW_ITEMS then Accept := TRUE;
         if SourceID = WINDOW_SCREEN then Accept := TRUE;
      end;
   end;
end;

procedure TFrmM.PaintLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   mousex := x;
   mousey := y;
   if mbRight = Button then begin
      mousecheck := TRUE;
      RightButtonDown := TRUE;
      exit;
   end;
   SelScreenId := 0;
   if SelectedChar <> 0 then SelScreenId := SelectedChar;

   if SelectedItem <> 0 then SelScreenId := SelectedItem;

   if SelScreenId <> 0 then begin
      SelScreenX := x;
      SelScreenY := y;
   end else begin
      SelScreenX := 0;
      SelScreenY := 0;
   end;
end;

procedure TFrmM.PaintLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
   Cl : TCharClass;
   IT : TItemClass;
   AIT : TDynamicObject;
begin
   mouseX := x;
   mousey := y;

   if RightButtonDown then mousecheck := TRUE;
   CharList.MouseMove (BackScreen.Cx + (Mousex-BackScreen.SWidth div 2), BackScreen.Cy + (Mousey-BackScreen.SHeight div 2));
   if (SelectedChar = 0) and(SelectedItem = 0) and (SelectedDynamicItem = 0) then MouseInfoStr := '';
   if SelectedChar <> 0 then begin
      Cl := CharList.GetChar (SelectedChar);
      if Cl <> nil then
         if Cl.Feature.rHideState = hs_100 then MouseInfoStr := Cl.Name;
   end;
   if SelectedItem <> 0 then begin
      IT := CharList.GetItem (SelectedItem);
      MouseInfoStr := IT.ItemName;
   end;

   if SelectedDynamicItem <> 0 then begin          // aniItem add by 001217
      AIT := CharList.GetDynamicObjItem (SelectedDynamicItem);
      MouseInfoStr := AIT.DynamicObjName;
   end;
   if (SelScreenId <> 0) and (abs (SelScreenX-x) + abs (SelScreenY-y) > 10) then PaintLabel.BeginDrag (TRUE);
end;

procedure TFrmM.PaintLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   mouseX := x;
   mousey := y;
   RightButtonDown := FALSE;

   if abs (SelScreenX-x) + abs (SelScreenY-y) < 10 then begin
      SelScreenX := 0;
      SelScreenY := 0;
      SelScreenId := 0;
   end;
end;

procedure TFrmM.PaintLabelStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
   DragItem.Dragedid := SelScreenId;
   DragItem.SourceId := WINDOW_SCREEN;
   DragItem.sx := mouseCellX;
   DragItem.sy := mouseCellY;
   DragObject := DragItem;
   SelScreenId := 0;
end;

procedure TFrmM.MoveProcess;
var
   dir, xx, yy : word;
   ckey : TCKey;
   cmove : TCMove;
   Cl : TCharClass;
begin
   if RightButtonDown = FALSE then exit;
   Cl := CharList.GetChar (CharCenterId);
   if Cl = nil then exit;
   if Cl.AllowAddAction = FALSE then exit;

   dir := GetMouseDirection;
   if dir <> DR_DONTMOVE then begin
      if dir <> Cl.dir then begin
         ckey.rmsg := CM_TURN;
         ckey.rkey := dir;
         FrmLogon.SocketAddData (sizeof(ckey), @ckey);
         CL.ProcessMessage (SM_TURN, dir, cl.x, cl.y, cl.feature, 0);
      end else begin
         xx := Cl.x; yy := Cl.y;
         GetNextPosition (dir, xx, yy);
         if Map.isMovable (xx, yy) = FALSE then exit;
         if CharList.isMovable (xx, yy) = FALSE then exit;

         cmove.rmsg := CM_MOVE;
         cmove.rdir := dir;
         cmove.rx := Cl.x;
         cmove.ry := Cl.y;
         FrmLogon.SocketAddData (sizeof(cmove), @cmove);
         CL.ProcessMessage (SM_MOVE, dir, cl.x, cl.y, cl.feature, 0);
      end;
   end;
end;

procedure TFrmM.CheckAndSendClick;
begin
   if mmAnsTick < ClickTick+10 then exit;
   if GrobalClick.rwindow = 0 then exit;
   Frmlogon.SocketAddData (sizeof(GrobalClick), @GrobalClick);
   FillChar (GrobalClick, sizeof(GrobalClick), 0);
end;

procedure TFrmM.MessageProcess (var code: TWordComData);
var
   TagetX, TagetY, len : Word;
   i, n, deg, xx, yy : integer;
   pan, volume, volume2: integer;
   str, rdstr : string;
   cstr : string[1];
   DynamicGuard : TDynamicGuard;

   ItemClass : TItemClass;
   Cl, TL : TCharClass;
   Dt : TDynamicObject;
   pckey : PTCKey;
   psSay : PTSSay;
   psNewMap : PTSNewMap;
   psShow : PTSShow;
   psShowItem : PTSShowItem;
   psHide : PTSHide;
   psTurn : PTSTurn;
   psMove : PTSMove;
   psSetPosition : PTSSetPosition;
   psChatMessage : PTSChatMessage;
   psChangeFeature : PTSChangeFeature;
   psChangeProperty : PTSChangeProperty;
   psMotion : PTSMotion;
   psStructed : PTSStructed;
   psHaveMagic : PTSHaveMagic;
   psHaveItem : PTSHaveItem;
//   psWearItem : PTSWearItem;
   psAttribBase : PTSAttribBase;
   psAttriblife : PTSAttribLife;
   psAttribValues : PTSAttribValues;
   psAttribFightBasic : PTSAttribFightBasic;
   psEventString : PTSEventString;
   psMovingMagic : PTSMovingMagic;
   psSoundString : PTSSoundString;
   psSoundBaseString : PTSSoundBaseString;
   psRainning: PTSRainning;
   psShowInputString : PTSShowInputString;

   PSShowDynamicObject : PTSShowDynamicObject; // DynamicItem Add 010102 ankudo
   PSChangeState : PTSChangeState; // Dynamic Item state Change 010105 ankudo
   PSSShowSpecialWindow : PTSShowSpecialWindow;
   PSTSHideSpecialWindow : PTSHideSpecialWindow;
   PSTSNetState : PTSNetState;
   cCNetState : TCNetState;
begin
   pckey := @Code.data;
   case pckey^.rmsg of
      SM_NETSTATE :
         begin
            PSTSNetState := @Code.data;
            with cCNetState do begin
               rMsg := CM_NETSTATE;
               rID := PSTSNetState^.rID;
               rMadeTick := PSTSNetState^.rMadeTick;
               rCurTick := mmAnsTick;
            end;
            FrmLogon.SocketAddData (sizeof(cCNetState), @cCNetState);

         end;
      SM_HIDESPECIALWINDOW :
         begin
            PSTSHideSpecialWindow := @Code.data;
            case PSTSHideSpecialWindow^.rWindow of
               WINDOW_GROUPWINDOW : FrmbatList.Visible := FALSE;
               WINDOW_ROOMWINDOW : FrmbatList.Visible := FALSE;
               WINDOW_GRADEWINDOW : FrmbatList.Visible := FALSE;
               WINDOW_ITEMLOG : FrmDepository.Visible := FALSE;
               WINDOW_ALERT : FrmDepository.Visible := FALSE;
               WINDOW_AGREE : FrmcMessageBox.Visible := FALSE;
               WINDOW_GUILDMAGIC : FrmMuMagicOffer.Visible := FALSE;
            end;
         end;
      SM_SHOWBATTLEBAR :
         begin
            PersonBat.MessageProcess (Code);
         end;
      SM_SHOWCENTERMSG :
         begin
            PersonBat.MessageProcess (Code);
         end;
      SM_CHECK :
         begin
            CheckSome (Code);
         end;
      SM_LOGITEM :
         begin
            FrmDepository.MessageProcess(Code);
         end;
      SM_SHOWSPECIALWINDOW :
         begin
            FrmDepository.MessageProcess(Code);
            FrmbatList.MessageProcess (Code);
            FrmcMessageBox.MessageProcess(Code);
            FrmMuMagicOffer.MessageProcess(Code);
            {
            FrmMunpaCreate.MessageProcess(Code);
            FrmMunpaimpo.MessageProcess(Code);
            FrmcMessageBox.MessageProcess(Code);
            FrmMunpaWarOffer.MessageProcess(Code);
            }
         end;
      SM_CHARMOVEFRONTDIEFLAG:
         begin // 烙矫荤侩 纳腐磐啊 磷篮荤恩困肺 瘤唱哎荐 乐绰 版快甫 TRUE肺 汲沥
            CharMoveFrontdieFlag := TRUE;
         end;
      SM_SHOWEXCHANGE:  // 背券芒
         begin
            FrmExChange.MessageProcess (Code);
         end;
      SM_HIDEEXCHANGE:
         begin
            FrmExchange.Visible := FALSE;
            if FrmQuantity.Visible then FrmQuantity.Visible := FALSE;
         end;
      SM_SHOWCOUNT:     // 荐樊芒
         begin
            FrmQuantity.MessageProcess (Code);
         end;

      // CM_SELECTCOUNT;
      SM_SHOWINPUTSTRING: // 沤祸芒
         begin
            psShowInputString := @Code.Data;
            FrmSearch.QuantityID :=  psShowInputString.rInputStringid;
            FrmSearch.QuantityData :=  GetWordString (psShowInputString.rWordString);
            FrmSearch.SearchItem;
            FrmSearch.Visible := TRUE;
         end;