clmain.pas

在网上有很多传奇源程序DELPHI

      if FadeIndex <= 1 then DoFadeOut := FALSE
      else Dec (FadeIndex, 2);
   end else
   if DoFadeIn then begin
      if FadeIndex > 29 then FadeIndex := 29;
      MakeDark (DxDraw1.Surface, FadeIndex);
      if FadeIndex >= 29 then DoFadeIn := FALSE
      else Inc (FadeIndex, 2);
   end else
   if DoFastFadeOut then begin
      if FadeIndex < 1 then FadeIndex := 1;
      MakeDark (DxDraw1.Surface, FadeIndex);
      if FadeIndex > 1 then Dec (FadeIndex, 4);
   end;

   {for i:=0 to 15 do
      for j:=0 to 15 do begin
         DxDraw1.Surface.FillRect(Rect (j*16, i*16, (j+1)*16, (i+1)*16), i*16 + j);
      end;

   for i:=0 to 15 do
      DxDraw1.Surface.Canvas.TextOut (600, i*14,
                                    IntToStr(i) + ' ' +
                                    IntToStr(DXDraw1.ColorTable[i].rgbRed) + ' ' +
                                    IntToStr(DXDraw1.ColorTable[i].rgbGreen) + ' ' +
                                    IntToStr(DXDraw1.ColorTable[i].rgbBlue));
   DxDraw1.Surface.Canvas.Release;}


//显示接收到或者发送的封包:
    if g_bIsShowPacket then begin
      SetBkMode (DxDraw1.Surface.Canvas.Handle, TRANSPARENT);
      DxDraw1.Surface.Canvas.Font.Color:=clWhite;
      for yy:=0 to myrecstr.Count-1 do begin
        DxDraw1.Surface.Canvas.TextOut(10,80+yy*16,myrecstr.Strings[yy]);
      end;

      DxDraw1.Surface.Canvas.Font.Color:=clRed;
      for yy:=0 to mysendstr.Count-1 do begin
        DxDraw1.Surface.Canvas.TextOut(10,280+yy*16,mysendstr.Strings[yy]);
      end;

      DxDraw1.Surface.Canvas.Release;
    end;
//


//   DxDraw1.Flip;
   DxDraw1.Primary.Draw (0, 0, DxDraw1.Surface.ClientRect, DxDraw1.Surface, FALSE);
end;

