⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 topedit.pas

📁 轻轻松松背单词软件源码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
begin
  Speaker.Tag := 0;
  nPause.Checked := not nPause.Checked;
  Timer1.Enabled := not nPause.Checked;
end;

procedure TfrmShow.wmHotKey(var Msg: Tmessage);
begin
  if (Msg.LParamHi = VK_F4) then
    frmShow.OnDblClick(self)
  else if (Msg.LParamHi = VK_F6) then
    frmShow.nPutNewClick(nPutNew);
end;

procedure TfrmShow.FormShow(Sender: TObject);
var
  WinArray: array[0..144] of char;
  SysPath: string;
begin
  ToClose := 0;
  Panel1.DoubleBuffered := true;
  frmShow.DoubleBuffered := true;
  frmShow.Width := Panel1.Width;
  Reg := Tregistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('Software\Wyabdc', true);
  try
    Arrlength := Reg.ReadInteger('Array');
  except
    Arrlength := 50;
    Reg.WriteInteger('Array', 50);
  end;
  try
    SpeFile := Reg.ReadString('Filename');
    if SpeFile = '' then
      Reg.WriteString('Filename', '托福词汇');
  except
    SpeFile := '托福词汇.wrd';
    Reg.WriteString('Filename', '托福词汇');
  end;
  try
    Arrnumber := Reg.ReadInteger('Number');
  except
    Arrnumber := 1;
    Reg.WriteInteger('number', 1);
  end;
  try
    Interval := Reg.ReadInteger('Delay');
  except
    Interval := 2000;
    Reg.WriteInteger('Delay', 2000);
  end;
  Timer1.Interval := Interval;
  try
    lblWord.Color := Reg.ReadInteger('BackColor');
    HidePanel.Color := Reg.ReadInteger('BackColor');
  except
    lblWord.Color := clBlack;
    HidePanel.Color := clBlack;
    Reg.WriteInteger('BackColor', clBlack);
  end;
  try
    lblWord.Font.Color := Reg.ReadInteger('FrontColor');
  except
    lblWord.Font.Color := clYellow;
    Reg.WriteInteger('FrontColor', clYellow);
  end;
  try
    nSay.Checked := Reg.ReadBool('Speech');
  except
    nSay.Checked := false;
    Reg.WriteBool('Speech', false);
  end;
  try
    nShowMeaning.Checked := Reg.ReadBool('Splash');
  except
    nShowMeaning.Checked := true;
    Reg.WriteBool('Splash', true);
  end;
  try
    if ExtractFileExt(Application.ExeName) = '.exe' then
      Reg.WriteString('ExePath', ExtractFilePath(Application.ExeName));
  except
  end;
  GetWindowsDirectory(WinArray, 144);
  SysPath := WinArray;
  if not FileExists(SysPath + '\QQSSBDC.scr') then
    copyfile(Pchar(Application.ExeName), Pchar(SysPath + '\QQSSBDC.scr'), false);
  SysPath := WinArray + '\FONTS';
  if not FileExists(SysPath + '\dfhgwprn.ttf') then
  begin
    copyfile('dfhgwprn.ttf', Pchar(SysPath + '\dfhgwprn.ttf'), false);
    showmessage('字体安装完毕,请重新运行本程序');
    TerminateProcess(GetCurrentProcess, 0);
    ToClose := 1;
  end;
  HotKeyF4 := GlobalAddAtom('HotKeyF4') - $C000;
  HotKeyF6 := GlobalAddAtom('HotKeyF6') - $C000;
  RegisterHotKey(Handle, HotKeyF4, 0, VK_F4);
  RegisterHotKey(Handle, HotKeyF6, 0, VK_F6);
  CurrentString := Tstringlist.Create;
  try
    Language := Reg.ReadInteger('Language');
  except
    Language := 1;
    Reg.WriteInteger('Language', 1);
  end;
  if Language = 1 then
  try
    SelectEngine(Speaker, 'Microsoft Mary');
  except
    try
      SelectEngine(Speaker, 'Microsoft Sam');
      nSetSpeech.Enabled := false;
      showmessage('中文TTS发音引擎未安装,程序将无法使用中文发音功能');
    except
      nSay.Enabled := false;
      nSay.Checked := false;
      nSetSpeech.Enabled := false;
      Reg.WriteBool('Speech', false);
      Language := 0;
      Reg.WriteInteger('Language', 0);
      showmessage('TTS发音引擎未安装,程序将无法使用发音功能');
    end;
  end
  else if Language > 1 then
  try
    SelectEngine(Speaker, 'Microsoft Simplified Chinese');
  except
    Language := 1;
    Reg.WriteInteger('Language', 1);
    try
      SelectEngine(Speaker, 'Microsoft Mary');
      showmessage('中文TTS发音引擎未安装,程序将无法使用中文发音功能');
    except
      try
        SelectEngine(Speaker, 'Microsoft Sam');
        nSetSpeech.Enabled := false;
        showmessage('中文TTS发音引擎未安装,程序将无法使用中文发音功能');
      except
        nSay.Enabled := false;
        nSay.Checked := false;
        nSetSpeech.Enabled := false;
        Reg.WriteBool('Speech', false);
        Language := 0;
        Reg.WriteInteger('Language', 0);
        showmessage('TTS发音引擎未安装,程序将无法使用发音功能');
      end;
    end
  end;
  lblWord.Caption := '轻轻松松背单词' + #13 + ' 制作: 钱昕';
  if frmSplash <> nil then
    frmSplash.Close;
  StartAction;
