Delphi控件源码

开发平台：
Delphi

SystemSetFrm.pas：源码内容
							unit SystemSetFrm;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSock, Buttons, ExtCtrls, Registry, RealMessengerUnit, MMSystem,
  bsSkinCtrls, bsSkinBoxCtrls, BusinessSkinForm, ComCtrls, bsSkinTabs,IniFiles;
type
  TSystemSetForm = class(TForm)
    Bevel1: TBevel;
    BitBtn1: TbsSkinButton;
    bsSkinButton2: TbsSkinButton;
    bsSkinPageControl1: TbsSkinPageControl;
    bsSkinTabSheet1: TbsSkinTabSheet;
    bsSkinTabSheet2: TbsSkinTabSheet;
    bsSkinTabSheet3: TbsSkinTabSheet;
    EDHostName: TEdit;
    CBProxyCategory: TComboBox;
    bsSkinLabel2: TbsSkinLabel;
    bsSkinLabel4: TbsSkinLabel;
    GroupBox1: TbsSkinGroupBox;
    Label1: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label7: TLabel;
    EDProxyPassword: TEdit;
    EDProxyUsername: TEdit;
    EDProxyAddress: TEdit;
    EDProxyPort: TEdit;
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    bsSkinLabel3: TbsSkinLabel;
    EDServerPort: TEdit;
    Edit1: TEdit;
    bsSkinGroupBox1: TbsSkinGroupBox;
    bsSkinButton1: TbsSkinButton;
    bsSkinComboBox1: TbsSkinComboBox;
    bsSkinLabel1: TbsSkinLabel;
    SBSelFile: TSpeedButton;
    SBPlay: TSpeedButton;
    Label5: TLabel;
    EDMsgSound: TEdit;
    CBDontPlaySound: TCheckBox;
    CBDontAutoConnect: TCheckBox;
    EDAutoConnectInterval: TEdit;
    bsSkinLabel5: TbsSkinLabel;
    bsSkinLabel6: TbsSkinLabel;
    OpenDialog1: TOpenDialog;
    CBAutoRun: TCheckBox;
    bsSkinTabSheet4: TbsSkinTabSheet;
    Label2: TLabel;
    Edit2: TEdit;
    procedure FormShow(Sender: TObject);
    procedure CBDontPlaySoundClick(Sender: TObject);
    procedure CBDontAutoConnectClick(Sender: TObject);
    procedure SBPlayClick(Sender: TObject);
    procedure SBSelFileClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure CBProxyCategoryChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bsSkinComboBox1Change(Sender: TObject);
    procedure bsSkinButton2Click(Sender: TObject);
  private
    procedure SetAutoRun(IsAutoRun: Boolean);
    function GetAutoRun(): Boolean;
    procedure loadskin(filename, filetype: string);
  public
    { Public declarations }
  end;
var
  SystemSetForm: TSystemSetForm;
implementation
uses
  RealMessengerImpl;
{$R *.dfm}
function TSystemSetForm.GetAutoRun(): Boolean;
var
  TempReg: TRegistry;
begin
  Result := False;
  TempReg := TRegistry.Create;
  try
    TempReg.RootKey := HKEY_LOCAL_MACHINE;
    if TempReg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun', False) then
    begin
      if TempReg.ReadString('易通科技') = Application.ExeName then
        Result := True
    end;
  finally
    TempReg.Free;
  end;
end;
procedure TSystemSetForm.SetAutoRun(IsAutoRun: Boolean);
var
  TempReg: TRegistry;
begin
  TempReg := TRegistry.Create;
  try
    TempReg.RootKey := HKEY_LOCAL_MACHINE;
    if TempReg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun', False) then
    begin
      if IsAutoRun then
        TempReg.WriteString('易通科技', Application.ExeName) {设置程序自动启动}
      else
        TempReg.DeleteValue('易通科技'); {取消程序自动启动}
    end;
  finally
    TempReg.Free;
  end;
end;
procedure TSystemSetForm.FormShow(Sender: TObject);
begin
  EDHostName.Text := HostName;
  EDServerPort.Text := IntToStr(ServerPort);
  CBProxyCategory.ItemIndex := Integer(ProxyCategory);
  CBProxyCategoryChange(CBProxyCategory);
  EDProxyAddress.Text := ProxyAddress;
  EDProxyPort.Text := IntToStr(ProxyPort);
  EDProxyUsername.Text := ProxyUsername;
  EDProxyPassword.Text := ProxyPassword;
  CBAutoRun.Checked := GetAutoRun;
  EDMsgSound.Text := MsgSound;
  if DontPlaySound then
  begin
    CBDontPlaySound.Checked := True;
    EDMsgSound.Enabled := False;
    SBSelFile.Enabled := False;
    SBPlay.Enabled := False;
  end;
  EDAutoConnectInterval.Text := IntToStr(AutoConnectInterval);
  if DontAutoConnect then
  begin
    CBDontAutoConnect.Checked := True;
    EDAutoConnectInterval.Enabled := False;
  end;
