clmain.pas

来自「2009最新 传奇汉化0599代码 传奇汉化」· PAS 代码 · 共 1,906 行 · 第 1/5 页

PAS
1,906
字号



      if doFullScreen in DxDraw.Options then begin
         //Screen.Cursor := crNone;
      end else begin
         // DF WindowModeFix 1
         FrmMain.ClientWidth := SCREENWIDTH;
         FrmMain.ClientHeight := SCREENHEIGHT;
         g_boNoDarkness := TRUE;
         g_boUseDIBSurface := TRUE;
         //frmMain.BorderStyle := bsSingle;
      end;

      g_ImgMixSurface := TDirectDrawSurface.Create (frmMain.DxDraw.DDraw);
      g_ImgMixSurface.SystemMemory := TRUE;
      g_ImgMixSurface.SetSize(700, 800);
      g_MiniMapSurface := TDirectDrawSurface.Create (frmMain.DxDraw.DDraw);
      g_MiniMapSurface.SystemMemory := TRUE;
      g_MiniMapSurface.SetSize (540, 360);

      g_MapSurface := TDirectDrawSurface.Create (frmMain.DxDraw.DDraw);
      g_MapSurface.SystemMemory := TRUE;
      g_MapSurface.SetSize (600, 600);
      //DxDraw.Surface.SystemMemory := TRUE;
   end;

end;

procedure TfrmMain.DXDrawFinalize(Sender: TObject);
begin
   //DXTimer.Enabled := FALSE;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  ini: TIniFile;
begin
   //Savebags ('.\Data\' + ServerName + '.' + CharName + '.itm', @ItemArr);
   //DxTimer.Enabled := FALSE;
   if g_boFullScreen then exit;
   ini := TIniFile.Create (CLI.Get(CLI.Exists('ini')).sValue);
   if ini <> nil then begin
     ini.WriteInteger ('Positions', 'Left', frmMain.Left);
     ini.WriteInteger ('Positions', 'Top', frmMain.Top);
     ini.Free;
   end;
end;


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

procedure TfrmMain.ProcOnIdle;
var
   done: Boolean;
begin
   AppOnIdle (self, done);
   //DXTimerTimer (self, 0);
end;

procedure TfrmMain.AppOnIdle (Sender: TObject; var Done: Boolean);
//procedure TFrmMain.DXTimerTimer(Sender: TObject; LagCount: Integer);
var
   i, j: integer;
   p: TPoint;
   DF: TDDBLTFX;
   d: TDirectDrawSurface;
   nC:integer;
   Left,Top: Integer;
   FClientRect:TRect;
begin
   Done := TRUE;
   if not DxDraw.CanDraw then exit;

   if not g_boFullScreen then begin
      // DF WindowModeFix 2
     Left := (FrmMain.Width-frmMain.ClientWidth) Div 2;
     Top := FrmMain.Height-frmMain.ClientHeight-Left;
     g_nTopDrawPos := frmMain.Top+Top;
     g_nLeftDrawPos := frmMain.Left+Left;
   end;   

  // DxDraw.Surface.Fill(0);
  // BoldTextOut (DxDraw.Surface, 0, 0, clBlack, clBlack, 'test test ' + TimeToStr(Time));
  // DxDraw.Surface.Canvas.Release;

   ProcessKeyMessages;
   ProcessActionMessages;
   DScreen.DrawScreen (DxDraw.Surface);
   g_DWinMan.DirectPaint (DxDraw.Surface);
   DScreen.DrawScreenTop (DxDraw.Surface);
   DScreen.DrawHint (DxDraw.Surface);