end;

procedure TfrmShow.nPutNewClick(Sender: TObject);
var
  HardWordBook: TextFile;
  HardWordFileName: string;
begin
  HardWordFileName := ExtractFilePath(Application.ExeName) + '生词本.wrd';
  AssignFile(HardWordBook, HardWordFileName);
  if not FileExists(HardWordFileName) then
    Rewrite(HardWordBook)
  else
    Append(HardWordBook);
  Writeln(HardWordBook, CurrentString.Strings[LastNumber]);
  CloseFile(HardWordBook);
end;

procedure TfrmShow.nExportClick(Sender: TObject);
begin
  Timer1.Enabled := false;
  //Speaker.Tag := 0;
  //Speaker.Stop;
  frmProgress.ShowModal;
  Timer1.Enabled := true;
end;

procedure TfrmShow.nSetSpeechClick(Sender: TObject);
var
  OldLanguage: Integer;
begin
  Timer1.Enabled := false;
  //Speaker.Stop;
  OldLanguage := Language;
  if frmSetSpeech.ShowModal = mrOK then
  begin
    if (OldLanguage = frmSetSpeech.rgSet.ItemIndex + 1)
      or ((OldLanguage = 2) and (OldLanguage = frmSetSpeech.rgSet.ItemIndex))
      or ((OldLanguage = 3) and (frmSetSpeech.rgSet.ItemIndex = 1)) then
    begin
      Language := frmSetSpeech.rgSet.ItemIndex + 1;
      Reg.WriteInteger('Language', Language);
      Timer1.Enabled := true;
      exit;
    end;
    Language := frmSetSpeech.rgSet.ItemIndex + 1;
    Reg.WriteInteger('Language', Language);
    if Language = 1 then
    try
      SelectEngine(Speaker, 'Microsoft Mary');
    except
      try
        SelectEngine(Speaker, 'Microsoft Sam');
        nSetSpeech.Enabled := false;
        showmessage('中文TTS发音引擎未安装,程序将无法使用中文发音功能');
      except
        nSay.Enabled := false;
        nSay.Checked := false;
        nSetSpeech.Enabled := false;
        Reg.WriteBool('Speech', false);
        Language := 0;
        Reg.WriteInteger('Language', 0);
        showmessage('TTS发音引擎未安装,程序将无法使用发音功能');
      end;
    end
    else if Language > 1 then
    try
      SelectEngine(Speaker, 'Microsoft Simplified Chinese');
    except
      Language := 1;
      Reg.WriteInteger('Language', 1);
      try
        SelectEngine(Speaker, 'Microsoft Mary');
        showmessage('中文TTS发音引擎未安装,程序将无法使用中文发音功能');
      except
        try
          SelectEngine(Speaker, 'Microsoft Sam');
          nSetSpeech.Enabled := false;
          showmessage('中文TTS发音引擎未安装,程序将无法使用中文发音功能');
        except
          nSay.Enabled := false;
          nSay.Checked := false;
          nSetSpeech.Enabled := false;
          Reg.WriteBool('Speech', false);
          Language := 0;
          Reg.WriteInteger('Language', 0);
          showmessage('TTS发音引擎未安装,程序将无法使用发音功能');
        end;
      end
    end;
  end;
  Timer1.Enabled := true;
end;

procedure TfrmShow.ApplicationEventsException(Sender: TObject;
  E: Exception);
begin
  //
end;

function TfrmShow.GetChineseStr(Input: WideString): WideString;
var
  C: string;
  I: Integer;
begin
  for I := 1 to length(Input) do
  begin
    C := Input[I];
    if length(C) > 1 then
      Result := Result + C;
  end;
end;

procedure TfrmShow.FormCreate(Sender: TObject);
var
  I: Integer;
  SOToken: ISpeechObjectToken;
  SOTokens: ISpeechObjectTokens;
begin
  SpeechType := TStringList.Create;
  Speaker.EventInterests := SVEAllEvents;
  SOTokens := Speaker.GetVoices('', '');
  for I := 0 to SOTokens.Count - 1 do
  begin
    //For each voice, store the descriptor in the TStrings list
    SOToken := SOTokens.Item(I);
    SpeechType.AddObject(SOToken.GetDescription(0), TObject(SOToken));
    //Increment the descriptor reference count to ensure it doesn't get destroyed
    SOToken._AddRef;
  end;
  //showmessage(SpeechType.Text);
end;

procedure TfrmShow.SelectEngine(Voice: TSpVoice; VoiceName: string);
var
  SOToken: ISpeechObjectToken;
begin
  SOToken := ISpeechObjectToken(Pointer(
    SpeechType.Objects[SpeechType.IndexOf(VoiceName)]));
  Voice.Voice := SOToken;
end;

procedure TfrmShow.SpeakerEndStream(ASender: TObject;
  StreamNumber: Integer; StreamPosition: OleVariant);
begin
  if (Speaker.Tag = 1) and (not nPause.Checked) then
  begin
    Speaker.Tag := 0;
    Timer1.Interval := 1;
    Timer1.Enabled := True;
  end;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -