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

📄 progress.pas

📁 轻轻松松背单词软件源码
💻 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 + -