unitmain.~pas

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

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ExtCtrls, StdCtrls, Menus,dictdb,speech, ComCtrls,Inifiles,shellapi,mmSystem,
  AppEvnts, jpeg;

const WM_callback=WM_USER+45;    //任务栏:
{------------star屏幕取词部分---------------}
const GETWORD_ENABLE=1001;
const GETWORD_DISABLE=1002;
const NHD_WM_GETWORD_OK=WM_USER + 1011;
const IDM_ABOUTBOX=9999;
type
  TEnglish=record
    english:array[1..20] of char; //英文
    cx:array[1..2] of char;     //词性
    offset  :DWORD;   //对应中文解释在Chinese.dat中的文件偏移位置
end;
{------------end 屏幕取词部分---------------}

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    l_comm: TLabel;
    l_right: TLabel;
    l_Yb: TLabel;
    l_Left: TLabel;
    l_Word: TLabel;
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Timer1: TTimer;
    Timer2: TTimer;
    N4: TMenuItem;
    N5: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N19: TMenuItem;
    Timer_popwin: TTimer;
    N20: TMenuItem;
    IE1: TMenuItem;
    N21: TMenuItem;
    Timer_GetWord: TTimer;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N9: TMenuItem;
    N6: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    MenuBM: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N29: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N18: TMenuItem;
   { procedure CreateParams(var Params: TCreateParams);override;//窗体置顶 }
    procedure WMMOVE(var Msg: TMessage); message WM_MOVE;//磁性窗体
    procedure N2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure Image1DblClick(Sender: TObject);
    procedure Timer_popwinTimer(Sender: TObject);
    procedure IE1Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer_GetWordTimer(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Getcn(Searchname:String);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N30Click(Sender: TObject);
     procedure newitemclick(Sender: TObject);
    procedure N29Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure l_WordClick(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure N36Click(Sender: TObject);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1DockOver(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure Panel1Enter(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
  private
    { Private declarations }
    WordRs:TStringList;
    YbRS:Tstringlist;
    CommRS:TStringlist;
    procedure allResize();
    procedure procback(var ms:tmessage);message WM_callback;  //任务栏:
    //屏幕取词:
    procedure GetWordFromBuffer(var message: tmessage); message NHD_WM_GETWORD_OK;
  public
    { Public declarations }
    RSCount,RSIndex,replay,replaycount,RSrangStar,RSrangEnd:integer;
    dictdb:tdictdb;
    SpeechEx:Tspeech;
    errmsg,path,CurDict:String;
    PlaySpeed,PlayMode:integer; //播放方式
    procedure ReLoadDict(dict:String);
    procedure addico(icc:hicon);  //任务栏:加入
    procedure delico;             //任务栏:删除
    function LoadBookMark():Boolean ;//重导入书签
    procedure AppException(Sender: TObject;E: Exception);//系统异常处理
  end;
  function DispOnTitle(title:String):Boolean ;
  function DispOnDesk(Str,Font:String;x,y,FontSize:Integer;DeskCanvas:TCanvas):Boolean ;
  procedure ClearDesk(x,y,x1,y1:Integer);



var
  FrmMain: TFrmMain;
  icoo:tnotifyicondata;
  lastx, lasty,hook: integer; //记录前一次的窗口坐标

  PrevWindows,CurWindows:HWND;
  PrevWinTitle:array [0..254] of char;

  EnglishFile:file of TEnglish; //屏幕取词：英文文件的变量
  cnFile:file of char; //中屏幕取词：文解释文件的变量
  En:TEnglish; //屏幕取词：英文文件的记录类型变量
   EnFileName:String;//屏幕取词：英文文件名
  cnFileName:String; //屏幕取词：中文解释文件名
  oldGetWord:String;//屏幕取词：上一次取得的词
  //文件chinese.dat由中文解释组成，每条中文解释之间用#作为间隔符号:中文#中文#

implementation

uses UnitSELDict, UnitChange, UnitSET, UnitPosSet, UnitAbout, UnitB,
  GetWord, UnitWordList, Uniterrmsg, FRM_TXL, unit1;

{$R *.dfm}
{procedure TFrmMain.CreateParams(var Params: TCreateParams);
begin
  //置于所有窗体之上,fromStyle为fsStayOnTop,Icon为None
  inherited CreateParams( Params);
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST or WS_EX_TOOLWINDOW;
  Params.WndParent := 0; // 这是必须的，否则当App变为后台时会将该窗体设置为不TopMost
end;   }
procedure TFrmMain.AppException(Sender: TObject;E: Exception);

begin
  errmsg:=e.Message;
  if not Assigned(frmerrmsg) then
   begin
     frmerrmsg:=Tfrmerrmsg.Create(Application);
     frmerrmsg.Show;
   end;
end;                           

procedure TFrmMain.WMMOVE(var Msg: TMessage);
begin
 { Inherited;
  if (Left < 10) and (Left <> 0) then left:=0; // 设定移动到左边 10
  if (Top < 10) and (Top <> 0) then top:=0;
  Msg.Result := 0;    }

end;


procedure TFrmMain.N2Click(Sender: TObject);
var ini:TIniFile;
begin
//  delico;
  //保存当前设置
  ini := tinifile.Create(Path + '\config.ini');
  ini.WriteString('DictDB','DbName',CurDict);
  ini.WriteInteger('DictDB','DBIndex',RSIndex);
  ini.WriteInteger('DictDB','PlayMode',PlayMode);
  ini.WriteInteger('DictDB','PlaySpeed',Timer1.Interval );
  ini.WriteInteger('DictDB','ReplayCount',ReplayCount );
 // ini.WriteInteger('DictDB','RSrangStar',RSrangStar );
 // ini.WriteInteger('DictDB','RSrangEnd',RSrangEnd );
  ini.WriteInteger('DictDB','Alpha',AlphaBlendValue);
  if Assigned(SpeechEx) then begin
    ini.WriteInteger('DictDB','PlaySpeakSpeed',SpeechEx.GetSpeakSpeed);
     SpeechEx.IVTxtAutoEx._Release;
  end;
  ini.WriteString('DictDB','SlowComm',BoolToStr( N7.Checked ));
  ini.Free;
  ini := nil;
  if n15.Checked then  n15.Click;
  if n17.Checked then  n17.Click;
  Application.Terminate;
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
var s,StrYB,StrWord,StrComm:String;
i,x,y:integer;
R: TRect;
deskcanvas:TCanvas;
begin
  case PlayMode of
    0: begin
         if replay>=replaycount then
         begin
         inc(RSIndex);replay:=0;
         end else  inc(replay);
       end;
    1: RSIndex:=random(RSCount);
  end;
  //启用书签单词范围
  if n32.Checked and (RSIndex>=RSrangEnd) and (RSrangStar<>RSrangEnd) then RSIndex:=RSrangStar;
  if RSIndex>=RSCount then RSIndex:=0;
  if (RSIndex<0) and (RSCount>0) then RSIndex := RSCount-1;
  RSCount := WordRs.Count ;
  StrWord := WordRS.Strings[RSIndex];
  StrYB := YbRS.Strings[RSIndex];
  StrComm := commrs.Strings[rsindex];
  {===================显示部分========================}
  //if (not N15.Checked) and (not n17.Checked) then
  if not N15.Checked then
  begin
      l_word.Caption := StrWord;
      l_yb.Caption := StrYB;
      //选择词意缓出
      if  N7.Checked then
      begin
        l_comm.Caption :='';
        Timer2.Enabled:=True;
        Timer2.Interval:=Timer1.Interval div 2;
        allResize();
      end else
      begin
      l_comm.Caption := StrComm;
      allResize();
      end;
  end;
  //秘密显示(显示在标题栏)
  if N15.Checked then
  begin
   DispOnTitle(Format('%S          %S',
           [StrWord,StrComm]));
  end;
  //疯狂显示
  if n17.Checked then
  begin
     DeskCanvas:=Tcanvas.create;
     deskcanvas.Handle:=GetDC(0);
      x:=screen.Width div 5;
      y:=Screen.Height div 2 -200;
      ClearDesk(x,y,x+2000,y+300);  //清除画布
      Sleep(10)  ;                  //很重要的一句，要不就会显示后就消失
      SetBkMode( deskcanvas.Handle, TRANSPARENT );
      deskcanvas.Font.style := [fsBold];
      deskcanvas.Font.Color :=RGB(255,0,0);
      DispOnDesk(StrWord,'Times New Roman',x,y,58, deskcanvas) ; //单词显示
      x:=x;      y:=y+100;
      DispOnDesk('/'+strYB+'/','DFPhonetic',x,y,25, deskcanvas) ; //音标显示
      x:=x;    y:=y+60;
      DispOnDesk(strcomm,'黑体',x,y,35, deskcanvas) ;  //词意显示
     ReleaseDC(0,deskcanvas.Handle);
   end;
   if Assigned(SpeechEx) then SpeechEx.Speak(StrWord);
end;

//画布清除
procedure ClearDesk(x,y,x1,y1:Integer);
var R: TRect;
begin
  R := Rect(x,y,x1,y1);
  RedrawWindow(0,@R,0, RDW_INVALIDATE or RDW_ALLCHILDREN);
end;


//在画布上绘字
function DispOnDesk(Str,Font:String;x,y,FontSize:Integer;DeskCanvas:TCanvas):Boolean ;
begin
  deskcanvas.Font.Name := Font;
  deskcanvas.Font.size := FontSize;
  deskcanvas.TextOut(x,y,Str);
  beginpath(deskcanvas.Handle);
  deskcanvas.TextOut(x,y,Str);
  endpath(deskcanvas.Handle);
  deskcanvas.Pen.Color :=RGB(0,0,160);
  StrokePath(deskcanvas.Handle);
end;


// 秘密显示过程
function DispOnTitle(title:String):Boolean ;

begin
   AttachThreadInput(GetCurrentThreadID,
     GetWindowThreadProcessID(GetForegroundWindow,nil),True);
     CurWindows :=GetActiveWindow();
     if PrevWindows=0 then  //当还没有窗口句柄被保存时
     begin
       GetWindowText(CurWindows,PrevWinTitle,254);
       PrevWindows:=CurWindows;
     end else begin
       if PrevWindows<>CurWindows then  //窗口焦点移动时
       begin

         SetWindowText(PrevWindows,PrevWinTitle);  //还原上一个窗口标题
          GetWindowText(CurWindows,PrevWinTitle,254); //取得现在窗口标题
         PrevWindows:=CurWindows;                  //保存当前为历史窗口
       end;
     end;
    SetWindowText(CurWindows,Pchar(Title+'-----'+StrPas(PrevWinTitle)));
end;



//大小设置
procedure TFrmMain.allResize();
var tmpwidth:integer;
begin
    if l_yb.Caption<>'' then begin
        if not l_yb.Visible then
        begin
          l_left.Visible := true;
          l_right.Visible := true;
          l_yb.Visible := true;
        end;
        l_left.Left := l_word.Left + l_word.Width + 10;
        l_yb.Left := l_left.Left + 10;
        l_right.Left := l_yb.Left + l_yb.Width + 5;
        l_comm.left := l_right.Left + 15;
     end else
     begin
        if  l_yb.Visible then
        begin
          l_left.Visible := false;
          l_right.Visible := false;
          l_yb.Visible := false;
        end;
        if l_comm.Caption<>'' then l_comm.Left := l_word.Left + l_word.Width + 10
        else begin l_comm.Left:=l_word.left;l_comm.width:=l_word.width;  end;
     end;
    //====================
    tmpwidth := l_comm.Left + l_comm.Width + 15;
   if tmpwidth>261 then
   begin panel1.Width:=tmpwidth;width := panel1.Width; end
   else begin width:=261;panel1.Width:=261; end;
        //height := panel1.Height;
    Panel1.Hint :=  Format('%S 第%d个单词',[CurDict,rsindex]);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
ini:tinifile;
SpeakSpeed:integer;
hr :thandle;

begin
Application.OnException := frmmain.AppException ;
 replay:=0;
{   //设置窗体为圆角矩形
hr:=createroundrectrgn(0,0,width,height,20,20);//定义园角矩形(win API函数)
setwindowrgn(handle,hr,true); //设置园角窗口  }
   //设置屏幕
  Timer1.Enabled:=False;
  Timer2.Enabled:=false;
  FrmMain.Left:=Panel1.Width;
  FrmMain.Height:=Panel1.Height;
  FrmMain.Width:=Panel1.Width;
  FrmMain.Top:=0;
  FrmMain.Left:=(screen.Width - width-55) div 2;
  allResize();
   //导入词库初始化
  wordRS := TStringlist.Create;
  YbRS := TStringList.Create;
  CommRS := TStringList.Create;
  //朗读引擎初始化

    speechEx := tspeech.create;