unit1.pas

一个采用类似大富翁游戏模式的背单词软件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,shellapi, ExtCtrls, ActnList, Menus,mmsystem, ImgList,
  ComCtrls,unit6;

const
  um_ontimer=wm_user+259;
  um_quitthread=wm_user+261;
   pic_start= 5;
   jit_delay= 60;
   jit_words_i_c= 2; //默认连续显示的数量为3
type
  TGameSave= record
    dangqianbs:integer;
    caifu:integer;
    koucu: integer;
    leiji: integer; //累计游戏时间
     dangqianbs_dn:integer;
    caifu_dn:integer;
    koucu_dn: integer;
    zhuangtai: integer;
    index: integer;
    tip1: integer;
    tip2: integer;
    tip3: integer;
    tip4: integer;
    tip5: integer;
    tip6: integer;
    tip7: integer;
    zqbs: integer;
    cwbs: integer;
  end;
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Button1: TButton;
    Button3: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button2: TButton;
    GroupBox3: TGroupBox;
    Label9: TLabel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    Timer1: TTimer;
    ActionList1: TActionList;
    Action1: TAction;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    CheckBox1: TCheckBox;
    Label15: TLabel;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label16: TLabel;
    Label17: TLabel;
    ImageList1: TImageList;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    Button11: TButton;
    ComboBox1: TComboBox;
    Button4: TButton;
    Label18: TLabel;
    GroupBox4: TGroupBox;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    Label19: TLabel;
    Edit1: TEdit;
    Action5: TAction;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    TrackBar1: TTrackBar;
    CheckBox7: TCheckBox;
    ListBox3: TListBox;
    Action6: TAction;
    ImageList2: TImageList;
    Action7: TAction;
    PopupMenu2: TPopupMenu;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    CheckBox8: TCheckBox;
    Action8: TAction;
    N9: TMenuItem;
    N10: TMenuItem;
    Button12: TButton;
    CheckBox9: TCheckBox;
    RichEdit1: TRichEdit;
    Button13: TButton;
    Action9: TAction;
    Action10: TAction;
    Action11: TAction;
    Action12: TAction;
    procedure FormCreate(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure GroupBox3Click(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure Label15Click(Sender: TObject);
    procedure Label15MouseEnter(Sender: TObject);
    procedure Label15MouseLeave(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Label16MouseEnter(Sender: TObject);
    procedure Label16MouseLeave(Sender: TObject);
    procedure Label16Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Label17Click(Sender: TObject);
    procedure ListBox2MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox2DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure CheckBox3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure GroupBox4Click(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListBox3MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox3DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Action6Execute(Sender: TObject);
    procedure ListBox3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Action7Execute(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Action8Execute(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox9Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Action9Execute(Sender: TObject);
    procedure Action10Execute(Sender: TObject);
    procedure Action11Execute(Sender: TObject);
    procedure Action12Execute(Sender: TObject);
  private
    { Private declarations }
    jit_dangqianbs : integer;
    jit_caifu: integer;
    jit_koucu: integer; //已经扣除，用作升级的金钱
     jit_dangqianbs_dn : integer;
     jit_caifu_dn: integer;
     jit_koucu_dn: integer; //已经扣除，用作升级的金钱
     jit_leiji: integer;
     jit_time: integer;
     jit_total: integer; //累计次数
     jit_num: integer; //上次数值
     wordlist1: Tstringlist;
     jit_tmp_3: integer;
     Jit_kssj: tdatetime; //开始时间
     Mcanvas:TCanvas;
     jit_cup_int: integer; //奖杯在谁
     jit_del: boolean; //是否有删除过单词
     jit_word_p: integer; //指向单词表当前单词的指针
     jit_game_start: boolean; //游戏是否开始
     Jit_words: shortstring; //当前显示的单词
     Jit_words_i: integer; //当前连续显示的个数。
    procedure show_game_state;
    procedure check_asw(i: integer);
    procedure prs_game_list2(const s: string); //处理游戏脚本
    procedure prs_game_list2_dn(const s: string); //处理游戏脚本
    procedure computer_step; //电脑走一步
    procedure show_inst_game;
    procedure up_game_honor;
    procedure show_ck;
    procedure My_FindFiles(sPath: string);
    procedure show_check(i: integer);  //显示关闭时的选择项状态
    procedure save_check;
    procedure jit_jewelry(i: integer); //几次相同事件后给予珠宝赠送
    procedure jit_draw_jewelry(i: integer);
    function get_jb: integer; //返回奖杯的获得者序号，0代表本人，1代表电脑
    procedure show_cup; //显示奖杯
    function get_filename_ck(isNew: boolean): string; //返回词库文件名
    procedure jit_chayifense; //差异部分分色显示
  public
    { Public declarations }
    procedure load_game_progress(filename: string);
    procedure save_game_progress(filename: string);
    function get_word_to_form6(index: integer): string; //向3d窗体传送单词
    procedure skp_string(s: string);
    procedure add_money(m: integer);
    procedure cut_money(m: integer);
  end;
 type
  Tjit_spk = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    spk: string;
    constructor create(COM_232:string);
  end;

  function eciSpeakText(text: pchar; annot: boolean): integer; stdcall; external 'ibmeci.dll';
  function eciNew: thandle; stdcall; external 'ibmeci.dll';
   function eciDelete(h: thandle): integer; stdcall; external 'ibmeci.dll';
  function eciSynthesize(h: thandle): integer; stdcall; external 'ibmeci.dll';
  function eciAddText(h: thandle ; s: pchar): integer; stdcall; external 'ibmeci.dll';
  function eciSynchronize(h: thandle): integer; stdcall; external 'ibmeci.dll';
  function eciCopyVoice(h: thandle; i: word; j: word): integer; stdcall; external 'ibmeci.dll';
  function eciSetVoiceParam(h: thandle; i: word; j: word; k: word): integer; stdcall; external 'ibmeci.dll';
var
  Form1: TForm1;
  GameSave1:TGameSave;
  jit_spk1: Tjit_spk;
  jit_h: thandle;
implementation

{$R *.dfm}

function GetFileSize(const FileName: string): LongInt;
var
  SearchRec: TSearchRec;
begin
  try
    if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
      Result := SearchRec.Size
    else Result := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;

function Get_WindowsDirectory: string;
var
    pcWindowsDirectory        : PChar;
    dwWDSize                  : DWORD;

begin
    dwWDSize := MAX_PATH + 1;
    result := '';
    GetMem(pcWindowsDirectory, dwWDSize);
    try
        if Windows.GetWindowsDirectory(pcWindowsDirectory, dwWDSize) <> 0 then
            Result := pcWindowsDirectory;
    finally
        FreeMem(pcWindowsDirectory);
    end;
end;
function Get_SystemDirectory: string;
var
    pcSystemDirectory         : PChar;
    dwSDSize                  : DWORD;
begin
    dwSDSize := MAX_PATH + 1;
    result := '';
    GetMem(pcSystemDirectory, dwSDSize);
    try
        if Windows.GetSystemDirectory(pcSystemDirectory, dwSDSize) <> 0 then
            Result := pcSystemDirectory;
    finally
        FreeMem(pcSystemDirectory);
    end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 listbox3.Items.Add('玩家：当前用户');
 listbox3.Items.Add('头衔');
 listbox3.Items.Add('财富');
 listbox3.Items.Add('当前步数');
  listbox3.Items.Add('消息');
  Jit_kssj:= now;
// listbox2.Items.LoadFromFile(ExtractFilePath(application.ExeName)+'moneybags.dat');
  listbox2.Items.LoadFromFile(ExtractFilePath(application.ExeName)+'note.dat');
 load_game_progress(extractfilepath(application.ExeName)+'save\default.sav');
 wordlist1:= Tstringlist.Create;
 //wordlist1.LoadFromFile(ExtractFilePath(application.ExeName)+'words.ini'); //载入单词本
 Randomize; //初始化随机数
  show_inst_game;

 show_ck; //载入词库
 combobox1.ItemIndex:= gamesave1.index;
 ComboBox1Change(combobox1); //载入单词本

 {限制edit只能输入数字}
 SetWindowLong(Edit1.Handle, GWL_STYLE,
                  GetWindowLong(Edit1.Handle, GWL_STYLE) or
                  ES_NUMBER);
 Mcanvas:=TCanvas.Create;//为panel1加canvas
  Mcanvas.Handle:=GetDC(groupbox4.Handle);
 show_check(gamesave1.zhuangtai);

  if not DirectoryExists(Get_WindowsDirectory + '\speech') then
   begin
     if not DirectoryExists(Get_SystemDirectory + '\speech') then
      begin
       if messagebox(handle,'您的电脑没有安装微软的语音合成组件，不能朗读单词，是否立即从微软网站下载该组件？','不能朗读',mb_yesno or MB_ICONWARNING)= mryes then
        ShellExecute(Handle, 'open', 'http://activex.microsoft.com/activex/controls/sapi/spchapi.exe', nil, nil, SW_SHOWNORMAL);
      end;
   end;
  if checkbox9.Checked then   //差异分色时，初始化一个随机单词
    jit_word_p:= Random(wordlist1.Count);
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  // ShellExecute(Handle, 'open', 'http://www.finer2.com/soft.htm', nil, nil, SW_SHOWNORMAL);
  if messagebox(handle,'词库文件由ini文件组成，您是否要编辑此文件？','提示',MB_yesno or MB_ICONWARNING)= mryes then
   ShellExecute(Handle, 'open', pchar(get_filename_ck(false)), nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
 if messagebox(handle,'游戏脚本是一个文本文件，您是否要编辑此文件？','提示',MB_yesno or MB_ICONWARNING)= mryes then
  ShellExecute(Handle, 'open', pchar(extractfilepath(application.ExeName)+'moneybags.dat'), nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', 'http://www.finer2.com/soft.htm', nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
 if FileExists(extractfilepath(application.ExeName)+'VoaWords.exe') then
  ShellExecute(Handle, 'open', pchar(extractfilepath(application.ExeName)+'VoaWords.exe'), nil, nil, SW_SHOWNORMAL)
   else begin
          if messagebox(handle,'您尚未安装voa单词通，是否下载安装？','提示',MB_yesno or MB_ICONWARNING)= mryes then
            ShellExecute(Handle, 'open', 'http://www.finer2.com/voa/VOAwordsSetup.exe', nil, nil, SW_SHOWNORMAL);
        end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
 messagebox(handle,'电话：[phone] 邮件：[e-mail]','联系方式',MB_OK or MB_ICONINFORMATION);
end;

procedure TForm1.load_game_progress(filename: string);
var File1: File Of TGameSave;
begin
 if GetFileSize(filename) = sizeof(GameSave1) then
  begin
  AssignFile(File1,filename);
  Reset(File1);
 try
   if not Eof(File1) then
   Read(File1,GameSave1);
 finally
   CloseFile(File1);
   end;