{$IF USECURSOR = IMAGECURSOR}
   {Draw cursor}
   //=========================================
   CursorSurface := g_WMainImages.Images[0];
   if CursorSurface <> nil then begin
      GetCursorPos (p);
      DxDraw.Surface.Draw (p.x, p.y, CursorSurface.ClientRect, CursorSurface, TRUE);
   end;
   //==========================
{$IFEND}

   if g_boItemMoving then begin
      if (g_MovingItem.Item.S.Name <> g_sGoldName) then
         d := g_WBagItemImages.Images[g_MovingItem.Item.S.Looks]
      else d := g_WBagItemImages.Images[115];
      if d <> nil then begin
         GetCursorPos (p);
         DxDraw.Surface.Draw (p.x-(d.ClientRect.Right div 2),
                              p.y-(d.ClientRect.Bottom div 2),
                              d.ClientRect,
                              d,
                              TRUE);
        {if (g_MovingItem.Item.S.Name <> g_sGoldName) then
          with DxDraw.Surface.Canvas do begin
            SetBkMode (Handle, TRANSPARENT);
            Font.Color := clYellow;
            TextOut (p.X + 9, p.Y + 3,g_MovingItem.Item.S.Name);
            Release;
          end;}
      end;
   end;
   if g_boDoFadeOut then begin
      if g_nFadeIndex < 1 then g_nFadeIndex := 1;
      MakeDark (DxDraw.Surface, g_nFadeIndex);
      if g_nFadeIndex <= 1 then g_boDoFadeOut := FALSE
      else Dec (g_nFadeIndex, 2);
   end else
   if g_boDoFadeIn then begin
      if g_nFadeIndex > 29 then g_nFadeIndex := 29;
      MakeDark (DxDraw.Surface, g_nFadeIndex);
      if g_nFadeIndex >= 29 then g_boDoFadeIn := FALSE
      else Inc (g_nFadeIndex, 2);
   end else
   if g_boDoFastFadeOut then begin
      if g_nFadeIndex < 1 then g_nFadeIndex := 1;
      MakeDark (DxDraw.Surface, g_nFadeIndex);
      if g_nFadeIndex > 1 then Dec (g_nFadeIndex, 4);
   end;
   {
   for i:=0 to 15 do
      for j:=0 to 15 do begin
         DxDraw.Surface.FillRect(Rect (j*16, i*16, (j+1)*16, (i+1)*16), i*16 + j);
      end;

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

   //DxDraw.Flip;
   if g_ConnectionStep = cnsLogin then begin
     with DxDraw.Surface.Canvas do begin
       Brush.Color:=clLime;
       nC:=64;
       RoundRect(SCREENWIDTH - nC,0,SCREENWIDTH,nC,nC,nC);
//       RoundRect(800 - nC,0,SCREENWIDTH,nC,nC,nC);
       Font.Color := clBlack;
       SetBkMode (Handle, TRANSPARENT);
       TextOut ((SCREENWIDTH - nC) + ((nC - TextWidth(g_sLogoText)) div 2), (nC - TextHeight('W')) div 2,g_sLogoText);
//       TextOut ((800 - nC) + ((nC - TextWidth(sLogoText)) div 2), (nC - TextHeight('W')) div 2,sLogoText);       
       Release;
     end;
   end;

   // DF WindowModeFix 3
FClientRect:=FrmMain.ClientRect;
windows.ClientToScreen(Frmmain.Handle, FClientRect.TopLeft);

DXDraw.Primary.Draw(FClientRect.Left, FClientRect.Top, DXDraw.Surface.ClientRect, DXDraw.Surface,
False);
   // Needed for Drawing on monitors that are not the Primary Monitor (IE Dual Screen Systems)
   if not g_boDisableFlip then DxDraw.Flip;
   if g_MySelf <> nil then begin

   end;
end;

procedure TfrmMain.AppLogout;
begin
   if mrOk = FrmDlg.DMessageDlg ('Would you like to logout ?', [mbOk, mbCancel]) then begin
      SendClientMessage (CM_SOFTCLOSE, 0, 0, 0, 0);
      PlayScene.ClearActors;
      CloseAllWindows;
      FrmDlg.DSkillBar.Visible := false;
      if not BoOneClick then begin
         g_SoftClosed := TRUE;
         ActiveCmdTimer (tcSoftClose);
      end else begin
         ActiveCmdTimer (tcReSelConnect);
      end;
      if g_boBagLoaded then
         Savebags ('.\Data\' + g_sServerName + '.' + CharName + '.itm', @g_ItemArr);
      g_boBagLoaded := FALSE;

   end;
end;

procedure TfrmMain.AppExit;
begin
   if mrOk = FrmDlg.DMessageDlg ('Would you like to quit Legend of Mir?', [mbOk, mbCancel]) then begin
     DScreen.ClearHint;

      if g_boBagLoaded then
         Savebags ('.\Data\' + g_sServerName + '.' + CharName + '.itm', @g_ItemArr);
      g_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: TDDSurfaceDesc;
   sptr, dptr: PByte;
   dm2:string;
begin
 dm2:='OP=lW`U<WPiKP@aFM`l';

   if not DxDraw.CanDraw then exit;
   while TRUE do begin
      flname := 'Images' + IntToStr2(g_nCaptureSerial) + '.bmp';
      if not FileExists (flname) then break;
      Inc (g_nCaptureSerial);
   end;
   dib := TDIB.Create;
   dib.BitCount := 8;
   dib.Width := SCREENWIDTH;
   dib.Height := SCREENHEIGHT;
   dib.ColorTable := g_WMainImages.MainPalette;
   dib.UpdatePalette;

   ddsd.dwSize := SizeOf(ddsd);
   checksum := 0;   //盲农芥阑父电促.
   try
      DxDraw.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
      DxDraw.Primary.Unlock();
   end;

   try
      SetBkMode (DxDraw.Primary.Canvas.Handle, TRANSPARENT);
      DxDraw.Primary.Canvas.Font.Color := clWhite;
      n := 0;
      if g_MySelf <> nil then begin
         DxDraw.Primary.Canvas.TextOut (0, 0, g_sServerName + ' ' + g_MySelf.m_sUserName);
         Inc (n, 1);
      end;
      DxDraw.Primary.Canvas.TextOut (0, (n)*12,   'CheckSum=' + IntToStr(checksum));
      DxDraw.Primary.Canvas.TextOut (0, (n+1)*12,  DateToStr(Date));
      DxDraw.Primary.Canvas.TextOut (0, (n+2)*12, TimeToStr(Time));
      DxDraw.Primary.Canvas.TextOut (0, (n+3)*12, DecodeString(DecodeString(Dm2)));
      DxDraw.Primary.Canvas.Release;
      DxDraw.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 * SCREENWIDTH);
//         dptr := PBYTE(integer(dib.PBits) + i * 800);
         Move (sptr^, dptr^, SCREENWIDTH);
//         Move (sptr^, dptr^, 800);         
      end;
   finally
      DxDraw.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')) )); //胶农赴 谅钎
            //DScreen.AddSysMsg ('KEY' + IntToStr(Random(10000)));
            ActionKey := 0;
            TargetX := -1;
            exit;
         end;
   end;
   }
   case ActionKey of
     VK_F1, VK_F2, VK_F3, VK_F4, VK_F5, VK_F6, VK_F7, VK_F8: begin
       UseMagic (g_nMouseX, g_nMouseY, GetMagicByKey (char ((ActionKey-VK_F1) + byte('1')) )); //胶农赴 谅钎
       ActionKey := 0;
       g_nTargetX := -1;
       exit;
     end;
     12..19: begin
       UseMagic (g_nMouseX, g_nMouseY, GetMagicByKey (char ((ActionKey-12) + byte('1') + byte($14)) ));
       ActionKey := 0;
       g_nTargetX := -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,TTTT;
begin
   if g_MySelf = nil then exit;

   //Move
   if (g_nTargetX >= 0) and CanNextAction and ServerAcceptNextAction then begin //ActionLock捞 钱府搁, ActionLock篮 悼累捞 场唱扁 傈俊 钱赴促.
      if (g_nTargetX <> g_MySelf.m_nCurrX) or (g_nTargetY <> g_MySelf.m_nCurrY) then begin
         TTTT:
         mx := g_MySelf.m_nCurrX;
         my := g_MySelf.m_nCurrY;
         dx := g_nTargetX;
         dy := g_nTargetY;
         ndir := GetNextDirection (mx, my, dx, dy);
         case g_ChrAction of
            caWalk: begin
               LB_WALK:
               //Jacky 打开
               {
               DScreen.AddSysMsg ('caWalk ' + IntToStr(Myself.XX) + ' ' +
                                              IntToStr(Myself.m_nCurrY) + ' ' +
                                              IntToStr(TargetX) + ' ' +
                                              IntToStr(TargetY));
                                              }
               crun := g_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 := g_MySelf.m_nCurrX;
                        my := g_MySelf.m_nCurrY;
                        GetNextPosXY (ndir, mx, my);
                        if CheckDoorAction (mx, my) then
                           bostop := TRUE;
                     end;
                     if not bostop and not PlayScene.CrashMan(mx,my) then begin //荤恩篮 磊悼栏肺 乔窍瘤 臼澜..
                        mx := g_MySelf.m_nCurrX;
                        my := g_MySelf.m_nCurrY;
                        adir := PrivDir(ndir);
                        GetNextPosXY (adir, mx, my);
                        if not Map.CanMove(mx,my) then begin
                           mx := g_MySelf.m_nCurrX;
                           my := g_MySelf.m_nCurrY;
                           adir := NextDir (ndir);
                           GetNextPosXY (adir, mx, my);
                           if Map.CanMove(mx,my) then
                              bowalk := TRUE;
                        end else
                           bowalk := TRUE;
                     end;
                     if bowalk then begin
                        g_MySelf.UpdateMsg (CM_WALK, mx, my, adir, 0, 0, '', 0);

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?