mainfrm.pas

NetHook API 对战平台内核库是一套实现时下流行的网络对战平台[如浩方、VS]同样功能的通用内核库

        NetMgr.NetBusiness.SelfInfo.GetGameNameByID(GameID);
      FUserAry[Integer(UserListView.Items[I].Data)].GameID := GameID;
    end;
  end;
end;

procedure TMainForm.OnUserEnterNotify(const UserInfo: TBaseUserInfo);
const
  FMTSTR = '[系统消息] %s 进来了(%s)';
var
  I: Integer;
  SaveIndex: Integer;
begin
  Assert(GetCurrentThreadId = MainThreadID);

  for I := 0 to UserListView.Items.Count - 1 do
  begin
    if UserListView.Items[I].Caption = UserInfo.UserName then
    begin
      UserListView.Items[I].Delete;
    end;
  end;

  with UserListView.Items.Add do
  begin
    SaveIndex := AllocUserAryIndex;
    Assert(SaveIndex >= 1);

    Caption := UserInfo.UserName;
    SubItems.Add(UserInfo.LevelName);
    SubItems.Add(NetMgr.NetBusiness.SelfInfo.GetGameNameByID(UserInfo.GameID));
    Data := Pointer(SaveIndex);     // 设置存储位置

    FUserAry[SaveIndex] := UserInfo;  // 赋值
  end;

  DisplaySystemInfo(Format(FMTSTR, [UserInfo.UserName, GetNowTimeStr]));

  if ConfigMgr.UseSound then
    PlaySoundFromRes('UserEnter');
end;

procedure TMainForm.OnUserLeaveNotify(const UserName: string);
const
  FMTSTR = '[系统消息] %s 离开了(%s)';
var
  I: Integer;
begin
  Assert(GetCurrentThreadId = MainThreadID);

  for I := UserListView.Items.Count - 1 downto 0 do
  begin
    if UserListView.Items[I].Caption = UserName then
    begin
      // 释放分配存储的Index
      if UserListView.Items[I].Data <> nil then
        DeAllocUserAryIndex(Integer(UserListView.Items[I].Data));

      UserListView.Items[I].Delete;
    end;
  end;

  DisplaySystemInfo(Format(FMTSTR, [UserName, GetNowTimeStr]));

  if ConfigMgr.UseSound then
    PlaySoundFromRes('UserLeave');
end;

procedure TMainForm.PlaySoundFromRes(const ResName: string);
begin
  MmSystem.PlaySound(PChar(ResName), HInstance, SND_RESOURCE or SND_ASYNC);
end;

procedure TMainForm.RecvMsgEditChange(Sender: TObject);
begin
  if RecvMsgEdit.LineCount > 500 then
  begin
    ClearChatMsgBtnClick(nil);
  end;
end;

procedure TMainForm.SearchGameExeBtnClick(Sender: TObject);
var
  ARunExe: string;
begin
  ARunExe := NetMgr.NetBusiness.SelfInfo.GameAry[GameNameCombox.ItemIndex].GameRunExe;

  with TSearchGameForm.Create(Self) do
  try
    SetGameName(GameNameCombox.Text);
    SetSearchFiles(ARunExe);
    ShowModal;

    if Length(GetFindFileName) <> 0  then
      RunGameExeEdit.Text := GetFindFileName;
  finally
    Free;
  end;
end;

procedure TMainForm.SelectExeButtonClick(Sender: TObject);
begin
  with TOpenDialog.Create(Self) do begin
    try
      Filter := '*.exe|*.exe';
      if Execute then
      begin
        RunGameExeEdit.Text := FileName;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TMainForm.SelectFontClick(Sender: TObject);
var
  ChatFont: TChatFontStyle;
begin
  if ChatFontDialog.Execute(Self.Handle) then
  begin
    SendMsgEdit.TextFont := ChatFontDialog.Font;
  end;

  ChatFont := FontToChatFont(ChatFontDialog.Font);
  ConfigMgr.ChatFont := ChatFont;
  ConfigMgr.Save;
end;

procedure TMainForm.SendMsgButtonClick(Sender: TObject);
  function NowTick: Cardinal;
  begin
    Result := DateTimeToUnix(Now);
  end;
var
  ChatMsg: TChatMsgInfo;
