Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
partizanjkee
0 / 0 / 2
Регистрация: 20.11.2009
Сообщений: 23
1

Калькулятор римских цифр

18.04.2010, 01:47. Просмотров 2957. Ответов 0
Метки нет (Все метки)

Я сделал калькулятор римских цифр, только вот проблема почему то тысяча (М) не вводится. Подскажите пожалуйста в чем проблема

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
var
  Form2: TForm2;
  Rchars:Array[1..7] of char = ('I','V','X','L','C','D','M');
  X,Y:Integer;
  N:Word;
  RDigitsV: Array[1..13] of Integer = (1000,900,500,400,100,90,50,40,10,9,5,4,1);
  RDigits: Array[1..13] of String = ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');
implementation
 
uses Unit3;
 
{$R *.dfm}
 
procedure TForm2.CSpeedButtonClick(Sender: TObject);
begin
  REdit.Text:=REdit.Text+'C';
  Verify;
end;
 
function TForm2.Digit(C: Char): Word;
begin
    Result:=0;
  case C of
 
    'I': Result:=1;
    'V': Result:=5;
    'X': Result:=10;
    'L': Result:=50;
    'C': Result:=100;
    'D': Result:=500;
    'M': Result:=1000;
  end;
 
 
end;
 
procedure TForm2.divsClick(Sender: TObject);
Var
T:String;
begin
   Redit.Clear;
    X:=StrToInt(Aredit.Text);
  N:=4;
end;
 
procedure TForm2.DSpeedButtonClick(Sender: TObject);
begin
  REdit.Text:=REdit.Text+'D';
  Verify;
end;
 
procedure TForm2.exClick(Sender: TObject);
begin
case N of
  1: Aredit.Text:=IntTostr(X+StrToInt(Aredit.Text));
 
  2: Aredit.Text:=IntTostr(X-StrToInt(Aredit.Text));
 
  3: Aredit.Text:=IntTostr(X*StrToInt(Aredit.Text));
 
  4: Aredit.Text:=IntTostr(X Div StrToInt(Aredit.Text));
end;
 
REdit.Text:=ArabycToR(StrToInt(Aredit.Text));
 
end;
 
procedure TForm2.ISpeedButtonClick(Sender: TObject);
begin
  REdit.Text:=REdit.Text+'I';
  Verify;
end;
 
function TForm2.RToArabyc(S: String): Integer;
Var
  I,A,I9,I1:Integer;
  x9x:Boolean;    // для обработки "девяток"
  Ar9x:Array[1..7] Of Boolean;    // счетчик девяток
  Ar19x:Array[1..7] Of Boolean;
  Ar1x:Array[1..7] Of Word;       // единиц и пятерок
  x91, x19:word; // указатель предыдущей девятки
begin
x19:=7;
  for I := 1  to 7 do
  begin
    Ar9x[I]:=False;           // исходные значения массива учета "девяток"
 
    if I mod 2 = 0  then      // если V,L,D, то
    Ar1x[i]:=1                // их может быть только по одному
 
    else
    Ar1x[i]:=3;               // иначе не более трех
 
  end;
  x9x:=False;                 //последняя - не "девятка"
  Result:=0;                  //итог пока равен нулю
 
  for I := 1  to length(s) do //Цикл: от 1 до длины переданной строки
  begin
 
 
      for A := 1 to 7 do      // каждый символ в строке проверяется
      begin
 
 
 
        if S[i] = RChars[A] then
        Begin
          if x91=a then      //если впереди девятка оканчивалась этим числом то это ошибка
          Begin
            Result:=-1;
            Exit;
          End;
          if not x9x then     // если это не девятка то
          Begin
 
              if Digit(S[i])>=Digit(S[i+1]) then // если старший символ больше или равен младшему,
              Begin                              // то
 
 
                  if Ar1x[A]>0 then                // если их количество не превышает допустимого ( счетчик не равен нулю)
                  Begin
                     For I1:=1 to A do
                     Begin
                      // если предыдущие девятки меньше то ошибка
                       if (Ar9x[I1]) or (x19-1<A) then
                       Begin
                         Result:=-1;
                         Exit;
                       End;
 
                     End;
                     Result:=Result+Digit(RChars[A]); //прибавим число к результату
                     Ar1x[A]:= Ar1x[A]-1;
                     Break;
                  End
 
                  Else
                  Begin
                     Result:=-1; //иначе  ошибка
                     Exit;
                  End;
              End
 
              Else  // если старший символ меньше младшего то это девятка
              Begin
                                    // Если чисел перед девяткой было больше двух то выход
              If  ((A mod 2 = 1) and (Ar1x[A]<3))then// то ошибка
               Begin
                     Result:=-1;
                     Exit;
               End;
 
 
                 x9x:=True;  // пролистываем следующий цикл
                 if x19>A then
                 x19:=A;
                 
                 Break;
              End;
 
 
         End
 
         Else           // если это девятка то
         Begin
 
 
           for i9:=2 to A do //если младщие или такиеже девятки были
           Begin             //(проверка в цикле)
         // если была девятка меньше или символ меньше и он не предпоследний
              if (Ar9x[I9]) or ((I9-1 mod 2 = 0) and (Ar1x[I9-1]<1)and (S[I-1]<>RChars[I9-1])) or ((I9-1 mod 2 = 1) and (Ar1x[I9-1]<3)and (S[I-1]<>RChars[I9-1]))then// то ошибка
              Begin
              Result:=-1;
              Exit;
              End;
 
           End;
 
 
           x9x:=False;      // ее уже обработали
           Ar9x[A]:=True;    // и она уже была
           x91:=A; // предыдущая девятка
           Result:=Result+Digit(S[I])-Digit(S[I-1]);  // увеличиваем значение
           Break;
         End;
 
      End;
 
 
    end
 
 
  end;
 
 
 
 
 
 
