Программа для информирования пользователя о смене языка ввода 2 (Написана на Delphi)

Немного изменил интерфейс, добавил то, что просили

Если нужен дополнительный функционал пишите.

Скачать программу под Windows XP SP3 можно отсюда Download
Скачать программу под Windows XP SP3 и Windows 7 64 можно отсюда Download

Как и просили  исходник Windows 7 64
Так как нет возможности создания 64-х разрядной DLL сделал по таймеру))

Листинг Windows 7 64

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, AppEvnts,MMSystem,Registry, Menus,IniFiles,ShellAPI;


type
  TfrmMain = class(TForm)
    pmMain: TPopupMenu;
    mniExit: TMenuItem;
    dlgOpen1: TOpenDialog;
    chkRun: TCheckBox;
    lblSite: TLabel;
    grp1: TGroupBox;
    lblRus: TLabel;
    lblEng: TLabel;
    chkCursor: TCheckBox;
    GroupBox2: TGroupBox;
    chkSay: TCheckBox;
    btnRusSound: TButton;
    btnEngSound: TButton;
    GroupBox3: TGroupBox;
    chkBeep: TCheckBox;
    btnSound: TButton;
    imgRusCur: TImage;
    imgEngCur: TImage;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    imgRusCurSel: TImage;
    imgEngCurSel: TImage;
    chkCursorSel: TCheckBox;
    lblSite2: TLabel;
    TrayIcon1: TTrayIcon;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure mniExitClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnRusSoundClick(Sender: TObject);
    procedure btnEngSoundClick(Sender: TObject);
    procedure btnSoundClick(Sender: TObject);
    procedure chkSayClick(Sender: TObject);
    procedure chkBeepClick(Sender: TObject);
    procedure chkCursorClick(Sender: TObject);
    procedure lblSiteClick(Sender: TObject);
    procedure lblSiteMouseEnter(Sender: TObject);
    procedure lblSiteMouseLeave(Sender: TObject);
    procedure chkCursorSelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure chkRunClick(Sender: TObject);
    procedure imgRusCurDblClick(Sender: TObject);
    procedure imgEngCurDblClick(Sender: TObject);
    procedure imgRusCurSelDblClick(Sender: TObject);
    procedure imgEngCurSelDblClick(Sender: TObject);
    procedure lblSite2Click(Sender: TObject);
    procedure lblSite2MouseEnter(Sender: TObject);
    procedure lblSite2MouseLeave(Sender: TObject);
    procedure TrayIcon1DblClick(Sender: TObject);
    procedure pmMainChange(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private declarations }
    hLib:THandle;
    iLang:integer;
    pathForData:TStringList;
    procedure OpenDialog(aValue,aSubValue,aFilter:string;OpenDial:Boolean=True);
    procedure LoadOprionsFull;
    procedure PlaySound(aValue:string);
  protected
    procedure WndProc(var Msg: TMessage); override;
    Procedure ControlWindow(Var Msg:TMessage); message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;


implementation

{$R *.dfm}
function SetWinCursor(aCurName,aCurNameType: string): boolean;
var Reg: TRegistry;
begin
  Result:=true;
  if not(FileExists(aCurName)) then
  begin
    Result:=false;
    Exit;
  end;
  Reg:=TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  if Reg.OpenKey('\Control Panel\Cursors', false)=false then
  begin
    Result:=false;
    exit;
  end;
  reg.WriteExpandString(aCurNameType, aCurName);
  Reg.free;
  SystemParametersInfo(SPI_SETCURSORS, 0, nil, 0);
end;

procedure TfrmMain.btnEngSoundClick(Sender: TObject);
begin
  openDialog('Sound','Eng','Sound Wav|*.wav');
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
   frmMain.Close;
end;

procedure TfrmMain.btnRusSoundClick(Sender: TObject);
begin
  openDialog('Sound','Rus','Sound Wav|*.wav');
end;

procedure TfrmMain.btnSoundClick(Sender: TObject);
begin
  openDialog('Sound','Beep','Sound Wav|*.wav');
end;

procedure TfrmMain.chkSayClick(Sender: TObject);
begin
  OpenDialog('Sound','SayEnable', BoolToStr(chkSay.Checked),false);
end;

procedure TfrmMain.ControlWindow(var Msg: TMessage);
begin
  inherited;

  if Msg.WParam=SC_MINIMIZE then
  Begin
    TrayIcon1.Visible:=true;
    TrayIcon1.ShowBalloonHint;
    ShowWindow(Handle,SW_HIDE);
  End;

end;

