📄 nhcconfig.pas
字号:
unit NhcConfig;
interface
uses
Windows, SysUtils, Classes, Graphics, Forms, NhConfigMgr, NhGlobalST;
type
{ TNhcConfigMgr }
TServerIpInfo = record
Name: string;
IP: string;
Port: Word;
end;
TServerIPInfoAry = array of TServerIpInfo;
TNhcConfigMgr = class(TCustomConfigMgr)
private
FUpgradeUrl: string;
FUserName: string;
FPassword: string;
FChatFont: TChatFontStyle;
FBeepOnRecvBroad: Boolean;
FUpdateSrvListUrl: string;
FNetServerCount: Integer;
FNetServers: TServerIpInfoAry;
FUserServerCount: Integer;
FUserServers: TServerIpInfoAry;
FUseSound: Boolean;
FSkinIndex: Integer;
function GetIniFileName: string;
function GetGames(GameID: Integer): TGameRunParam;
procedure SetGames(GameID: Integer; const Value: TGameRunParam);
procedure SetChatFont(const Value: TChatFontStyle);
function GetServers(Index: Integer): TServerIPInfo;
function GetUserServers(Index: Integer): TServerIpInfo;
public
constructor Create;
destructor Destroy; override;
procedure Load;
procedure Save;
procedure UpdateNetServers(const SrvIpAry: TServerIPInfoAry);
procedure AddUserServer(const SrvIpInfo: TServerIpInfo);
procedure RemoveUserServer(Index: Integer);
property UpdateSrvListUrl: string read FUpdateSrvListUrl;
property NetServerCount: Integer read FNetServerCount;
property NetServers[Index: Integer]: TServerIPInfo read GetServers;
property UserServerCount: Integer read FUserServerCount;
property UserServers[Index: Integer]: TServerIpInfo read GetUserServers;
property UpgradeUrl: string read FUpgradeUrl;
property UserName: string read FUserName write FUserName;
property Password: string read FPassword write FPassword;
property ChatFont: TChatFontStyle read FChatFont write SetChatFont;
property UseSound: Boolean read FUseSound write FUseSound;
property SkinIndex: Integer read FSkinIndex write FSkinIndex;
property Games[GameID: Integer]: TGameRunParam read GetGames write SetGames;
property BeepOnRecvBroad: Boolean read FBeepOnRecvBroad write FBeepOnRecvBroad;
end;
var
ConfigMgr: TNhcConfigMgr;
implementation
const
SConfigFileName = 'Config.ini';
SUser = 'User';
SServer = 'Server';
SGame = 'Game';
SMisc = 'Misc';
{ TNhcConfigMgr }
procedure TNhcConfigMgr.AddUserServer(const SrvIpInfo: TServerIpInfo);
begin
Inc(FUserServerCount);
SetLength(FUserServers, FUserServerCount);
with FUserServers[FUserServerCount-1] do
begin
Name := SrvIpInfo.Name;
IP:= SrvIpInfo.IP;
Port := SrvIpInfo.Port;
end;
end;
constructor TNhcConfigMgr.Create;
begin
inherited;
Load;
end;
destructor TNhcConfigMgr.Destroy;
begin
Save;
inherited;
end;
function TNhcConfigMgr.GetGames(GameID: Integer): TGameRunParam;
begin
Result.GameName := GetString(SGame, 'GameName'+IntToStr(GameID), '');
Result.GameExe := GetString(SGame, 'GameExe'+IntToStr(GameID), '');
Result.GameParam := GetString(SGame, 'GameParam'+IntToStr(GameID), '');
end;
function TNhcConfigMgr.GetIniFileName: string;
begin
Result := ExtractFilePath(Application.ExeName) + SConfigFileName;
end;
function TNhcConfigMgr.GetServers(Index: Integer): TServerIPInfo;
begin
Result := FNetServers[Index];
end;
function TNhcConfigMgr.GetUserServers(Index: Integer): TServerIpInfo;
begin
Result := FUserServers[Index];
end;
procedure TNhcConfigMgr.Load;
procedure LoadServer;
var
I: Integer;
begin
FNetServerCount := GetInteger(SServer, 'NetServerCount', 0);
SetLength(FNetServers, FNetServerCount);
for I := 0 to FNetServerCount - 1 do
begin
FNetServers[I].Name := GetString(SServer, 'NetServerName_'+IntToStr(I), '');
FNetServers[I].IP := GetString(SServer, 'NetServerIp_'+IntToStr(I), '');
FNetServers[I].Port := GetInteger(SServer, 'NetServerPort_'+IntToStr(I), 25000);
end;
FUserServerCount := GetInteger(SServer, 'UserServerCount', 0);
SetLength(FUserServers, FUserServerCount);
for I := 0 to FUserServerCount - 1 do
begin
FUserServers[I].Name := GetString(SServer, 'UserServerName_'+IntToStr(I), '');
FUserServers[I].IP := GetString(SServer, 'UserServerIp_'+IntToStr(I), '');
FUserServers[I].Port := GetInteger(SServer, 'UserServerPort_'+IntToStr(I), 25000);
end;
FUpdateSrvListUrl := GetString(SServer, 'UpdateSrvListUrl', '');
FUpgradeUrl := GetString(SServer, 'UpgradeUrl', '');
end;
procedure LoadMisc;
begin
FBeepOnRecvBroad := GetBoolean(SMisc, 'BeepOnRecvBroad', True);
FUseSound := GetBoolean(SMisc, 'UseSound', True);
FSkinIndex := GetInteger(SMisc, 'SkinIndex', 0);
end;
procedure LoadUser;
begin
FUserName := GetString(SUser, 'UserName', '');
FPassword := GetString(SUser, 'Password', '');
FChatFont.Name := GetString(SUser, 'FONT_Name', '宋体');
FChatFont.Color := GetInteger(SUser, 'FONT_Color', 0);
FChatFont.Size := GetInteger(SUser, 'FONT_Size', 9);
FChatFont.Bold := GetInteger(SUser, 'FONT_Bold', 0);
FChatFont.Italic := GetInteger(SUser, 'FONT_Italic', 0);
FChatFont.Underline := GetInteger(SUser, 'FONT_Underline', 0);
FChatFont.Strikeout := GetInteger(SUser, 'FONT_StrikeOut', 0);
end;
procedure LoadGames;
begin
end;
begin
LoadFromIniFile(GetIniFileName);
LoadUser;
LoadServer;
LoadMisc;
LoadGames;
end;
procedure TNhcConfigMgr.RemoveUserServer(Index: Integer);
var
I: Integer;
begin
if (Index < 0) or (Index >= FUserServerCount) then
raise Exception.Create('Config Index Out Of Bound');
for I := Index + 1 to FUserServerCount - 1 do
begin
FUserServers[Index] := FUserServers[Index + 1];
end;
SetLength(FUserServers, FUserServerCount-1);
Dec(FUserServerCount);
end;
procedure TNhcConfigMgr.Save;
procedure SaveServer;
var
I: Integer;
begin
SetInteger(SServer, 'NetServerCount', FNetServerCount);
for I := 0 to FNetServerCount - 1 do
begin
SetString(SServer, 'NetServerName_' + IntToStr(I), FNetServers[I].Name);
SetString(SServer, 'NetServerIp_' + IntToStr(I), FNetServers[I].IP);
SetInteger(SServer, 'NetServerPort_' + IntToStr(I), FNetServers[I].Port);
end;
SetInteger(SServer, 'UserServerCount', FUserServerCount);
for I := 0 to FUserServerCount - 1 do
begin
SetString(SServer, 'UserServerName_' + IntToStr(I), FUserServers[I].Name);
SetString(SServer, 'UserServerIp_' + IntToStr(I), FUserServers[I].IP);
SetInteger(SServer, 'UserServerPort_' + IntToStr(I), FUserServers[I].Port);
end;
end;
procedure SaveMisc;
begin
SetBoolean(SMisc, 'BeepOnRecvBroad', FBeepOnRecvBroad);
SetBoolean(SMisc, 'UseSound', FUseSound);
SetInteger(SMisc, 'SkinIndex', FSkinIndex);
end;
procedure SaveUser;
begin
SetString(SUser, 'UserName', FUserName);
SetString(SUser, 'Password', FPassword);
SetString(SUser, 'FONT_Name', FChatFont.Name);
SetInteger(SUser, 'FONT_Color', FChatFont.Color);
SetInteger(SUser, 'FONT_Size', FChatFont.Size);
SetInteger(SUser, 'FONT_Bold', FChatFont.Bold);
SetInteger(SUser, 'FONT_Italic', FChatFont.Italic);
SetInteger(SUser, 'FONT_Underline', FChatFont.Underline);
SetInteger(SUser, 'FONT_StrikeOut', FChatFont.Strikeout);
end;
procedure SaveGame;
begin
end;
begin
SaveUser;
SaveServer;
SaveMisc;
SaveGame;
SaveToIniFile(GetIniFileName);
end;
procedure TNhcConfigMgr.SetChatFont(const Value: TChatFontStyle);
begin
FChatFont := Value;
end;
procedure TNhcConfigMgr.SetGames(GameID: Integer; const Value: TGameRunParam);
begin
SetString(SGame, 'GameName'+IntToStr(GameID), Value.GameName);
SetString(SGame, 'GameExe'+IntToStr(GameID), Value.GameExe);
SetString(SGame, 'GameParam'+IntToStr(GameID), Value.GameParam);
Save;
end;
procedure TNhcConfigMgr.UpdateNetServers(const SrvIpAry: TServerIPInfoAry);
var
I: Integer;
begin
if Length(SrvIpAry) > 0 then
begin
FNetServerCount := Length(SrvIpAry);
SetLength(FNetServers, FNetServerCount);
for I := 0 to Length(SrvIpAry) - 1 do
begin
FNetServers[I] := SrvIpAry[I];
end;
end;
Save;
end;
initialization
ConfigMgr := TNhcConfigMgr.Create;
finalization
ConfigMgr.Free;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -