unitmain.pas

一个背单词程序。是我闲着没事做的。 给大家看看

  if not speechEx.InitVTxtAuto then
  begin
     MessageBox(Handle,'语音引擎创建失败!','提示', MB_OK + MB_ICONWARNING + MB_DEFBUTTON1);
     speechEx.Free;
     SpeechEx:=nil;
  end;
  //读ini文件
  path := ExtractFilePath(Application.ExeName);
  path := path + 'data';
  ini := tinifile.Create(Path + '\config.ini');
  curDict := ini.ReadString('DictDB','DBName','gre');
  RSIndex := ini.ReadInteger('DictDB','DBIndex',1);
  PlayMode := ini.ReadInteger('DictDB','PlayMode',0);
  PlaySpeed:= ini.ReadInteger('DictDB','PlaySpeed',3000);
  ReplayCount:= ini.ReadInteger('DictDB','ReplayCount',0);
 // RSrangStar:= ini.ReadInteger('DictDB','RSrangStar',0);
 // RSrangEnd:= ini.ReadInteger('DictDB','RSrangEnd',0);
  SpeakSpeed:= ini.ReadInteger('DictDB','PlaySpeakSpeed',150);
  //用ini设置( 直接设置 )
  AlphaBlendValue := ini.ReadInteger('DictDB','Alpha',175);  //半透明
  if Assigned(SpeechEx) then SpeechEx.SpeakSpeed(SpeakSpeed);
  Timer1.Interval := PlaySpeed;  //设置诵读间隔
  N7.Checked := StrToBool( ini.ReadString('DictDB','SlowComm','0') ); //词意缓出
  if PlayMode=1 then N8.Checked:=True;
  dictDB := TDictDB.Create(path);
  dictDB.loadDictDBToSTR(CurDict, WordRS , YbRS , CommRS );
  if WordRs.Count=0 then
  begin
    MessageBox(Handle,'请选择有效字典!','提示',
      MB_OK + MB_ICONINFORMATION + MB_DEFBUTTON1);
    exit;
  end;
  Timer1.Enabled:=True;
  ini.Free;
  ini := nil;
  //ShowWindow(GetWindow(Handle,GW_OWNER),SW_HIDE);
  n21.Click;//主窗口置顶。
    //加入系统栏:
  addico(FrmMain.Icon.Handle);


  EnFileName:=path+'\english.dat';//英文文件名
  cnFileName:=path+'\chinese.dat'; //中文解释文件名
  if not (FileExists(EnFileName) and FileExists(cnFileName)) then//屏幕取词:判断指定的文件是否存在
  begin
    //Messagebox(handle,'无法找到屏幕取词字典!屏幕取词被禁止！','提示',MB_OK++ MB_IconInformation);
    n22.Visible:=False;
   // exit;
  end
  else  begin  //屏幕取词:如果指定的文件存在，也将文件变量和文件名相关联
    AssignFile(EnglishFile,EnFileName);
    Reset(EnglishFile); //打开文件
    AssignFile(cnFile,cnFileName);  //打开文件
    Reset(cnFile);
    //屏幕取词: 初始化屏幕取词模块
   if NHD_InitGetWords(application.handle,handle)=0 then begin
    messagebox(application.handle,'初始化屏幕取词动态链接库失败!','信息',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
    n22.Enabled:=False;
    //application.Terminate;
    //exit;
    end;
  end;
  LoadBookMark();
end;

//用于转换字典
procedure TFrmMain.ReLoadDict(dict:String);
begin
  dictDB.loadDictDBToSTR(dict, WordRS , YbRS , CommRS );
end;


procedure TFrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;


begin
if button= mbLeft then
begin
  lastx := x;  lasty := y;//记录当前坐标
  //ReleaseCapture;
  //perform(WM_SysCommand, SC_DragMove, 0);

end;
end;



//字典选择
procedure TFrmMain.N1Click(Sender: TObject);
begin
  if not Assigned(FrmSelDict) then
  begin
    FrmSelDict:=TFrmSelDict.Create(Application);
    //Application.NormalizeAllTopMosts;
    FrmSelDict.Show;
    //Application.RestoreTopMosts;
  end else FrmSelDict.BringToFront;


end;

//词库转换
procedure TFrmMain.N4Click(Sender: TObject);
begin
  if not Assigned(frmchange) then
     frmchange:=Tfrmchange.Create(Application);
  frmchange.Show;
end;

procedure TFrmMain.N3Click(Sender: TObject);
begin    //查找及设 置
 if not Assigned(frmSET) then
 begin
   frmSET:=TfrmSET.Create(Application);
   frmSET.Show;
   frmset.PageControl1.ActivePage:=FrmSet.PageControl1.Pages[1];
 end;
end;

//暂停
procedure TFrmMain.N5Click(Sender: TObject);
begin
   Timer1.Enabled:= not Timer1.Enabled;
   n5.checked:= not Timer1.Enabled;
end;

procedure TFrmMain.N19Click(Sender: TObject);
begin
 if not Assigned(SpeechEx) then
 begin
   Messagebox(handle,'语音引擎不存在，无法设置！','提示',MB_OK++ MB_IconInformation);
   exit;
 end;

  N19.Checked := not N19.Checked;
  if N19.Checked then
    SpeechEx.IVTxtAutoEx.AudioPause
  else
    SpeechEx.IVTxtAutoEx.AudioResume;
end;


procedure TFrmMain.N7Click(Sender: TObject);
begin
  N7.Checked:= not N7.Checked;
end;

procedure TFrmMain.Timer2Timer(Sender: TObject);
begin
  l_comm.Caption := commrs.Strings[rsindex];
  allResize();
  Timer2.Enabled:= False;
end;

procedure TFrmMain.N8Click(Sender: TObject);
begin
  N8.Checked:= not N8.Checked;
  if n8.Checked then
    PlayMode:=1
  else PlayMode:=0;
end;

procedure TFrmMain.N10Click(Sender: TObject);
var
oldvalue:Byte;
begin
  if not Assigned(FrmPosSet) then
     FrmPosSet:=TFrmPosSet.Create(Application);
  oldvalue:=AlphaBlendValue;
  FrmPosSet.Label1.Caption:='透明度:';
  FrmPosSet.Label2.Caption:=IntToStr(oldvalue);    ;
  with FrmPosSet.TrackBar1 do
  begin
     Max:=255;
     Min:=100;
     Position:=oldvalue;
  end;
  FrmPosSet.Show;
end;

procedure TFrmMain.N12Click(Sender: TObject);
var
oldvalue,dispvalue:Integer;
begin
  if not Assigned(FrmPosSet) then
     FrmPosSet:=TFrmPosSet.Create(Application);
  oldvalue:=Timer1.Interval;
  FrmPosSet.Label1.Caption:='播放间隔:';
  dispvalue:=oldvalue div 1000;
  FrmPosSet.Label2.Caption:=IntToStr(dispvalue)+'秒';    ;
  with FrmPosSet.TrackBar1 do
  begin
     Max:=10000;
     Min:=1500;
     Position:=oldvalue;
  end;
  FrmPosSet.Show;
end;

procedure TFrmMain.N11Click(Sender: TObject);
var
oldvalue:Integer;
begin
  if not Assigned(SpeechEx) then
  begin
    Messagebox(handle,'语音引擎不存在，无法设置！','提示',MB_OK++ MB_IconInformation);
     exit;
  end;
  if not Assigned(FrmPosSet) then
     FrmPosSet:=TFrmPosSet.Create(Application);
  oldvalue:=SpeechEx.GetSpeakSpeed;
  FrmPosSet.Label1.Caption:='发音速度:';
  FrmPosSet.Label2.Caption:=IntToStr(oldvalue);    ;
  with FrmPosSet.TrackBar1 do
  begin
     Max:=200;
     Min:=30;
     Position:=oldvalue;
  end;
  FrmPosSet.Show;
end;

procedure TFrmMain.N14Click(Sender: TObject);
var
oldvalue:Integer;
begin
  if not Assigned(FrmPosSet) then
     FrmPosSet:=TFrmPosSet.Create(Application);
  oldvalue:=RSIndex;
  FrmPosSet.Label1.Caption:='播放进度:';
  FrmPosSet.Label2.Caption:=IntToStr(oldvalue);    ;
  with FrmPosSet.TrackBar1 do
  begin
     Max:=RSCount;
     Min:=1;
     Position:=oldvalue;
  end;
  FrmPosSet.Show;
end;

procedure TFrmMain.N15Click(Sender: TObject);
begin  //显示在其它活动窗口标题栏上
  N15.Checked := Not N15.Checked;
  if n15.Checked then begin
      if n17.Checked then n17.Click;
       FrmMain.Hide;;
  end else begin
      DispOnTitle('');
      FrmMain.Show;
      BringToFront;
  end;
end;


procedure TFrmMain.N16Click(Sender: TObject);
begin
   if not Assigned(AboutBox) then
     AboutBox:=TAboutBox.Create(Application);
   AboutBox.ShowModal;
end;

procedure TFrmMain.N17Click(Sender: TObject);
var x,y:integer;
begin
   N17.Checked := not N17.Checked;
   if n17.Checked then
   begin
        if n15.Checked then n15.Click;
        FrmMain.Hide;
  end else
      x:=screen.Width div 5;
      y:=Screen.Height div 2 -200;
      ClearDesk(x,y,x+2000,y+300);

      Visible := True;
      BringToFront;
end;


{===============================================
           下面是将程序显示在任务栏!
Shell_NotifyIcon(NIM_MODIFY, @TrayInfoID)
第一个参数可为下面的三个之一：
  NIM_ADD         ：增加图标；
  NIM_MODIFY      ：改变图标；
  NIM_DELETE      ：删除图标；
        }
procedure TFrmMain.addico(icc:hicon);
begin
icoo.cbsize:=sizeof(icoo);
icoo.hIcon:=icc;
icoo.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
icoo.Wnd:=handle;
icoo.szTip:='Limen dictionary';
icoo.uID:=1;
icoo.uCallbackMessage:=WM_callback;
shell_notifyicon(NIM_ADD,@icoo);

end;

procedure TFrmMain.delico;
begin
shell_notifyicon(NIM_DELETE,@icoo);
end;

procedure TFrmMain.procback(var ms:tmessage);
var p:tpoint;
begin
  getcursorpos(p);
  case ms.LParam of
    WM_LBUTTONDBLCLK:SetForeGroundWindow(handle);
    WM_RBUTTONDOWN:popupmenu1.Popup(p.x,p.y);
  end;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  delico;
  NHD_ExitGetWords();//屏幕取词:注销
end;
procedure TFrmMain.PopupMenu1Popup(Sender: TObject);
begin
//任务栏:这二句用于：在任务栏时，鼠标在其它位置按左键弹出菜单即会关闭
PostMessage(handle, WM_USER, 0, 0);
SetForeGroundWindow(handle);

end;

procedure TFrmMain.FormShow(Sender: TObject);
begin
//任务栏:不显示在系统栏
  setwindowpos(application.handle,hwnd_top,0,0,0,0,swp_hidewindow);
end;

procedure TFrmMain.N18Click(Sender: TObject);
begin
//背单词
 //if not Assigned(frmBdc) then
 //    frmBdc:=TfrmBdc.Create(Application);
  // frmBdc.ShowModal;
  person_main.show;
end;


//打开/关闭光驱
procedure TFrmMain.Image1DblClick(Sender: TObject);
var
    MCIO : TMCI_Open_Parms;
    MCIS : TMCI_Status_Parms;
begin
    MCIO.lpstrDeviceType := PChar(MCI_DEVTYPE_CD_AUDIO);  //设置操作设备为光驱
    if mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE or MCI_OPEN_TYPE_ID or
       MCI_OPEN_SHAREABLE, LongInt(@MCIO) )= 0 then
    begin
      MCIS.dwItem := MCI_STATUS_READY;
      mciSendCommand(MCIO.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM
                     or MCI_WAIT, LongInt(@MCIS));
       if MCIS.dwReturn<> 0 then    //光盘已经准备好
         mciSendCommand(MCIO.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0)//打开
       else
         mciSendCommand(MCIO.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0); //关闭

       mciSendCommand(MCIO.wDeviceID, MCI_CLOSE, MCI_WAIT, 0);  //等待
     end;