procedure TFrmMain.AppLogout;
begin
   if mrOk = FrmDlg.DMessageDlg ('是否注销?', [mbOk, mbCancel]) then begin
      SendClientMessage (CM_SOFTCLOSE, 0, 0, 0, 0);
      PlayScene.ClearActors;
      CloseAllWindows;
      if not BoOneClick then begin
         SoftClosed := TRUE;
         ActiveCmdTimer (tcSoftClose);
      end else begin
         ActiveCmdTimer (tcReSelConnect);
      end;
      if BoBagLoaded then
         Savebags ('.\Data\' + ServerName + '.' + CharName + '.itm', @ItemArr);
      BoBagLoaded := FALSE;
   end;
end;

procedure TFrmMain.AppExit;
begin
   if mrOk = FrmDlg.DMessageDlg ('你真的要退出游戏吗?', [mbOk, mbCancel]) then begin

FrmDlg.DMessageDlg ('sizeof()'+IntToStr(sizeof(TClientItem)), [mbOk]);

      if BoBagLoaded then   //保存装备
         Savebags ('.\Data\' + ServerName + '.' + CharName + '.itm', @ItemArr);
      BoBagLoaded := FALSE;
      FrmMain.Close;
   end;
end;

procedure TFrmMain.PrintScreenNow;
   function IntToStr2(n: integer): string;
   begin
      if n < 10 then Result := '0' + IntToStr(n)
      else Result := IntToStr(n);
   end;
var
   i, k, n, checksum: integer;
   flname: string;
   dib: TDIB;
   ddsd: DDSURFACEDESC;
   sptr, dptr: PByte;
begin
   if not DXDraw1.CanDraw then exit;
   while TRUE do begin
      flname := 'Images' + IntToStr2(CaptureSerial) + '.bmp';
      if not FileExists (flname) then break;
      Inc (CaptureSerial);
   end;
   dib := TDIB.Create;
   dib.BitCount := 8;
   dib.Width := SCREENWIDTH;
   dib.Height := SCREENHEIGHT;
   dib.ColorTable := WProgUse.MainPalette;
   dib.UpdatePalette;

   ddsd.dwSize := SizeOf(ddsd);
   checksum := 0;   //盲农芥阑父电促.
   try
      DXDraw1.Primary.Lock (TRect(nil^), ddsd);
      for i := (600-120) to SCREENHEIGHT-10 do begin
         sptr := PBYTE(integer(ddsd.lpSurface) + (SCREENHEIGHT - 1 - i)*ddsd.lPitch + 200);
         for k:=0 to 400-1 do begin
            checksum := checksum + byte(pbyte(integer(sptr) + k)^);
         end;
      end;
   finally
      DXDraw1.Primary.Unlock();// (ddsd.lpSurface);
   end;

   try
      SetBkMode (DXDraw1.Primary.Canvas.Handle, TRANSPARENT);
      DXDraw1.Primary.Canvas.Font.Color := clWhite;
      n := 0;
      if Myself <> nil then begin
         DXDraw1.Primary.Canvas.TextOut (0, 0, ServerName + ' ' + Myself.UserName);
         Inc (n, 1);
      end;
      DXDraw1.Primary.Canvas.TextOut (0, (n)*12,   'CheckSum=' + IntToStr(checksum));
      DXDraw1.Primary.Canvas.TextOut (0, (n+1)*12,  DateToStr(Date));
      DXDraw1.Primary.Canvas.TextOut (0, (n+2)*12, TimeToStr(Time));
      DXDraw1.Primary.Canvas.Release;
      DXDraw1.Primary.Lock (TRect(nil^), ddsd);
      for i := 0 to dib.Height-1 do begin
         sptr := PBYTE(integer(ddsd.lpSurface) + (dib.Height - 1 - i)*ddsd.lPitch);
         dptr := PBYTE(integer(dib.PBits) + i*800);
         Move (sptr^, dptr^, 800);
      end;
   finally
      DXDraw1.Primary.Unlock();// (ddsd.lpSurface);
   end;
   dib.SaveToFile (flname);
   dib.Clear;
   dib.Free;
end;


{------------------------------------------------------------}

procedure TFrmMain.ProcessKeyMessages;
begin
   case ActionKey of
      VK_F1, VK_F2, VK_F3, VK_F4, VK_F5, VK_F6, VK_F7, VK_F8:
         begin
            UseMagic (MouseX, MouseY, GetMagicByKey (char ((ActionKey-VK_F1) + byte('1')) )); //胶农赴 谅钎
            //DScreen.AddSysMsg ('KEY' + IntToStr(Random(10000)));
            ActionKey := 0;
            TargetX := -1;
            exit;
         end;
   end;
end;



{
 鼠标控制 左　键 控制基本的行动：行走、攻击拾取物品和其他东西
右　键 近处的点击能够看到物品使用方法，远处的点击能够在地图上跑动。
Shift + 左键 强制攻击
Ctrl + 左键 跑动
Ctrl + 右键 关于对手的信息，如同F10一样。
Alt + 右键 取得肉或者其他玩家因为死亡丢失的东西。
双　击 拾取在地上的物品或者使用自己包裹中的物品。
}

procedure TFrmMain.ProcessActionMessages;
var
   mx, my, dx, dy, crun: integer;
   ndir, adir, mdir: byte;
   bowalk, bostop: Boolean;
label
   LB_WALK;
begin
   if Myself = nil then exit;

   //Move
   if (TargetX >= 0) and CanNextAction and ServerAcceptNextAction then begin //ActionLock捞 钱府搁, ActionLock篮 悼累捞 场唱扁 傈俊 钱赴促.
      if (TargetX <> Myself.XX) or (TargetY <> Myself.YY) then begin
         mx := Myself.XX;
         my := Myself.YY;
         dx := TargetX;
         dy := TargetY;
         ndir := GetNextDirection (mx, my, dx, dy);
         case ChrAction of
            caWalk: begin
               LB_WALK:
               //DScreen.AddSysMsg ('caWalk ' + IntToStr(Myself.XX) + ' ' +
               //                               IntToStr(Myself.YY) + ' ' +
               //                               IntToStr(TargetX) + ' ' +
               //                               IntToStr(TargetY));
               crun := Myself.CanWalk;
               if IsUnLockAction (CM_WALK, ndir) and (crun > 0) then begin
                  GetNextPosXY (ndir, mx, my);
                  bowalk := TRUE;
                  bostop := FALSE;
                  if not PlayScene.CanWalk (mx, my) then begin
                     bowalk := FALSE;
                     adir := 0;
                     if not bowalk then begin  //涝备 八荤
                        mx := Myself.XX;
                        my := Myself.YY;
                        GetNextPosXY (ndir, mx, my);
                        if CheckDoorAction (mx, my) then
                           bostop := TRUE;
                     end;
                     if not bostop and not PlayScene.CrashMan(mx,my) then begin //荤恩篮 磊悼栏肺 乔窍瘤 臼澜..
                        mx := Myself.XX;
                        my := Myself.YY;
                        adir := PrivDir(ndir);
                        GetNextPosXY (adir, mx, my);
                        if not Map.CanMove(mx,my) then begin
                           mx := Myself.XX;
                           my := Myself.YY;
                           adir := NextDir (ndir);
                           GetNextPosXY (adir, mx, my);
                           if Map.CanMove(mx,my) then
                              bowalk := TRUE;
                        end else
                           bowalk := TRUE;
                     end;
                     if bowalk then begin
                        Myself.UpdateMsg (CM_WALK, mx, my, adir, 0, 0, '', 0);
                        LastMoveTime := GetTickCount;
                     end else begin
                        mdir := GetNextDirection (Myself.XX, Myself.YY, dx, dy);
                        if mdir <> Myself.Dir then
                           Myself.SendMsg (CM_TURN, Myself.XX, Myself.YY, mdir, 0, 0, '', 0);
                        TargetX := -1;
                     end;
                  end else begin
                     Myself.UpdateMsg (CM_WALK, mx, my, ndir, 0, 0, '', 0);  //亲惑 付瘤阜 疙飞父 扁撅
                     LastMoveTime := GetTickCount;
                  end;
               end else begin
                  TargetX := -1;
               end;
            end;
            caRun: begin
               if RunReadyCount >= 1 then begin
                  crun := Myself.CanRun;
                  if (GetDistance (mx, my, dx, dy) >= 2) and (crun > 0) then begin
                     if IsUnLockAction (CM_RUN, ndir) then begin
                        GetNextRunXY (ndir, mx, my);
                        if PlayScene.CanRun (Myself.XX, Myself.YY, mx, my) then begin
                           Myself.UpdateMsg (CM_RUN, mx, my, ndir, 0, 0, '', 0);
                           LastMoveTime := GetTickCount;
                        end;
                     end else
                        TargetX := -1;
                  end else begin
                     //if crun = -1 then begin
                        //DScreen.AddSysMsg ('瘤陛篮 钝 荐 绝嚼聪促.');
                        //TargetX := -1;
                     //end;
                     goto LB_WALK;     //眉仿捞 绝绰版快.
                     {if crun = -2 then begin
                        DScreen.AddSysMsg ('泪矫饶俊 钝 荐 乐嚼聪促.');
                        TargetX := -1;
                     end; }
                  end;
               end else begin
                  Inc (RunReadyCount);
                  goto LB_WALK;
               end;
            end;
         end;
      end;
   end;
   TargetX := -1; //茄锅俊 茄沫究..
   if Myself.RealActionMsg.Ident > 0 then begin
      FailAction := Myself.RealActionMsg.Ident; //角菩且锭 措厚
      FailDir := Myself.RealActionMsg.Dir;
      if Myself.RealActionMsg.Ident = CM_SPELL then begin
         SendSpellMsg (Myself.RealActionMsg.Ident,
                       Myself.RealActionMsg.X,
                       Myself.RealActionMsg.Y,
                       Myself.RealActionMsg.Dir,
                       Myself.RealActionMsg.State);
      end else
         SendActMsg (Myself.RealActionMsg.Ident,
                  Myself.RealActionMsg.X,
                  Myself.RealActionMsg.Y,
                  Myself.RealActionMsg.Dir);
      Myself.RealActionMsg.Ident := 0;

      //皋春甫 罐篮饶 10惯磊惫 捞惑 吧栏搁 磊悼栏肺 荤扼咙
      if MDlgX <> -1 then
         if (abs(MDlgX-Myself.XX) >= 8) or (abs(MDlgY-Myself.YY) >= 8) then begin
            FrmDlg.CloseMDlg;
            MDlgX := -1;
         end;
   end;
end;


procedure TFrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
   msg, wc, dir, mx, my: integer;
   ini: TIniFile;
begin
   case Key of
      VK_PAUSE:   // 橇赴飘 胶农赴 虐
         begin
            Key := 0;
            PrintScreenNow;
         end;
   end;

   if DWinMan.KeyDown (Key, Shift) then exit;

//是否显示封包: CTRL+F1
    if( Key=VK_F1) then
    begin
        if ssCtrl in Shift then begin
          g_bIsShowPacket:= not g_bIsShowPacket;
        end;
    end;


   if (Myself = nil) or (DScreen.CurrentScene <> PlayScene) then exit;
   mx := Myself.XX;
   my := Myself.YY;

   case Key of
      VK_F1, VK_F2, VK_F3, VK_F4,
      VK_F5, VK_F6, VK_F7, VK_F8:
         begin
           if (GetTickCount - LatestSpellTime > (500{+200} + MagicDelayTime)) then begin
              ActionKey := Key;
           end;
           Key := 0;
         end;
{
　 快捷键 F10 打开/关闭角色窗口
F9 打开/关闭包裹窗口
F11 打开/关闭角色能力窗口
Pause Break 在游戏中截图，截图将以IMAGE格式自动保存在MIR的目录下。
F1, F2, F3, F4, F5, F6, F7, F8 由玩家自己设置的快捷键，这些魔法技能的快捷键设置可以加快游戏的操作性和流畅性，比如对火球，治愈等魔法的设置。

}
      VK_F9:
         begin
            FrmDlg.OpenItemBag;
         end;
      VK_F10:
         begin
            FrmDlg.StatePage := 0;
            FrmDlg.OpenMyStatus;
         end;
      VK_F11:
         begin
            FrmDlg.StatePage := 3;
            FrmDlg.OpenMyStatus;
         end;


{
Ctrl + H 选择自己喜欢的攻击模式
和平攻击模式：除了对暴民以外其他攻击都无效。
行会联盟攻击模式：对自己行会内的其他玩家攻击无效
编组攻击模式：处于同一小组的玩家攻击无效
全体攻击模式：对所有的玩家和暴民都具有攻击效果。
善恶攻击模式：PK红名专用攻击模式。
 }