umain.pas

Delphi编写的Cs1.6中文输入软件 支持CS游戏全屏下的中文输入；但只支持CS1.6

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, AAFont, AACtrls, RXShell, Mask,
  ToolEdit, ImgList, RzTray, ShellApi, Buttons, XPMan, RzPanel;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    rtiApp: TRzTrayIcon;
    il1: TImageList;
    btnHelp: TBitBtn;
    RzGroupBox1: TRzGroupBox;
    XPManifest1: TXPManifest;
    diredtCS: TDirectoryEdit;
    lbl1: TLabel;
    cbbIme: TComboBox;
    lbl2: TLabel;
    procedure tmr1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    procedure diredtCSAfterDialog(Sender: TObject; var Name: String;
      var Action: Boolean);
    procedure cbbImeChange(Sender: TObject);
  private
    sF:TStringList;
    isHooked:Boolean;
    iH:Integer;
    procedure GetCSHWND;
  public

  end;

var
  Form1: TForm1;

  function HookOn:Boolean; external 'KeyHook.dll';
  procedure HookOff; external 'KeyHook.dll';

implementation

uses Math, StrUtils, UKeyInput, UFrmHelp;

{$R *.dfm}

procedure TForm1.tmr1Timer(Sender: TObject);
var
  TimeOut:Integer;
begin
  GetCSHWND;
  if iH<>0 then
  begin
    if not isHooked then isHooked:=HookOn;

    if not isHooked then
    begin
      TimeOut:=5;
      rtiApp.ShowBalloonHint('挂接CS失败！','挂接错误！请重新运行软件',bhiError,TimeOut);
      Close;
    end;
  end
  else isHooked:=False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  HookOff;
  FreeAndNil(sF);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose:=MessageBox(0, '确定要退出CS中文输入么？', '提示', MB_OKCANCEL +
    MB_ICONQUESTION + MB_TOPMOST) = IDOK;
end;

procedure TForm1.GetCSHWND;
begin
  iH:=FindWindow(nil,'Counter-Strike');
  if iH=0 then iH:=FindWindow(nil,'strike');
  if iH=0 then iH:=FindWindow(nil,'HL');
  if iH=0 then iH:=FindWindow(nil,'Condition Zero');
  if iH=0 then iH:=FindWindow('Valve001',nil);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  cbbIme.Items.Assign(Screen.Imes);
  cbbIme.Items.Insert(0,'英文');
  if FileExists(ExtractFilePath(ParamStr(0))+'Cs.cfg') then
  begin
    sF:=TStringList.Create;
    try
      sF.LoadFromFile(ExtractFilePath(ParamStr(0))+'Cs.cfg');
      diredtCS.Text:=sF.Strings[0];
      if FileExists(diredtCS.Text+'\myime.cfg') then
      begin
        sF.LoadFromFile(diredtCS.Text+'\myime.cfg');
        cbbIme.ItemIndex:=cbbIme.Items.IndexOf(sF.Strings[0]);
      end;
    finally
      FreeAndNil(sF);
    end;
  end
  else tmr1.Enabled:=False;
  sF:=TStringList.Create;
end;

procedure TForm1.btnHelpClick(Sender: TObject);
begin
  frmHelp:=TfrmHelp.Create(self);
  try
    frmHelp.ShowModal;
  finally
    frmHelp.Free;
  end;
end;

procedure TForm1.diredtCSAfterDialog(Sender: TObject; var Name: String;
  var Action: Boolean);
var
  iPos:Integer;
  procedure ModiCfg;
  begin
    if DirectoryExists(Name+'\cstrike') then
    begin
      sF.LoadFromFile(Name+'\cstrike\config.cfg');
      iPos:=sF.IndexOf('bind "F11"');
      if iPos=-1 then
          sF.Append('bind "F11" "exec say.cfg"')
      else sF.Strings[iPos]:='bind "F11" "exec say.cfg"';
      sF.SaveToFile(Name+'\cstrike\config.cfg');
    end;
    if DirectoryExists(Name+'\czero') then
    begin
      sF.LoadFromFile(Name+'\czero\config.cfg');
      iPos:=sF.IndexOf('bind "F11"');
      if iPos=-1 then
          sF.Append('bind "F11" "exec say.cfg"')
      else sF.Strings[iPos]:='bind "F11" "exec say.cfg"';
      sF.SaveToFile(Name+'\czero\config.cfg');
    end;
  end;
begin
  //修改CS配置
  if Name=EmptyStr then Exit;
  if not FileExists(ExtractFilePath(ParamStr(0))+'Cs.cfg') then
  begin
      sF.Text:=Name;
      sF.SaveToFile(ExtractFilePath(ParamStr(0))+'Cs.cfg');
      GetCSHWND;
      if iH<>0 then
      begin
        if MessageBox(0, '游戏正在运行。必须退出游戏重新启动才能输入中文。确定退出游戏么？', '提示',
          MB_OKCANCEL + MB_ICONINFORMATION + MB_TOPMOST) = IDOK then
        begin
          SendMessage(iH,WM_CLOSE,0,0);
          repeat
            Application.ProcessMessages;
            GetCSHWND;
          until iH=0;
          ModiCfg;
        end;
      end
      else ModiCfg;
    tmr1.Enabled:=true;
  end;
end;

procedure TForm1.cbbImeChange(Sender: TObject);
begin
  if diredtCS.Text=EmptyStr then
  begin
     MessageBox(0, '请先选择反恐精英游戏目录', '提示', MB_OK +
       MB_ICONINFORMATION + MB_TOPMOST);
     diredtCS.SetFocus;
  end
  else begin
    sF.Text:=cbbIme.Text;
    sF.SaveToFile(diredtCS.Text+'\myime.cfg');
  end;
end;

end.