begin
  if not SendMsgButton.Enabled then Exit;

  // 控制发言时间不能太快
  if (FLastSendTick <> 0) and ((NowTick - FLastSendTick)<3) then
  begin
    MessageBox(Handle, '发言速度不能太快!', '提示信息', MB_ICONINFORMATION);
    Exit;
  end;

  if Trim(SendMsgEdit.Text) = '' then
  begin
    MessageBox(Handle, '消息不能为空!', '提示信息', MB_ICONINFORMATION);
    Exit;
  end;

  if Length(Trim(SendMsgEdit.Text)) > 128 then
  begin
    MessageBox(Handle, '消息长度太长!', '提示信息', MB_ICONINFORMATION);
    Exit;
  end;

  if ChatIsPrivateCheck.Checked and (ToUserCmb.ItemIndex = 0) then
  begin
    MessageBox(Handle, '私聊信息不能发送给所有人!', '提示信息', MB_ICONINFORMATION);
    Exit;
  end;

  ChatMsg.FromID := 0;
  ChatMsg.FromName := NetMgr.NetBusiness.SelfInfo.UserName;
  ChatMsg.ToID := 0;
  ChatMsg.ToName := ToUserCmb.Text;
  ChatMsg.IsPrivate := ChatIsPrivateCheck.Checked;
  ChatMsg.Msg := Trim(SendMsgEdit.Text);
  ChatMsg.Style := FontToChatFont(ChatFontDialog.Font);

  FLastSendTick := NowTick;
  NetMgr.NetBusiness.SendChatMsg(ChatMsg);

  SendMsgEdit.Text := '';
  SendMsgEdit.TextFont := ChatFontDialog.Font;
end;

procedure TMainForm.StartGameButtonClick(Sender: TObject);
var
  GameParam: TGameRunParam;
  LGameID: Integer;
  LRelayPort: Word;
begin
  LGameID := NetMgr.NetBusiness.SelfInfo.GameAry[GameNameCombox.ItemIndex].GameID;
  LRelayPort := NetMgr.NetBusiness.SelfInfo.GameAry[GameNameCombox.ItemIndex].GameRelayPort;

  GameParam.GameName := GameNameCombox.Text;
  GameParam.GameExe := RunGameExeEdit.Text;
  GameParam.GameParam := RunGameParamEdit.Text;

  // 如果为空设成成--, 用来区分用户是否设定过参数
  if GameParam.GameParam = '' then
    GameParam.GameParam := '--';

  ConfigMgr.Games[LGameID] := GameParam;

  // 如果游戏指定的转发端口为空，则启用默认端口
  if LRelayPort = 0 then
    LRelayPort := NetMgr.NetBusiness.SelfInfo.MainRelayPort;

  // 修改一次魔兽的用户名
  LockWarIIIUserName(AnsiToUtf8(NetMgr.NetBusiness.SelfInfo.UserName));

  with NetMgr.NetBusiness.SelfInfo do
    SetParam(PChar(BaseInfo.VirtualIP), PChar(IpToString(NetMgr.ServerAddr.Ip)), LRelayPort, 0, nil, 0);
  FRunningGameProcessID := InjectDll2Exe(PChar(GameParam.GameExe), PChar(GameParam.GameParam));

  NetMgr.NetBusiness.SendUserEnterGame(LGameID);
  CheckGameStateTimer.Enabled := True;
end;

procedure TMainForm.SystemSetBtnClick(Sender: TObject);
begin
  with TSystemSetForm.Create(nil) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

procedure TMainForm.UserListViewAdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
begin
  if FUserAry[Integer(Item.Data)].UserName = NetMgr.NetBusiness.SelfInfo.UserName then
    Sender.Canvas.Font.Color := clRed;
end;

procedure TMainForm.UserListViewClick(Sender: TObject);
var
  ListItem: TListItem;
  VPoint: TPoint;
begin
  ListItem := UserListView.Selected;
  if ListItem = nil then Exit;

  VPoint := UserListView.ScreenToClient(Mouse.CursorPos);
  VPoint.X := -5;

  VPoint := UserListView.ClientToScreen(VPoint);
  ShowUserInfoForm(VPoint, FUserAry[Integer(ListItem.Data)]);
  SetCapture(UserListView.Handle);
end;

function CustomSortProc(Item1, Item2: TListItem; ParamSort: Integer): Integer; stdcall;
var
  S1, S2: string;
begin
  if FListViewSortColumIndex = 0 then
  begin
    S1 := Item1.Caption;
    S2 := Item2.Caption;
  end else
  begin
    S1 := Item1.SubItems[FListViewSortColumIndex - 1];
    S2 := Item2.SubItems[FListViewSortColumIndex - 1];
  end;

  if FListViewSortFlag then
    Result := CompareText(S1, S2)
  else
    Result := CompareText(S2, S1);
