topedit.pas

轻轻松松背单词软件源码

unit TopEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Menus, Registry, FileCtrl, AppEvnts,
  OleServer, SpeechLib_TLB, WinSkinData;

type
  Content = record
    Words: string;
    Proun: string;
    Chinese: string;
  end;

type
  TfrmShow = class(TForm)
    Panel1: TPanel;
    lblWord: TLabel;
    Timer1: TTimer;
    Pop: TPopupMenu;
    N1: TMenuItem;
    nBackColor: TMenuItem;
    nForcolor: TMenuItem;
    nSelectBook: TMenuItem;
    nSay: TMenuItem;
    nDelay: TMenuItem;
    N7: TMenuItem;
    Open: TOpenDialog;
    nClass: TMenuItem;
    dlgColor: TColorDialog;
    nShowMeaning: TMenuItem;
    Timer2: TTimer;
    HidePanel: TPanel;
    N10: TMenuItem;
    nPause: TMenuItem;
    nPutNew: TMenuItem;
    nExport: TMenuItem;
    nSetSpeech: TMenuItem;
    ApplicationEvents: TApplicationEvents;
    Speaker: TSpVoice;
    SkinData: TSkinData;
    procedure nPutNewClick(Sender: TObject);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure nSelectBookClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure nClassClick(Sender: TObject);
    procedure nDelayClick(Sender: TObject);
    procedure nBackColorClick(Sender: TObject);
    procedure nForcolorClick(Sender: TObject);
    procedure nShowMeaningClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure StartAction;
    function IniString(S: string): Content;
    function StrtoPunc(S: string): string;
    procedure nSayClick(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure nExportClick(Sender: TObject);
    procedure nSetSpeechClick(Sender: TObject);
    procedure ApplicationEventsException(Sender: TObject; E: Exception);
    procedure FormCreate(Sender: TObject);
    procedure SpeakerEndStream(ASender: TObject; StreamNumber: Integer;
      StreamPosition: OleVariant);
  private
    HotKeyF4: Integer;
    HotKeyF6: Integer;
    procedure wmHotKey(var Msg: Tmessage); message WM_HOTKEY;
    { Private declarations }
  public
    procedure SelectEngine(Voice: TSpVoice; VoiceName: string);
    function GetChineseStr(Input: WideString): WideString;
    { Public declarations }
  end;

var
  frmShow: TfrmShow;

var //定义变量
  Reg: Tregistry;
  Arrlength: Integer; //每组字符长度
  Arrnumber: Integer; //第几组?
  SpeFile: string; //文件名
  CurrentString: Tstringlist;
  CurrentNumber: Integer; //总的第几行了
  LastNumber: Integer;  //刚过的第几行，用于设置生词本
  ToClose: Integer;
  Nowstr: Content; //目前的单词结构体,Timer1触发后有效
  Language: Integer; //0-none;1=English;2=Spell;3=Chinese
  Interval: Integer; //单词延时秒数
  SpeechType: TStrings; //本机安装的语音种类

implementation

uses Option, SelectBook, Settime, about, Progress, SetSpeech;

{$R *.dfm}

procedure TfrmShow.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssleft in Shift then
  begin
    releaseCapture;
    Perform(WM_SYSCOMMAND, $F012, 0);
  end;
end;

procedure TfrmShow.N1Click(Sender: TObject);
begin
  close;
  //TerminateProcess(GetCurrentProcess, 0);
end;

procedure TfrmShow.nSelectBookClick(Sender: TObject);
begin
  Timer1.Enabled := false;
  Speaker.Tag := 0;
  if frmSelectBook.ShowModal = mrOK then
  begin
    try
      Reg.WriteString('Filename', frmSelectBook.edtSelected.Text);
    except
      Reg.WriteString('Filename', '托福词汇');
    end;
    Reg.WriteInteger('array', 50);
    Reg.WriteInteger('number', 1);
    StartAction;
  end
  else
    Timer1.Enabled := true;
end;

procedure TfrmShow.Timer1Timer(Sender: TObject);
var
  S: string;
begin
  if ToClose = 1 then
    close;
  Timer1.Interval := Interval;
  S := CurrentString.Strings[CurrentNumber];
  Nowstr := IniString(S);
  lblWord.Caption := Nowstr.Words + #13 + '/' + StrtoPunc(Nowstr.Proun) + '/' +
    #13;
  lblWord.Caption := lblWord.Caption + Nowstr.Chinese;
  if nSay.Checked then
  begin
    Speaker.Skip('Sentence', MaxInt);
    case Language of
    1, 2:
      Speaker.Speak(Nowstr.Words, SVSFlagsAsync);
    3:
      if not nShowMeaning.Checked then
        Speaker.Speak(GetChineseStr(Nowstr.Chinese), SVSFlagsAsync);
    end;
  end;
  if nShowMeaning.Checked then //如果延时
  begin
    HidePanel.Left := lblWord.Left;
    HidePanel.Width := lblWord.Width;
    HidePanel.Top := lblWord.Height - 18;
    HidePanel.Height := 19;
    HidePanel.Visible := true;
    Timer2.Interval := Timer1.Interval div 2;
    Timer2.Enabled := true;
  end;
  LastNumber := CurrentNumber;
  if (CurrentNumber = Arrlength * Arrnumber - 1) or (CurrentNumber >=
    CurrentString.Count - 1) then
    CurrentNumber := Arrlength * (Arrnumber - 1)
  else
    CurrentNumber := CurrentNumber + 1;
end;

procedure TfrmShow.Timer2Timer(Sender: TObject);
begin
  HidePanel.Visible := false;
  Timer2.Enabled := false;
  if nSay.Checked and (Language = 3) then
  begin
    Timer1.Enabled := False;
    Speaker.Tag := 1;
    Speaker.Speak(GetChineseStr(Nowstr.Chinese), SVSFlagsAsync);
  end;
end;

procedure TfrmShow.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CurrentString.Free;
  Reg.CloseKey;
  Reg.Free;
  UnRegisterHotKey(Handle, HotKeyF4);
  DeleteAtom(HotKeyF4);
  UnRegisterHotKey(Handle, HotKeyF6);
  DeleteAtom(HotKeyF6);
  Action := caFree;
end;

procedure TfrmShow.StartAction;
begin
  Arrlength := Reg.ReadInteger('array');
  Arrnumber := Reg.ReadInteger('number');
  SpeFile := Reg.ReadString('ExePath') + Reg.ReadString('Filename') + '.wrd';
  CurrentNumber := (Arrnumber - 1) * Arrlength;
  CurrentString.Clear;
  CurrentString.LoadFromFile(SpeFile);
  Timer1.Enabled := true;
end;

function TfrmShow.IniString(S: string): Content;
var
  pos1, pos2, pos3: Integer;
begin
  pos1 := Pos('[W]', S);
  pos2 := Pos('[T]', S);
  pos3 := Pos('[M]', S);
  IniString.Words := Copy(S, pos1 + 3, pos2 - pos1 - 3);
  IniString.Chinese := Copy(S, pos3 + 3, length(S) - pos3 - 2);
  if pos2 <> 0 then
  begin
    IniString.Words := Copy(S, pos1 + 3, pos2 - pos1 - 3);
    IniString.Proun := Copy(S, pos2 + 3, pos3 - pos2 - 3);
  end
  else
  begin
    IniString.Words := Copy(S, pos1 + 3, pos3 - pos1 - 3);
    IniString.Proun := '';
  end;
end;

procedure TfrmShow.nClassClick(Sender: TObject); //组别设置
begin
  FrmOpt.ShowModal;
end;

procedure TfrmShow.nDelayClick(Sender: TObject);
begin
  FrmTime.ShowModal;
end;

procedure TfrmShow.nBackColorClick(Sender: TObject);
begin
  if dlgColor.Execute then
  begin
    lblWord.Color := dlgColor.Color;
    HidePanel.Color := lblWord.Color;
    Reg.WriteInteger('BackColor', lblWord.Color);
  end;
end;

procedure TfrmShow.nForcolorClick(Sender: TObject);
begin
  if dlgColor.Execute then
  begin
    lblWord.Font.Color := dlgColor.Color;
    Reg.WriteInteger('FrontColor', lblWord.Font.Color);
  end;
end;

procedure TfrmShow.nShowMeaningClick(Sender: TObject);
begin
  nShowMeaning.Checked := not (nShowMeaning.Checked);
  Reg.WriteBool('Splash', nShowMeaning.Checked);
end;

function TfrmShow.StrtoPunc(S: string): string;
var
  I: Integer;
begin
  for I := 1 to length(S) do
    if S[I] = '0' then
      S[I] := 'C'
    else if S[I] = '1' then
      S[I] := 'B'
    else if S[I] = '2' then
      S[I] := 'E'
    else if S[I] = '3' then
      S[I] := 'Q'
    else if S[I] = '4' then
      S[I] := 'W'
    else if S[I] = '5' then
      S[I] := 'T'
    else if S[I] = '6' then
      S[I] := 'F'
    else if S[I] = '7' then
      S[I] := 'V'
    else if S[I] = '8' then
      S[I] := 'N'
    else if S[I] = '9' then
      S[I] := 'A';
  StrtoPunc := S;
end;

procedure TfrmShow.nSayClick(Sender: TObject);
begin
  nSay.Checked := not (nSay.Checked);
  Reg.WriteBool('Speech', nSay.Checked);
end;

procedure TfrmShow.N10Click(Sender: TObject);
begin
  Frmabout.ShowModal;
end;

procedure TfrmShow.FormDblClick(Sender: TObject);