end;
 
function TForm2.ArabycToR(INT: Integer): String;
Var
  a,o,I,Index:Integer;
begin
  Result:='';
  O:=Int;
  if Int>3000 then
  begin
    ShowMessage('Слишком большое значение');
    Exit;
  end;
  for I := 1 to 13 do
  begin
    a:= O Div rDigitsV[i];
    o:= O Mod rDigitsV[i];
    for Index := 1 to A do
    Result:=Result+rDigits[I];
 
  end;
 
 
end;
 
procedure TForm2.BcspcClick(Sender: TObject);
Var
T:String;
begin
    T:=Redit.Text;
    Delete(T,length(T),1);
    Redit.Text:=T;
end;
 
procedure TForm2.clearClick(Sender: TObject);
begin
  Redit.Clear;
  ArEdit.clear;
end;
 
procedure TForm2.plusClick(Sender: TObject);
Var
T:String;
begin
Redit.Clear;
X:=StrToInt(Aredit.Text);
N:=1;
end;
 
procedure TForm2.SpeedButton7Click(Sender: TObject);
begin
Verify;
 
end;
 
procedure TForm2.sqrClick(Sender: TObject);
 
begin
 
  ArEdit.Text:=IntToStr(Round(Sqrt((StrToInt(ArEdit.Text)))));
  REDIT.Text:=ArabycToR((StrToInt(ArEdit.Text)));
end;
 
procedure TForm2.Verify;
Var
  Ar1x:Array[1..7] Of Word;
  Ar9x:Array[1..7] Of Boolean;
  T:string;
begin
 
  while RToArabyc(Redit.Text)<0 do
  begin
    T:=Redit.Text;
    Delete(T,length(T),1);
    Redit.Text:=T;
  end;
  ArEdit.Text:=IntToStr(RToArabyc(REdit.Text));
end;
 
procedure TForm2.VSpeedButtonClick(Sender: TObject);
begin
  REdit.Text:=REdit.Text+'V';
  Verify;
end;
 
procedure TForm2.LSpeedButtonClick(Sender: TObject);
begin
  REdit.Text:=REdit.Text+'L';
  Verify;
end;
procedure TForm2.MSpeedButtonClick(Sender: TObject);
begin
  REdit.Text:=REdit.Text+'M';
  Verify;
end;
 
procedure TForm2.minClick(Sender: TObject);
Var
T:String;
begin
    Redit.Clear;
    X:=StrToInt(Aredit.Text);
  N:=2;
end;
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.04.2010, 01:47
Ответы с готовыми решениями:

Калькулятор римских цифр
Я сделал обычный калькулятор. Как мне перейти от арабских цифр к римским цифрам? unit Unit1; ...

Разработать прогу для перевода римских цифр
Записать исходные данные и результаты в текстовый файл. (L-50, C-100, D-500, M-1000)

Разработать прогу для перевода римских цифр
Разработать прогу для перевода римских цифр в десятичную,двоичную и восьмеричную системы счисления....

Написать обратный перевод из римских цифр в арабские
Помогите написать обратный перевод, из римских в арабские(10-ую систему) function...

Составить подпрограмму перевода римских цифр в десятичную систему счисления
Составить подпрограмму преобраз-я натур-х чисел,записанных в римской нумерации в десятичную систему...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
18.04.2010, 01:47

Калькулятор для букв и цифр.
Я сделал калькулятор, но в отличии от того, что дан в книге я хочу, что бы он делал операции не...

Написать программу, находящую последовательность цифр произведения чисел, представленных последовательностью цифр
Нужна помощь с решением следующей задачи: Два натуральных числа заданы последовательностями...

Дана строка, состоящая из букв и цифр. Определить количество четных и нечетных цифр
Дана строка, состоящая из букв и цифр. Определить количество четных и нечетных цифр.


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru