Develop and Download Open Source Software

Browse Subversion Repository

Contents of /trunk/Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations) (download) (as text)
Sat Feb 28 14:30:50 2015 UTC (9 years, 1 month ago) by yamat0jp
File MIME type: text/x-pascal
File size: 4578 byte(s)


1 unit Unit1;
2
3 interface
4
5 uses
6 System.SysUtils, System.Types, System.UITypes, System.Classes,
7 System.Variants, System.Math,
8 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
9 FMX.Menus, FMX.Layouts, FMX.ListBox, FMX.Printer;
10
11 type
12 TForm1 = class(TForm)
13 ListBox1: TListBox;
14 Label1: TLabel;
15 Label2: TLabel;
16 MainMenu1: TMainMenu;
17 ListBox2: TListBox;
18 Button2: TButton;
19 Label3: TLabel;
20 MenuItem1: TMenuItem;
21 MenuItem2: TMenuItem;
22 MenuItem3: TMenuItem;
23 MenuItem4: TMenuItem;
24 Label4: TLabel;
25 Label5: TLabel;
26 Label6: TLabel;
27 MenuItem5: TMenuItem;
28 MenuItem6: TMenuItem;
29 Label7: TLabel;
30 MenuItem7: TMenuItem;
31 procedure Button2Click(Sender: TObject);
32 procedure MenuItem2Click(Sender: TObject);
33 procedure MenuItem4Click(Sender: TObject);
34 procedure MenuItem6Click(Sender: TObject);
35 procedure MenuItem7Click(Sender: TObject);
36 procedure FormCreate(Sender: TObject);
37 private
38 { private ���� }
39 Count: integer;
40 prt: TPrinter;
41 public
42 { public ���� }
43 end;
44
45 var
46 Form1: TForm1;
47 const
48 max = 30;
49
50 implementation
51
52 {$R *.fmx}
53
54 uses Unit2;
55
56 procedure TForm1.Button2Click(Sender: TObject);
57 var
58 i: integer;
59 begin
60 if ListBox2.Items.Count = 0 then
61 begin
62 MenuItem2Click(Sender);
63 Exit;
64 end;
65 inc(Count);
66 i := Random(ListBox2.Items.Count);
67 ListBox1.Items.Insert(0, Format('%d�����F%s���o������', [Count, ListBox2.Items[i]]));
68 Label5.Text := ListBox2.Items[i];
69 ListBox2.Items.Delete(i);
70 Label1.Text := '�q�b�g�i���o�[���������������������B';
71 Label3.Text := '�i�i�s�����q�b�g�i���o�[��������������������.�j';
72 if Count mod 10 = 0 then
73 begin
74 if Count >= max div 5 then
75 Label1.Text := IntToStr(ListBox1.Items.Count - i) +
76 '���������B�����������[�`���r���S���������������H';
77 ListBox1.Items.Insert(0, '----- -----');
78 end;
79 ListBox1.ScrollBy(0, ListBox1.Height);
80 end;
81
82 procedure TForm1.FormCreate(Sender: TObject);
83 begin
84 Label7.Text:=Format(Label7.Text,[max]);
85 end;
86
87 procedure TForm1.MenuItem2Click(Sender: TObject);
88 var
89 i: integer;
90 begin
91 if (ListBox1.Items.Count = 0) or
92 (MessageDlg('�������Q�[�����I�����������H', TMsgDlgType.mtConfirmation, mbYesNo, 0,
93 TMsgDlgBtn.mbYes) = mrYes) then
94 begin
95 ListBox1.Items.Clear;
96 ListBox2.Items.Clear;
97 Count := 0;
98 Randomize;
99 for i := 1 to max do
100 ListBox2.Items.Add(IntToStr(i));
101 Label1.Text := '���������������������H';
102 Label3.Text :=
103 '�i�V�����J�[�h���z������������. �J�[�h���p���T�C�YB5������A5. �q�b�g�i���o�[�������������M�L�����Q����������������������������.�j';
104 Label5.Text := '�u�v';
105 end
106 else
107 Label1.Text := '���s�������B';
108 end;
109
110 procedure TForm1.MenuItem4Click(Sender: TObject);
111 begin
112 Close;
113 end;
114
115 procedure TForm1.MenuItem6Click(Sender: TObject);
116 const
117 size = 120;
118 font = 20;
119 var
120 k: integer;
121 temp: TStringList;
122 procedure print;
123 var
124 i, j, k: integer;
125 begin
126 temp.Clear;
127 for i := 1 to max do
128 temp.Add(IntToStr(i));
129 Randomize;
130 prt.Canvas.Font.Size:=font;
131 for i := 1 to 5 do
132 for j := 1 to 5 do
133 begin
134 k := Random(temp.Count);
135 prt.Canvas.FillText(RectF(i * size, j * size, (i + 1) * size,
136 (j + 1) * size), temp[k], false, 1, [], TTextAlign.Center);
137 temp.Delete(k);
138 end;
139 prt.Canvas.font.size := Label1.TextSettings.Font.Size;
140 prt.Canvas.FillText(RectF(font, 7 * size, 8 * size, 7 * size),
141 '�����������������������������������B', false, 1, [], TTextAlign.Leading);
142 end;
143
144 begin
145 if Form2.ShowModal = mrOK then
146 begin
147 {
148 if (prt is TPrinter)and(prt.Printing = true) then
149 begin
150 Showmessage('�����������B���������������B');
151 Exit;
152 end;
153 }
154 temp := TStringList.Create;
155 try
156 prt:=Printer;
157 prt.ActivePrinter.SelectDPI(300, 300);
158 prt.Orientation:=TPrinterOrientation.poPortrait;
159 prt.Canvas.SetSize(Floor(4.13*prt.ActivePrinter.ActiveDPI.X), Floor(5.83*prt.ActivePrinter.ActiveDPI.Y));
160 k := 1;
161 prt.BeginDoc;
162 while True do
163 begin
164 print;
165 if StrToInt(Form2.SpinBox1.Text) > k then
166 prt.NewPage
167 else
168 break;
169 inc(k);
170 end;
171 prt.EndDoc;
172 finally
173 temp.Free;
174 end;
175 end;
176 end;
177
178 procedure TForm1.MenuItem7Click(Sender: TObject);
179 begin
180 Button2Click(Sender);
181 end;
182
183 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26