procedure TfrmMain.chkBeepClick(Sender: TObject);
begin
  OpenDialog('Sound','BeepEnable', BoolToStr(chkBeep.Checked),false);
end;

procedure TfrmMain.chkCursorClick(Sender: TObject);
begin
  OpenDialog('Cursor','Enable', BoolToStr(chkCursor.Checked),false);
end;

procedure TfrmMain.chkCursorSelClick(Sender: TObject);
begin
  OpenDialog('CursorSel','Enable', BoolToStr(chkCursorSel.Checked),false);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  pathForData:=TStringList.Create;
  iLang:= GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil));
  LoadOprionsFull;
end;

procedure TfrmMain.lblSiteClick(Sender: TObject);
begin
  ShellExecute(frmMain.Handle, nil, 'http://nmdsoft.blogspot.com/', nil, nil, SW_RESTORE);
end;

procedure TfrmMain.lblSiteMouseEnter(Sender: TObject);
begin
  lblSite.Font.Color:=clBlue;
end;

procedure TfrmMain.lblSiteMouseLeave(Sender: TObject);
begin
  lblSite.Font.Color:=clBlack;
end;

procedure TfrmMain.LoadOprionsFull;
var
  ini:TIniFile;
begin
  pathForData.Clear;
  ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'Options.ini');
  try
    chkCursor.Checked:= StrToBool(ini.ReadString('Cursor','Enable','0'));
    //edtRusCur.Text:=ini.ReadString('Cursor','Rus',ExtractFilePath(ParamStr(0))+'Rus.cur');
    //edtEngCur.Text:=ini.ReadString('Cursor','Eng',ExtractFilePath(ParamStr(0))+'Eng.cur');
    pathForData.Add(ini.ReadString('Cursor','Rus',ExtractFilePath(ParamStr(0)))+'Rus.cur');
    pathForData.Add(ini.ReadString('Cursor','Eng',ExtractFilePath(ParamStr(0))+'Eng.cur'));
    imgRusCur.Picture.Icon.Handle :=LoadCursorFromFile(PWideChar(pathForData.Strings[0]));
    imgEngCur.Picture.Icon.Handle :=LoadCursorFromFile(PWideChar(pathForData.Strings[1]));

    chkCursorSel.Checked:= StrToBool(ini.ReadString('CursorSel','Enable','0'));
    //edtRusCurSel.Text:=ini.ReadString('CursorSel','Rus',ExtractFilePath(ParamStr(0))+'RusSel.cur');
    //edtEngCurSel.Text:=ini.ReadString('CursorSel','Eng',ExtractFilePath(ParamStr(0))+'EngSel.cur');
    pathForData.Add(ini.ReadString('CursorSel','Rus',ExtractFilePath(ParamStr(0))+'RusSel.cur'));
    pathForData.Add(ini.ReadString('CursorSel','Eng',ExtractFilePath(ParamStr(0))+'EngSel.cur'));
    imgRusCurSel.Picture.Icon.Handle :=LoadCursorFromFile(PWideChar(pathForData.Strings[2]));
    imgEngCurSel.Picture.Icon.Handle :=LoadCursorFromFile(PWideChar(pathForData.Strings[3]));


    chkSay.Checked:= StrToBool(ini.ReadString('Sound','SayEnable','-1'));
    //edtRusSound.Text:=ini.ReadString('Sound','Rus',ExtractFilePath(ParamStr(0))+'Rus.wav');
    //edtEngSound.Text:=ini.ReadString('Sound','Eng',ExtractFilePath(ParamStr(0))+'Eng.wav');
    pathForData.Add(ini.ReadString('Sound','Rus',ExtractFilePath(ParamStr(0))+'Rus.wav'));
    pathForData.Add(ini.ReadString('Sound','Eng',ExtractFilePath(ParamStr(0))+'Eng.wav'));

    chkBeep.Checked:= StrToBool(ini.ReadString('Sound','BeepEnable','0'));
    //edtBeep.Text:=ini.ReadString('Sound','Beep',ExtractFilePath(ParamStr(0))+'Beep.wav');
    pathForData.Add(ini.ReadString('Sound','Beep',ExtractFilePath(ParamStr(0))+'Beep.wav'));
  finally
    ini.Free;
  end;
end;

procedure TfrmMain.mniExitClick(Sender: TObject);
begin
  frmMain.Close;
end;

procedure TfrmMain.OpenDialog(aValue,aSubValue,aFilter:string;OpenDial:Boolean);
var
  ini:TIniFile;