end;

procedure TMainForm.UserListViewColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  FListViewSortColumIndex := Column.Index;
  FListViewSortFlag := not FListViewSortFlag;
  UserListView.CustomSort(@CustomSortProc, 0);
end;

procedure TMainForm.UserListViewDblClick(Sender: TObject);
var
  SelUserName: string;
begin
  if UserListView.Selected = nil then
    Exit;

  SelUserName := UserListView.Selected.Caption;

  // 如果是自己则退出
  if SameText(SelUserName, NetMgr.NetBusiness.SelfInfo.UserName) then
    Exit;

  while ToUserCmb.Items.Count > 1 do
    ToUserCmb.Items.Delete(ToUserCmb.Items.Count - 1);

  ToUserCmb.AddItem(SelUserName, nil);
  ToUserCmb.ItemIndex := 1;
end;

procedure TMainForm.UserListViewExit(Sender: TObject);
begin
  ReleaseCapture;
  HideUserInfoForm;
end;

procedure TMainForm.UserListViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (X < 0) or (Y < 0) or (X > UserListView.Width) or (Y > UserListView.Height) then
  begin
    ReleaseCapture;
    HideUserInfoForm;
  end;
end;

procedure TMainForm.UserNumTimerTimer(Sender: TObject);
begin
  OnlineUserLabel.Caption := Format('当前在线：%d人', [UserListView.Items.Count]);
end;

procedure TMainForm.AbountBtnClick(Sender: TObject);
begin
  ShowAboutForm;
end;

procedure TMainForm.AddRecvChatMsg(const MsgInfo: TChatMsgInfo);
const
  CHATSTR = '%s 说(%s):'#13;
  CHATSTR_PRI = '(私聊)%s 对 %s 说(%s):'#13;
var
  AFont: TFont;
begin
  RecvMsgEdit.ReadOnly := False;
  try
    RecvMsgEdit.MoveCaretToEnd;

    RecvMsgEdit.TextFontName := '宋体';
    RecvMsgEdit.TextFontSize := 9;
    RecvMsgEdit.TextColor := clGray;
    RecvMsgEdit.TextStyles := [];

    if MsgInfo.IsPrivate then
      RecvMsgEdit.SelText := Format(CHATSTR_PRI, [MsgInfo.FromName, MsgInfo.ToName, GetNowTimeStr])
    else
      RecvMsgEdit.SelText := Format(CHATSTR, [MsgInfo.FromName, GetNowTimeStr]);

    AFont := TFont.Create;
    try
      ChatFontToFont(MsgInfo.Style, AFont);
      RecvMsgEdit.TextFont := AFont;
    finally
      AFont.Free;
    end;
    
    RecvMsgEdit.SelText := '  ' + MsgInfo.Msg + #13#13;
  finally
    RecvMsgEdit.ReadOnly := True;
  end;
end;

procedure TMainForm.DisplayGameExeAndParam;
var
  AGameID: Integer;
  AGameParam: string;
begin
  if GameNameCombox.ItemIndex = -1 then Exit;

  with NetMgr.NetBusiness do
  begin
    AGameID := SelfInfo.GameAry[GameNameCombox.ItemIndex].GameID;
    AGameParam := SelfInfo.GameAry[GameNameCombox.ItemIndex].GameRunParam;
  end;

  RunGameExeEdit.Text := ConfigMgr.Games[AGameID].GameExe;

  // 如果本地已经设置过参数(不为空，本地空用"--"表示)，则需要读本地，否则读取服务器
  if ConfigMgr.Games[AGameID].GameParam = '' then
    RunGameParamEdit.Text := AGameParam
  else
  begin
    RunGameParamEdit.Text := ConfigMgr.Games[AGameID].GameParam;
    if RunGameParamEdit.Text = '--' then
      RunGameParamEdit.Text := '';
  end;
end;

procedure TMainForm.DisplaySystemInfo(const Msg: string);
begin
  RecvMsgEdit.ReadOnly := False;
  try
    RecvMsgEdit.MoveCaretToEnd;

    RecvMsgEdit.TextColor := clGreen;
    RecvMsgEdit.TextFontName := '宋体';
    RecvMsgEdit.TextFontSize := 9;
    RecvMsgEdit.TextStyles := [fsBold];
    RecvMsgEdit.SelText := Msg + #13#13;
  finally
    RecvMsgEdit.ReadOnly := True;
  end;
end;

end.