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

📄 unit1.~pas

📁 delphi的文件朗读器
💻 ~PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  liuDialogs, OleServer, SpeechLib_TLB, ComCtrls, StdCtrls, Buttons,
  liureg,liuwatchClipbrd,liutts, Dialogs;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    CheckBox2: TCheckBox;
    BitBtn1: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    SpVoice1: TSpVoice;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    SpFileStream1: TSpFileStream;
    SaveDialog1: TSaveDialog;
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure  WMChangeCBChain(var Msg: TWMChangeCBChain);message  WM_CHANGECBCHAIN;
procedure  ClipboardChanged(var  message:  TMessage);message  WM_DRAWCLIPBOARD;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  pbl:Tliuwatchclipbrd;
implementation

{$R *.dfm}
procedure  TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);
            begin
            //调整剪贴板查看链
              pbl.WMChangeCBChain(msg);
            end;

procedure  TForm1.ClipboardChanged(var  message:  TMessage);
           var
           st:string;
            begin
              case  pbl.ClipboardChanged(message) of
              1: //文本  在使用时最好等待一会sleep(500)以免出现打开剪贴板
              begin
              if form1.CheckBox1.Checked then
              begin
              sleep(1000);
              spvoice1.Disconnect;//没有播完中止
              st:=pbl.Gettext;
              if comparestr(copy(st,1,10),copy(memo1.Text,1,10))<>0 then
              begin
              memo1.Text:=st;
              st:=liutts.DoAutospeak(st);

              form1.spvoice1.speak(st,1);
              
              end;
              end;
              end;
              end;
            end;
procedure TForm1.TrackBar2Change(Sender: TObject);

begin
  spvoice1.Rate:=100-trackbar2.Position;

end;

procedure TForm1.TrackBar1Change(Sender: TObject);

begin
  spvoice1.Volume:=100-trackbar1.Position;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
var
yy:Fyuyin;
i,en,ch:integer;
begin
yy:=GetYuyin;
en:=-1;
ch:=-1;
for i:=low(yy) to high(yy) do
begin
    if comparetext('Microsoft Sam',yy[i].aname)=0 then
    begin
       en:=i;
    end;

    if comparetext('Microsoft Simplified Chinese',yy[i].aname)=0 then
    begin
       ch:=i;
    end;
end;
if radiobutton1.Checked and (ch>=0) then
begin
liureg.SetYuyin(yy[ch].akey);
end
else if en>=0 then
begin
 liureg.SetYuyin(yy[en].akey);
 trackbar2.Position:=100;
end
else
begin
    liu('没有找到相应的语音引擎');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
yy:Fyuyin;
i:integer;
begin
yy:=GetYuyin;
if length(yy)=0 then
begin
   liu('没有安装语音引擎');
   abort;
end;
for i:=low(yy) to high(yy) do
begin


    if comparetext('Microsoft Simplified Chinese',yy[i].aname)=0 then
    begin
        liureg.SetYuyin(yy[i].akey);
        break;
    end;
end;
pbl:=Tliuwatchclipbrd.create(form1);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
st:string;
begin
st:=liutts.DoAutospeak(memo1.Text);
if not checkbox2.Checked then
begin

//memo1.Text:=st;
spvoice1.Speak(st,1);
end
else
begin
savedialog1.FileName:='未命名.wav';
savedialog1.filter:='wave文件|*.wav';
   if   savedialog1.execute   then
     begin
       spfilestream1.format.type_:=SAFT32KHz8BitMono;
       spfilestream1.open(savedialog1.filename,SSFMCreateForWrite,False);
       SpVoice1.allowAudioOutputFormatChangesOnNextSet:=false;
       Spvoice1.AudioOutputStream:=SpFilestream1.defaultInterface;

//memo1.Text:=st;
spvoice1.Speak(st,1);

      SpVoice1.waitUntilDone(-1);
       Spfilestream1.close;
        Spvoice1.AudioOutputStream:=nil;
        spvoice1.Speak(st,1);
     end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if assigned(pbl) then
begin
   pbl.free;
end;
end;

end.

⌨️ 快捷键说明

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