end;
procedure TSystemSetForm.CBDontPlaySoundClick(Sender: TObject);
begin
  EDMsgSound.Enabled := not CBDontPlaySound.Checked;
  SBSelFile.Enabled := not CBDontPlaySound.Checked;
  SBPlay.Enabled := not CBDontPlaySound.Checked;
end;
procedure TSystemSetForm.CBDontAutoConnectClick(Sender: TObject);
begin
  EDAutoConnectInterval.Enabled := not CBDontAutoConnect.Checked;
end;
procedure TSystemSetForm.SBPlayClick(Sender: TObject);
begin
  PlaySound(PChar(EDMsgSound.Text), 0, SND_ASYNC or SND_FILENAME);
end;
procedure TSystemSetForm.SBSelFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then EDMsgSound.Text := OpenDialog1.filename;
end;
procedure TSystemSetForm.BitBtn1Click(Sender: TObject);
var
  Port, socksPort, Interval: Integer;
  TempReg: TRegistry;
  ServerInfoChanged: Boolean;
  f: TIniFile;
begin
  f := TIniFile.Create(ExtractFileDir(Application.ExeName) + 'IP_set.ini');
  f.WriteString('netip', 'IP', trim(Edit2.Text));
  f.Free;
  socksPort := ProxyPort;
  if trim(EDHostName.Text) = '' then
  begin
    MessageBox(Handle, '请输入服务器地址！', '提示', MB_ICONINFORMATION);
    Exit;
  end;
  try
    Port := StrToInt(EDServerPort.Text);
    if (Port <= 0) or (Port > 32767) then
    begin
      MessageBox(Handle, '端口号必须为大于0且小于32768的数字！', '提示', MB_ICONINFORMATION);
      Exit;
    end;
  except
    MessageBox(Handle, '端口号必须为数字！', '提示', MB_ICONINFORMATION);
    Exit;
  end;
  if CBProxyCategory.ItemIndex > 0 then
  begin
    if trim(EDProxyAddress.Text) = '' then
    begin
      MessageBox(Handle, '请输入代理服务器地址！', '提示', MB_ICONINFORMATION);
      Exit;
    end;
    try
      socksPort := StrToInt(EDProxyPort.Text);
      if (socksPort <= 0) or (socksPort > 32767) then
      begin
        MessageBox(Handle, '代理服务器端口号必须为大于0且小于32768的数字！', '提示', MB_ICONINFORMATION);
        Exit;
      end;
    except
      MessageBox(Handle, '代理服务器端口号必须为数字！', '提示', MB_ICONINFORMATION);
      Exit;
    end;
  end;
  Interval := 0;
  if not CBDontAutoConnect.Checked then
  begin
    try
      Interval := StrToInt(EDAutoConnectInterval.Text);
      if (Interval <= 0) then
      begin
        MessageBox(Handle, '自动连接时间必须为大于0的数字！', '提示', MB_ICONINFORMATION);
        Exit;
      end;
    except
      MessageBox(Handle, '自动连接时间必须为数字！', '提示', MB_ICONINFORMATION);
      Exit;
    end;
  end;
  SetAutoRun(CBAutoRun.Checked);
  ServerInfoChanged := False;
  TempReg := TRegistry.Create;
  try
    TempReg.RootKey := HKEY_LOCAL_MACHINE;
    if TempReg.OpenKey(AppKey + 'Login', True) then
    begin
      if (HostName <> trim(EDHostName.Text)) or (ServerPort <> Port) then ServerInfoChanged := True;
      HostName := trim(EDHostName.Text);
      ServerPort := Port;
      ProxyCategory := TProxyCategory(CBProxyCategory.ItemIndex);
      ProxyAddress := trim(EDProxyAddress.Text);
      ProxyPort := socksPort;
      ProxyUsername := trim(EDProxyUsername.Text);
      ProxyPassword := trim(EDProxyPassword.Text);
      MsgSound := trim(EDMsgSound.Text);
      DontPlaySound := CBDontPlaySound.Checked;
      if Interval > 0 then AutoConnectInterval := Interval;
      DontAutoConnect := CBDontAutoConnect.Checked;
      TempReg.WriteString('HostName', HostName);
      TempReg.WriteString('ServerPort', IntToStr(ServerPort));
      TempReg.WriteString('ProxyCategory', IntToStr(Integer(ProxyCategory)));
      TempReg.WriteString('ProxyAddress', ProxyAddress);
      TempReg.WriteString('ProxyPort', IntToStr(ProxyPort));
      TempReg.WriteString('ProxyUsername', ProxyUsername);
      TempReg.WriteString('ProxyPassword', ProxyPassword);
      TempReg.WriteString('MsgSound', MsgSound);
      TempReg.WriteString('DontPlaySound', IntToStr(Integer(DontPlaySound)));
      TempReg.WriteString('AutoConnectInterval', IntToStr(AutoConnectInterval));
      TempReg.WriteString('DontAutoConnect', IntToStr(Integer(DontAutoConnect)));
      HostToIP(HostName, HostIP);
      if ProxyAddress <> '' then HostToIP(ProxyAddress, ProxyAddress);
    end;
  finally
    TempReg.Free;
  end;
  ModalResult := mrOK;
  if ServerInfoChanged and (RealMessengerX.MDisconnect.Enabled) then
  begin
    Hide;
    RealMessengerX.MDisconnectClick(nil);
    if MessageBox(Handle, '服务器信息已改动，当前登录已注销，是否使用当前的帐号自动重新登录？', '提示', MB_YESNO or MB_ICONQUESTION) = IDYES then
    begin
      RealMessengerX.TimerAutoConnect.Enabled := False;
      RealMessengerX.MConnect.Enabled := False;
      RealMessengerX.SendIdentity();
    end;
  end;