end;
//禁止IE弹出窗口(没有作用)
procedure TFrmMain.Timer_popwinTimer(Sender: TObject);
var
mainHD,WorkAHD,ViewHD:THandle;
y_workA,y_view:integer;
rect1,rect2:TRect;

begin
// Kill AD.
{正常浏览窗口的类名是IEFRAME和CabinetWClass,而广告窗口的类名是CabinetWClass}
  mainHD:=FindWIndowEx(0,0,'CabinetWClass',nil);
  if Mainhd<>0 then
  begin
    WorkAHD:=FindWindowEx(Mainhd,0,'WorkerA',nil);
    GetwindowRect(WorkAHD,rect1);
    y_workA:=rect1.top;
    ViewHD:=FindWindowEx(mainHD,0,'Shell DocObject View',nil);
    {资源管理器的类名也是"CabinetWClass",
    但它不具有"Shell DocObject View".
    如果不判断这一点,那么运行程序后,你连资源管理器也打不开了. }
   if viewHD<>0 then ////注1:
    begin
      GetwindowRect(ViewHD,rect2);
      y_view:=rect2.top;
      {1.广告窗口的WorkerA类和Shell DocObject View类的rect.top的值是相同的;
      2.正常IE窗口的WorkerA类和Shell DocObject View类的rect.top的值是不相同的; }

      if y_View-y_WorkA<5 then PostMessage(ViewHD,WM_CLOSE,0,0);
    end;
  end;
end;

procedure TFrmMain.IE1Click(Sender: TObject);
begin
  if not ie1.Checked then
    Timer_popwin.Enabled:=True
  else Timer_popwin.Enabled:=false;
  ie1.Checked:=Timer_popwin.Enabled;

end;

procedure TFrmMain.N21Click(Sender: TObject);
begin
    n21.Checked:=not n21.Checked;
    If n21.Checked then