📄 progress.pas
字号:
unit Progress;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Gauges, ExtCtrls, StrUtils, mmsystem,
MMACMDlg, MMObj, MMDSPObj, MMWave, MMPCMSup, MMRegs, MMACM, OleServer,
SpeechLib_TLB;
type
TfrmProgress = class(TForm)
Gauge: TGauge;
btnCancel: TBitBtn;
dlgSave: TSaveDialog;
Timer: TTimer;
fWave: TMMWaveFile;
MMACM: TMMACM;
lblWork: TLabel;
Voice1: TSpVoice;
Voice2: TSpVoice;
procedure FormShow(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
private
Cancel: Boolean;
DestFileName: string;
public
procedure LinkWave(WaveFiles, NewWaveFile: string);
procedure WavetoMp3(WaveFile, MP3File: string);
procedure ConvertProgress(Sender: TObject; CurByte, NumBytes: Longint;
var Cancel: Boolean);
end;
var
frmProgress: TfrmProgress;
implementation
uses
TopEdit;
{$R *.dfm}
procedure TfrmProgress.FormShow(Sender: TObject);
begin
if dlgSave.Execute then
begin
DestFileName := dlgSave.FileName;
Gauge.Progress := 0;
Cancel := False;
Timer.Enabled := True;
end
else
PostMessage(Self.Handle, WM_Close, 0, 0);
end;
procedure TfrmProgress.TimerTimer(Sender: TObject);
var
I, J: Integer;
Nowstr: Content;
ExportChinese: Boolean;
FileStream: TSpFileStream;
begin
ExportChinese := True;
Timer.Enabled := False;
try
frmShow.SelectEngine(Voice1, 'Microsoft Mary');
except
try
frmShow.SelectEngine(Voice1, 'Microsoft Sam');
except
Application.MessageBox('语音引擎错误,无法使用导出功能','错误', 0);
Close;
end;
end;
try
frmShow.SelectEngine(Voice2, 'Microsoft Simplified Chinese');
except
Application.MessageBox('中文语音引擎错误,只能导出单词发音部分','警告',0);
ExportChinese := False;
end;
if CurrentString.Count > Arrlength * (Arrnumber + 1) then
J := Arrlength * Arrnumber - 1
else
J := CurrentString.Count - 1;
lblWork.Caption := '正在导出语音信息……';
FileStream := TSpFileStream.create(nil);
FileStream.Open(ExtractFilePath(Application.ExeName)
+ 'temp.wav', SSFMCreateForWrite , False);
Voice1.AudioOutputStream := FileStream.DefaultInterface;
Voice2.AudioOutputStream := FileStream.DefaultInterface;
//Voice1.AudioOutputStream := FileStream;
//Voice2.AudioOutputStream := FileStream;
for I := Arrlength * (Arrnumber - 1) to J do
begin
Nowstr := frmShow.IniString(CurrentString.Strings[I]);
Voice1.Speak(Nowstr.Words, SVSFDefault);
if ExportChinese then
begin
Voice2.Speak(Nowstr.Words, SVSFDefault);
Voice2.Speak(frmShow.GetChineseStr(Nowstr.Chinese), SVSFDefault);
end;
Gauge.Progress := Trunc((I + 1 - Arrlength * (Arrnumber - 1)) / Arrlength *
100);
Application.ProcessMessages;
if Cancel then
begin
Application.MessageBox('操作被用户取消','提示',0);
FileStream.Close;
DeleteFile(ExtractFilePath(Application.ExeName) + 'temp.wav');
Close;
end;
end;
FileStream.Close;
//LinkWave(LeftStr(ScrFileList, Length(ScrFileList) - 1),
// ExtractFilePath(Application.ExeName) + 'temp\total.wav');
lblWork.Caption := '正在生成MP3文件……';
btnCancel.Enabled := False;
Application.ProcessMessages;
WavetoMp3(ExtractFilePath(Application.ExeName) + 'temp.wav', DestFileName);
DeleteFile(ExtractFilePath(Application.ExeName) + 'temp.wav');
Close;
end;
procedure TfrmProgress.LinkWave(WaveFiles, NewWaveFile: string);
//WaveFiles:原文件串(必须是完整路径);NewWaveFile:生成的文件名
var
Files: TStringList;
I, n1, n2, n3, n, WaveLen: Integer;
WaveFile, SoureFile: TFileStream;
a1, a2, a3: byte;
sr: TSearchRec;
//联接WAV声音文件函数。
//调用方法:将所要联接的声音文件的完整路径用,号组成字符串。
begin
Files := TStringList.Create;
Files.CommaText := WaveFiles;
I := Files.Count - 1;
while (I >= 0) do
begin
if (FindFirst(PChar(Files.Strings[I]), faAnyFile, sr) = 0) and (sr.Size >=
60) then
begin
end
else
Files.Delete(I);
Dec(I);
end;
WaveFile := TFileStream.Create(NewWaveFile, fmCreate);
SoureFile := TFileStream.Create(Files.Strings[0], fmOpenRead);
//打开其中一个声音文件
WaveFile.CopyFrom(SoureFile, 59); //读取声音文件头
WaveLen := 0; //记录声音长度
for n := 0 to Files.Count - 1 do
begin
SoureFile.Free;
SoureFile := TFileStream.Create(Files.Strings[n], fmOpenRead);
SoureFile.Position := 42;
SoureFile.read(a1, 1);
SoureFile.read(a2, 1);
SoureFile.read(a3, 1);
WaveLen := WaveLen + (ord(a3) * 65536) + (ord(a2) * 256) + ord(a1);
SoureFile.Position := 59;
WaveFile.CopyFrom(SoureFile, SoureFile.Size - 60);
end;
WaveFile.Position := 4;
n1 := (WaveFile.Size - 8) div 65536;
n2 := (WaveFile.Size - 8 - n1 * 65536) div 256;
n3 := WaveFile.Size - 8 - n1 - n2 * 256;
WaveFile.WriteBuffer(n3, 1);
WaveFile.WriteBuffer(n2, 1);
WaveFile.WriteBuffer(n1, 1);
n1 := WaveLen div 65536;
n2 := (WaveLen - n1 * 65536) div 256;
n3 := WaveLen - n1 - n2 * 256;
WaveFile.Position := 42;
WaveFile.WriteBuffer(n3, 1);
WaveFile.WriteBuffer(n2, 1);
WaveFile.WriteBuffer(n1, 1);
Files.Free;
WaveFile.Free;
SoureFile.Free;
end;
procedure TfrmProgress.btnCancelClick(Sender: TObject);
begin
Cancel := True;
Close;
end;
procedure TfrmProgress.WavetoMp3(WaveFile, MP3File: string);
var
formattag, format: string;
wfxDst: TWaveFormatEx;
dwSuggest: Longint;
begin
fWave.Wave.FileName := WaveFile;
pcmBuildWaveHeader(@wfxDst, 16, 1, 22050);
wfxDst.wFormatTAG := WAVE_FORMAT_MPEG_LAYER3;
dwSuggest := ACM_FORMATSUGGESTF_NCHANNELS or
ACM_FORMATSUGGESTF_NSAMPLESPERSEC or
ACM_FORMATSUGGESTF_WFORMATTAG;
// now let the ACM suggest a format
MMACM.PWaveFormat := @wfxDst;
if MMACM.SuggestFormat(fWave.Wave.PWaveFormat, dwSuggest) then
begin
MMACM.GetFormatDescription(MMACM.PWaveFormat, formattag, format);
fWave.Wave.OnProgress := ConvertProgress;
MMACM.ConvertFile(MP3File);
MessageDlg('Conversion completed successfully!',
mtInformation, [mbOk], 0);
end;
end;
procedure TfrmProgress.ConvertProgress(Sender: TObject; CurByte,
NumBytes: Integer; var Cancel: Boolean);
begin
Gauge.Progress := Round((CurByte * 100.0) / NumBytes + 0.5);
Cancel := frmProgress.Cancel;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -