unit1.pas

一个小学生出题器

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, ComCtrls,DateUtils,
  XLSReadWriteII2, ApplyFormat, CellFormats2, BIFFRecsII2,XLSFonts2;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Bevel1: TBevel;
    Label4: TLabel;
    Edit1: TEdit;
    Bevel2: TBevel;
    Memo1: TMemo;
    ComboBox1: TComboBox;
    Label9: TLabel;
    Image2: TImage;
    Label3: TLabel;
    ComboBox2: TComboBox;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit1Key1Up(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    QCount:integer;     //问题数量
    MaxNum:integer;     //最大数值
    OperandNum:integer;//多少元操作数运算
    QList:TstringList;//问题列表
    AList:TstringList;//答案列表
    XLS: TXLSReadWriteII2;
    procedure init;
    procedure Builder;

    procedure ExportToXls;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses expr;

{$R *.dfm}
Function BookLeftSpace(s:string;len:integer):string;
begin
    while length(s)<Len do s:=' '+s;
    result:=s;
end;
Function BookRightSpace(s:string;len:integer):string;
begin
    while length(s)<Len do s:=s+' ';
    result:=s;
end;
Function StringToint(s:string;def:integer=0):integer;
begin
    result:=def;
    s:=trim(s);
    if s='' then exit;
    try
      result:=strtoint(s);
    Except
      result:=def;
    end;
end;
Function showstr(str:string;F:boolean=False;Titlestr:string='注意'):boolean;
begin
      result:=False;
      if not F then
      begin
          application.MessageBox(pchar(str),pchar(titlestr),MB_OK);
          exit;
      end;
      result:=application.MessageBox(pchar(str),pchar(titlestr),MB_OKCancel)=IDOK;
end;
procedure TForm1.init;
begin
    QCount:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    Randomize;
    QCount:=0;//问题数量
    OperandNum:=0;//操作数个数
    QList:=TstringList.Create;//问题列表
    AList:=TstringList.Create;//答案列表
    MaxNum:=0;
    XLS:=TXLSReadWriteII2.Create(self);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
    XLS.free;
end;
Function RunExpression(s:string):integer;
var
  yacc: TYacc;
  Lex: TLex;
  B: SmallInt;
begin
  result:=-1;
  if Trim(s) = '' then Exit;
  yacc := TYacc.Create;
  Lex := TLex.Create;
  yacc.ylex := Lex;

  Lex.llib.yyinput := s + ';';
  //yacc.GetFuncValue := GetFuncValue;
    if yacc.yyparse = 0 then
      result:=stringtoint(Lex.llib.yyoutput,-1);
end;
procedure TForm1.Builder;
const p:array[0..1] of string=('-','+');
var //Expressions:TstringList;
    i,j,k,oper:integer;
    ExpressionIsOK:boolean;
    s,Str:string;
begin
    //Expressions:=TstringList.create;
    QList.clear;
    AList.Clear;
    for i:=0 to QCount-1 do
    begin
        ExpressionIsOK:=false;
        while not ExpressionIsOK do
        begin
            j:=1;
            //Expressions.Clear;
            Str:='';
            while j<OperandNum*2 do
            begin
                if odd(j) then
                begin
                    s:=inttostr(random(MaxNum));
                    //Expressions.Add(s);
                    str:=str+s;
                    if (j>1) and (RunExpression(str)<0) then
                        break;
                end
                else
                begin
                    Oper:=random(100);
                    Oper:=ord(odd(Oper));
                    //Expressions.Add(p[Oper]);
                    str:=str+p[Oper];
                end;
                inc(j);
            end;
            if (j>=OperandNum*2) and (QList.IndexOf(Str+' =' )=-1) then
               ExpressionIsOK:=true;
        end;
        QList.Add(Str+' = ');
        AList.Add(inttostr(RunExpression(Str)));
    end;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
    QCount:=stringtoint(trim(edit1.text),0);
    if QCount<=0 then
    begin
        showstr('请输入正确的出期数量！');
        exit;
    end;
    OperandNum:=Combobox2.ItemIndex;
    if OperandNum<0 then
    begin
        showstr('请选择适合的操作数个数！（多少个数的加减）');
        exit;
    end;
    OperandNum:=OperandNum+2;
    MaxNum:=Combobox1.ItemIndex;
    if MaxNum<0 then
    begin
        showstr('请选择正确的最大运算数值范围');
        exit;
    end;
    case MaxNum of
       0  : MaxNum:=10;
       1  : MaxNum:=20;
       2  : MaxNum:=30;
       3  : MaxNum:=50;
       4  : MaxNum:=100;

    end;
    Builder;
    ExportToXls;
end;

procedure TForm1.ExportToXls;
var FName:string;
    i:integer;
begin

    SaveDialog1.FileName:='小学数据题目与答案'+formatdatetime('yyyymmdd-hhnn',now)+'.xls';
    if not SaveDialog1.Execute then exit;
    FName:=SaveDialog1.FileName;
    if fileExists(FName) then
    begin
        if not showstr('你需要保存的文件已经存在，请确定是否需要覆盖这个文件？'+FName,true) then
            exit;
    end;
    
    XLS.Filename := FName;
    XLS.Sheets.Clear;
    XLS.Sheets.Add;
    XLS.Sheets.Add;
    with XLS.Sheets[0] do
    begin
        Name:='题目';
        DisplayName:='题目';
        DefaultColWidth:=15;

        for i:=0 to QCount-1 do
        begin
            AsString[0,3+i] :='['+BookLeftSpace(inttostr(i+1),3)+']';
            AsString[1,3+i] :=BookLeftSpace(QList[i],12);
            Cell[0,3+i].FontSize:=14;
            Cell[1,3+i].FontSize:=14;
            Cell[1,3+i].HorizAlignment:=chaRight;
        end;
        AutoWidthCol(0);
        AutoWidthCol(1);

        AsStringRef['B1'] := '小学数学加减法测验卷';
        Range.ItemsRef['B1:D1'].FontSize := 20;
        Range.ItemsRef['B1:D1'].FontStyle := [xfsBold];

    end;

    with XLS.Sheets[1] do
    begin
        Name:='答案';
        DisplayName:='答案';
        DefaultColWidth:=15;

        for i:=0 to QCount-1 do
        begin
            AsString[0,3+i] :='['+BookLeftSpace(inttostr(i+1),3)+']';
            AsString[1,3+i] :=BookLeftSpace(QList[i],12);
            AsString[2,3+i] :=AList[i];
            Cell[0,3+i].FontSize:=14;
            Cell[1,3+i].FontSize:=14;
            Cell[2,3+i].FontSize:=14;
            Cell[1,3+i].HorizAlignment:=chaRight;
            Cell[2,3+i].HorizAlignment:=chaLeft;
            
        end;
        AutoWidthCol(0);
        AutoWidthCol(1);

        AsStringRef['B1'] := '小学数学加减法测验卷';
        Range.ItemsRef['B1:D1'].FontSize := 20;
        Range.ItemsRef['B1:D1'].FontStyle := [xfsBold];

    end;



    XLS.Write;

    
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
    close

end;


Function AllIsDigit(s:string):boolean;
var pStr:pchar;
begin
    result:=false;
    pStr:=pchar(s);
    while pStr^<>#0 do
    begin
        if (pStr^<'0') or (pStr^>'9') then Exit;
        inc(pStr);
    end;
    result:=True;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
    //if not  AllIsDigit(key) then  key:=#0;
    if not AllIsDigit(trim(Edit1.Text+key)) then Key:=#0;
end;

procedure TForm1.Edit1Key1Up(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    if not AllIsDigit(trim(Edit1.Text)) then Key:=0;
end;




end.