begin
  ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'Options.ini');
  if OpenDial then
  begin
    dlgOpen1.Filter:=aFilter;
    if dlgOpen1.Execute then
    begin
      try
        ini.WriteString(aValue,aSubValue,dlgOpen1.FileName);
      finally
        ini.Free;
      end;
    end;
  end
  else
   begin
    try
      ini.WriteString(aValue,aSubValue,aFilter);
    finally
      ini.Free;
    end;
  end;
  LoadOprionsFull;
end;

procedure TfrmMain.PlaySound(aValue: string);
begin
  if FileExists(aValue) then
    sndPlaySound(PwideChar(aValue), SND_ASYNC)
  else
    ShowMessage('Файл '+aValue+ 'не найден!!! Озвучка невозможна!!');
end;

procedure TfrmMain.pmMainChange(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
begin
  frmMain.Close;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
var
  KBL_RUS:Integer;
  KBL_ENG:Integer;
begin
    KBL_RUS:=68748313;
    KBL_ENG:=67699721;
  if iLang<>GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) then
  begin
    iLang:=GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil));
    if GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = KBL_RUS  then
      begin
        if chkCursor.Checked then
          SetWinCursor(pathForData.Strings[0],'Arrow'); //SetWinCursor(edtRusCur.Text,'Arrow');

        if chkCursorSel.Checked then
          SetWinCursor(pathForData.Strings[2],'IBeam'); //SetWinCursor(edtRusCurSel.Text,'IBeam');

        if chkSay.Checked then
          PlaySound(pathForData.Strings[4]);//PlaySound(edtRusSound.Text);

        if chkBeep.Checked then
          PlaySound(pathForData.Strings[6]);//PlaySound(edtBeep.Text);
      end;
      if GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = KBL_ENG then
      begin
        if chkCursor.Checked then
          SetWinCursor(pathForData.Strings[1],'Arrow');//SetWinCursor(edtEngCur.Text,'Arrow');

        if chkCursorSel.Checked then
          SetWinCursor(pathForData.Strings[3],'IBeam'); //SetWinCursor(edtEngCurSel.Text,'IBeam');

        if chkSay.Checked then
          PlaySound(pathForData.Strings[5]);//PlaySound(edtEngSound.Text);

        if chkBeep.Checked then
          PlaySound(pathForData.Strings[6]);//PlaySound(edtBeep.Text);
      end;
  end;
end;

procedure TfrmMain.TrayIcon1DblClick(Sender: TObject);
begin
  ShowWindow(Handle,SW_RESTORE);
  SetForegroundWindow(Handle);
  TrayIcon1.Visible:=False;
end;

procedure TfrmMain.WndProc(var Msg: TMessage);

begin
  inherited;

end;

procedure TfrmMain.FormShow(Sender: TObject);
var
  reg:TRegistry;
begin
  reg := TRegistry.Create;
  with reg do
  begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', true);
      if ValueExists('NMDsoft') then
        chkRun.Checked:=True;
    finally
      CloseKey;
      Free;
    end;
  end;
end;

procedure TfrmMain.chkRunClick(Sender: TObject);
var
  reg:TRegistry;
begin
  reg := TRegistry.Create;
  with reg do
  begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', true);
      if chkRun.Checked then
        WriteString('NMDsoft', ParamStr(0))
      else
        if ValueExists('NMDsoft') then
           DeleteValue('NMDsoft');
    finally
      CloseKey;
      Free;
    end;
  end;
end;

procedure TfrmMain.imgRusCurDblClick(Sender: TObject);
begin
  openDialog('Cursor','Rus','Cursors|*.cur|Animate cursors|*.ani');
end;

procedure TfrmMain.imgEngCurDblClick(Sender: TObject);
begin
  openDialog('Cursor','Eng','Cursors|*.cur|Animate cursors|*.ani');
end;

procedure TfrmMain.imgRusCurSelDblClick(Sender: TObject);
begin
  openDialog('CursorSel','Rus','Cursors|*.cur|Animate cursors|*.ani');
end;

procedure TfrmMain.lblSite2Click(Sender: TObject);
begin
  ShellExecute(frmMain.Handle, nil, 'http://blogistor.com/', nil, nil, SW_RESTORE);
end;

procedure TfrmMain.lblSite2MouseEnter(Sender: TObject);
begin
  lblSite2.Font.Color:=clBlue;
end;

procedure TfrmMain.lblSite2MouseLeave(Sender: TObject);
begin
  lblSite2.Font.Color:=clBlack;
end;

procedure TfrmMain.imgEngCurSelDblClick(Sender: TObject);
begin
  openDialog('CursorSel','Eng','Cursors|*.cur|Animate cursors|*.ani');
end;



end.