view/trunk/Unit1.pas

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants, System.Math,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Menus, FMX.Layouts, FMX.ListBox, FMX.Printer;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    ListBox2: TListBox;
    Button2: TButton;
    Label3: TLabel;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    Label7: TLabel;
    MenuItem7: TMenuItem;
    procedure Button2Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure MenuItem4Click(Sender: TObject);
    procedure MenuItem6Click(Sender: TObject);
    procedure MenuItem7Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private ���� }
    Count: integer;
    prt: TPrinter;
  public
    { public ���� }
  end;

var
  Form1: TForm1;

const
  max = 30;

implementation

{$R *.fmx}

uses Unit2;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  if ListBox2.Items.Count = 0 then
  begin
    MenuItem2Click(Sender);
    Exit;
  end;
  inc(Count);
  i := Random(ListBox2.Items.Count);
  ListBox1.Items.Insert(0, Format('%d�����F%s���o������', [Count, ListBox2.Items[i]]));
  Label5.Text := ListBox2.Items[i];
  ListBox2.Items.Delete(i);
  Label1.Text := '�q�b�g�i���o�[���������������������B';
  Label3.Text := '�i�i�s�����q�b�g�i���o�[��������������������.�j';
  if Count mod 10 = 0 then
  begin
    if Count >= max div 5 then
      Label1.Text := Count.ToString + '���������B�����������[�`���r���S���������������H';
    ListBox1.Items.Insert(0, '----- -----');
  end;
  ListBox1.ScrollBy(0, ListBox1.Height);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label7.Text := Format(Label7.Text, [max]);
end;

procedure TForm1.MenuItem2Click(Sender: TObject);
var
  i: integer;
begin
  if (ListBox1.Items.Count = 0) or
    (MessageDlg('�������Q�[�����I�����������H', TMsgDlgType.mtConfirmation, mbYesNo, 0,
    TMsgDlgBtn.mbYes) = mrYes) then
  begin
    ListBox1.Items.Clear;
    ListBox2.Items.Clear;
    Count := 0;
    Randomize;
    for i := 1 to max do
      ListBox2.Items.Add(IntToStr(i));
    Label1.Text := '���������������������H';
    Label3.Text :=
      '�i�V�����J�[�h���z������������. �J�[�h���p���T�C�YA6. �q�b�g�i���o�[�������������M�L�����Q����������������������������.�j';
    Label5.Text := '�u�v';
  end
  else
    Label1.Text := '���s�������B';
end;

procedure TForm1.MenuItem4Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.MenuItem6Click(Sender: TObject);
const
  size = 120;
  font = 20;
var
  k: integer;
  temp: TStringList;
  procedure print;
  var
    i, j, k: integer;
  begin
    temp.Clear;
    for i := 1 to max do
      temp.Add(IntToStr(i));
    Randomize;
    prt.Canvas.font.size := font;
    for i := 1 to 5 do
      for j := 1 to 5 do
      begin
        k := Random(temp.Count);
        prt.Canvas.FillText(RectF(i * size, j * size, (i + 1) * size,
          (j + 1) * size), temp[k], false, 1, [], TTextAlign.Center);
        temp.Delete(k);
      end;
    prt.Canvas.font.size := Label1.TextSettings.font.size;
    prt.Canvas.FillText(RectF(font, 7 * size, 8 * size, 7 * size),
      '�����������������������������������B', false, 1, [], TTextAlign.Leading);
  end;

begin
  if Form2.ShowModal = mrOK then
  begin
    {
      if (prt is TPrinter)and(prt.Printing = true) then
      begin
      Showmessage('�����������B���������������B');
      Exit;
      end;
    }
    temp := TStringList.Create;
    try
      prt := Printer;
      prt.ActivePrinter.SelectDPI(300, 300);
      prt.Orientation := TPrinterOrientation.poPortrait;
      prt.Canvas.SetSize(Floor(4.13 * prt.ActivePrinter.ActiveDPI.X),
        Floor(5.83 * prt.ActivePrinter.ActiveDPI.Y));
      k := 1;
      prt.BeginDoc;
      while True do
      begin
        print;
        if StrToInt(Form2.SpinBox1.Text) > k then
          prt.NewPage
        else
          break;
        inc(k);
      end;
      prt.EndDoc;
    finally
      temp.Free;
    end;
  end;
end;

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

end.