clmain.pas

解元 传奇2客户端delphi源程序

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 ();
   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 ();
   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')) )); //胶农赴 谅钎
            ActionKey := 0;
            TargetX := -1;
            exit;
         end;
   end;
end;

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:
               crun := Myself.CanWalk;
               {DScreen.AddSysMsg ('caWalk ' + IntToStr(Myself.XX) + ' ' +
                                              IntToStr(Myself.YY) + ' ' +
                                              IntToStr(TargetX) + ' ' +
                                              IntToStr(TargetY)+' :'+inttostr(crun));
               }
               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;

   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;
      VK_F9:
         begin
            FrmDlg.OpenItemBag;
         end;
      VK_F10:
         begin
            FrmDlg.StatePage := 0;
            FrmDlg.OpenMyStatus;
         end;
      VK_F11:
         begin
            FrmDlg.StatePage := 3;
            FrmDlg.OpenMyStatus;
         end;

      word('H'):  //措牢傍拜 规过
         begin
            if ssCtrl in Shift then begin
               SendSay ('@傍拜规侥');
            end;
         end;
      word('A'):
         begin
            if ssCtrl in Shift then begin
               SendSay ('@绒侥');
            end;
         end;
      word('F'):
         begin
            if ssCtrl in Shift then begin
               if CurFont < MAXFONT-1 then Inc(CurFont)
               else CurFont := 0;
               CurFontName := FontArr[CurFont];
               FrmMain.Font.Name := CurFontName;
               FrmMain.Canvas.Font.Name := CurFontName;
               DxDraw1.Surface.Canvas.Font.Name := CurFontName;
               PlayScene.EdChat.Font.Name := CurFontName;

               ini := TIniFile.Create ('.\mir.ini');
               if ini <> nil then begin
                  ini.WriteString ('Setup', 'FontName', CurFontName);
                  ini.Free;
               end;

            end;
         end;
      word('X'):
         begin
            if Myself = nil then exit;
            if ssAlt in Shift then begin
               if (GetTickCount - LatestStruckTime > 10000) and
                  (GetTickCount - LatestMagicTime > 10000) and
                  (GetTickCount - LatestHitTime > 10000) or
                  (Myself.Death) then
               begin
                  AppLogOut;
               end else
                  DScreen.AddChatBoardString ('正在战斗，不能注销.', clYellow, clRed);
            end;
         end;
      word('Q'):
         begin
            if Myself = nil then exit;
            if ssAlt in Shift then begin
               if (GetTickCount - LatestStruckTime > 10000) and
                  (GetTickCount - LatestMagicTime > 10000) and
                  (GetTickCount - LatestHitTime > 10000) or
                  (Myself.Death) then
               begin
                  AppExit;
               end else
                  DScreen.AddChatBoardString ('正在战斗，不能退出游戏.', clYellow, clRed);
            end;
         end;
   end;
   //盲泼芒 炼沥
   case Key of
      VK_UP:
         with DScreen do begin
            if ChatBoardTop > 0 then Dec (ChatBoardTop);
         end;
      VK_DOWN:
         with DScreen do begin
            if ChatBoardTop < ChatStrs.Count-1 then
               Inc (ChatBoardTop);
         end;
      VK_PRIOR:
         with DScreen do begin
            if ChatBoardTop > VIEWCHATLINE then
               ChatBoardTop := ChatBoardTop - VIEWCHATLINE
            else ChatBoardTop := 0;
         end;
      VK_NEXT:
         with DScreen do begin
            if ChatBoardTop + VIEWCHATLINE < ChatStrs.Count-1 then
               ChatBoardTop := ChatBoardTop + VIEWCHATLINE
            else ChatBoardTop := ChatStrs.Count-1;
            if ChatBoardTop < 0 then ChatBoardTop := 0;
         end;
   end;
end;

procedure TFrmMain.FormKeyPress(Sender: TObject; var Key: Char);
begin
   if DWinMan.KeyPress (Key) then exit;
   if DScreen.CurrentScene = PlayScene then begin
      if PlayScene.EdChat.Visible then begin
         //傍烹栏肺 贸府秦具 窍绰 版快父 酒贰肺 逞绢皑
         exit;
      end;
      case byte(key) of
         byte('1')..byte('6'):
            begin
               EatItem (byte(key) - byte('1')); //骇飘 酒捞袍阑 荤侩茄促.
            end;
         27: //ESC
            begin
            end;
         byte(' '), 13: //盲泼 冠胶
            begin
               PlayScene.EdChat.Visible := TRUE;
               PlayScene.EdChat.SetFocus;
               SetImeMode (PlayScene.EdChat.Handle, LocalLanguage);
               if FrmDlg.BoGuildChat then begin
                  PlayScene.EdChat.Text := '!~';
                  PlayScene.EdChat.SelStart := Length(PlayScene.EdChat.Text);
                  PlayScene.EdChat.SelLength := 0;
               end else begin
                  PlayScene.EdChat.Text := '';
               end;
            end;
         byte('@'),
         byte('!'),
         byte('/'):
            begin
               PlayScene.EdChat.Visible := TRUE;
               PlayScene.EdChat.SetFocus;
               SetImeMode (PlayScene.EdChat.Handle, LocalLanguage);