Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /trunk/Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide 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 yamat0jp 2 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