end;
procedure TSystemSetForm.CBProxyCategoryChange(Sender: TObject);
var
  iLoop: Integer;
begin
  if CBProxyCategory.ItemIndex > 0 then
    for iLoop := 0 to GroupBox1.ControlCount - 1 do GroupBox1.Controls[iLoop].Enabled := True
  else
    for iLoop := 0 to GroupBox1.ControlCount - 1 do GroupBox1.Controls[iLoop].Enabled := False;
  if CBProxyCategory.ItemIndex = Integer(pcHTTP) then
    EDProxyPort.Text := '808'
  else
    EDProxyPort.Text := '1080';
end;
procedure TSystemSetForm.loadskin(filename, filetype: string);
var
  strfile: tstringlist;
begin
  if fileexists(filename) then begin
    strfile := tstringlist.Create;
    RealMessengerX.Skin1.LoadFromIniFile(filename);
    RealMessengerX.bsSkinData1.LoadCompressedStoredSkin(RealMessengerX.Skin1);
    strfile.Add(filetype);
    strfile.SaveToFile(extractfilepath(Application.ExeName) + 'skin.ini');
    strfile.Free;
  end;
end;
procedure TSystemSetForm.FormCreate(Sender: TObject);
var
  Path: string;
  lindex, i, j: Integer;
  sr: TSearchRec;
  lname, m_SkinPath, name: string;
  str: tstringlist;
begin
  lindex := 9999;
  if fileexists(extractfilepath(Application.ExeName) + 'skin.ini') then begin
    try
      str := tstringlist.Create;
      str.LoadFromFile(extractfilepath(Application.ExeName) + 'skin.ini');
      if str.Count > 0 then
        lname := str.Strings[0];
    finally
      str.Free;
    end;
  end;
  Path := extractfilepath(ParamStr(0));
  m_SkinPath := Path + 'MySkins';
  Edit1.Text := m_SkinPath + '*';
  //添加皮肤列表
  if FindFirst(Edit1.Text, faDirectory, sr) = 0 then
  begin
    repeat
        //if (sr.Attr and FileAttrs) = sr.Attr then
      begin
        if (sr.name <> '.') and (sr.name <> '..') then begin
          if sr.name = lname then
            lindex := bsSkinComboBox1.Items.Add(sr.name)
          else
            bsSkinComboBox1.Items.Add(sr.name);
        end;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  if lindex <> 9999 then
    bsSkinComboBox1.ItemIndex := lindex;
end;
procedure TSystemSetForm.bsSkinComboBox1Change(Sender: TObject);
var
  Path, m_SkinPath, name: string;
begin
  Path := extractfilepath(ParamStr(0));
  m_SkinPath := Path + 'MySkins';
  name := bsSkinComboBox1.Text;
  loadskin(m_SkinPath + name + 'skin.ini', name);
end;
procedure TSystemSetForm.bsSkinButton2Click(Sender: TObject);
begin
  close;
end;
end.

						