Написать калькулятор (Turbo Vision)

@Vladislav_Mirom · Регистрация: 29.08.2015

Студворк — интернет-сервис помощи студентам

Написать программу, работающую как простейший калькулятор, выполняющий действия: "+","-","*","/". Turbo Vision.

@volvo · 29.08.2015, 20:59

В папке \Tp70\EXAMPLES\TVDEMO есть модуль calc.pas, который реализует функционал калькулятора. Как его подключить к основной программе и запустить - можно посмотреть в файле tvdemo.pas...

@Vladislav_Mirom · 10.09.2015, 23:14 **[ТС]**

Спасибо, но такая проблема, преподаватель потребовал описать каждую строчку в модуле. Уже неделю не могу отдать ему полный отчёт.

Pascal
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
unit modul2; {Название модуля}
interface {Итерфейсная часть}
uses {Подключает программные модули}
 crt,app,menus,drivers,views,objects,dialogs,
 msgbox,stddlg,dos; {Список подключенных модулей}
type {Раздел типов}
  TCalcState = (csFirst, csValid, csError);
  PCalcDisplay = ^TCalcDisplay;
  TCalcDisplay = object(TView) 
   Status: TCalcState; 
   Number: string[15]; {Переменной присовен тип string}
   Sign: Char; {Переменной присовен тип char}
   Operator: Char; {Переменной присовен тип char}
   Operand: Real; {Переменной присовен тип real}
   constructor Init(var Bounds: TRect);
   constructor Load(var S: TStream);
   procedure CalcKey(Key: Char);
   procedure Clear;
   procedure Draw; virtual;
   function GetPalette: PPalette; virtual;
   procedure HandleEvent(var Event: TEvent); virtual;
   procedure Store(var S: TStream);
end; 
  PCalculator = ^TCalculator;
  TCalculator = object(TDialog)
    constructor Init;
end;
const {Раздел констант}
  RCalcDisplay: TStreamRec = (
   ObjType: 10040;
   VmtLink: Ofs(TypeOf(TCalcDisplay)^);
   Load:    @TCalcDisplay.Load;
   Store:   @TCalcDisplay.Store
 );
 RCalculator: TStreamRec = (
  ObjType: 10041;
  VmtLink: Ofs(TypeOf(TCalculator)^);
  Load:    @TCalculator.Load;
  Store:   @TCalculator.Store
 );
procedure RegisterCalc;
implementation
const
  cmCalcButton = 100;
constructor TCalcDisplay.Init(var Bounds: TRect);
begin
  inherited Init(Bounds);
   Options := Options or ofSelectable;
   EventMask := evKeyDown + evBroadcast;
   Clear;
end;
constructor TCalcDisplay.Load(var S: TStream);
begin
  inherited Load(S);
   S.Read(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
   SizeOf(Operator) + SizeOf(Operand));
end;
procedure TCalcDisplay.CalcKey(Key: Char);
var
 R: Real;
procedure Error;
begin
 Status := csError;
 Number := 'Error';
 Sign := ' ';
end;
procedure SetDisplay(R: Real);
var
 S: string[63];
begin
 Str(R: 0: 10, S);
 if S[1] <> '-' then Sign := ' ' else
  begin
   Delete(S, 1, 1);
   Sign := '-';
  end;
  if Length(S) > 15 + 1 + 10 then Error
  else
   begin
    while S[Length(S)] = '0' do Dec(S[0]);
    if S[Length(S)] = '.' then Dec(S[0]);
    Number := S;
  end;
end;
procedure GetDisplay(var R: Real);
var
  E: Integer;
begin
  Val(Sign + Number, R, E);
end;
procedure CheckFirst;
begin
 if Status = csFirst then
  begin
    Status := csValid;
    Number := '0';
    Sign := ' ';
  end;
end;
begin
  Key := UpCase(Key);
  if (Status = csError) and (Key <> 'C') then Key := ' ';
  case Key of
    '0'..'9':
      begin
        CheckFirst;
        if Number = '0' then Number := '';
        Number := Number + Key;
      end;
    '.':
      begin
        CheckFirst;
        if Pos('.', Number) = 0 then Number := Number + '.';
      end;
    #8, #27:
      begin
        CheckFirst;
        if Length(Number) = 1 then Number := '0' else Dec(Number[0]);
      end;
    '_', #241:
      if Sign = ' ' then Sign := '-' else Sign := ' ';
    '+', '-', '*', '/', '=', '%', #13:
      begin
        if Status = csValid then
        begin
          Status := csFirst;
          GetDisplay(R);
          if Key = '%' then
            case Operator of
              '+', '-': R := Operand * R / 100;
              '*', '/': R := R / 100;
            end;
          case Operator of
            '+': SetDisplay(Operand + R);
            '-': SetDisplay(Operand - R);
            '*': SetDisplay(Operand * R);
            '/': if R = 0 then Error else SetDisplay(Operand / R);
          end;
        end;
        Operator := Key;
        GetDisplay(Operand);
      end;
    'C':
      Clear;
  end;
  DrawView;
end;
procedure TCalcDisplay.Clear;
begin
 Status := csFirst;
 Number := '0';
 Sign := ' ';
 Operator := '=';
end;
procedure TCalcDisplay.Draw;
var
 Color: Byte;
 I: Integer;
 B: TDrawBuffer;
begin
 Color := GetColor(1);
 I := Size.X - Length(Number) - 2;
 MoveChar(B, ' ', Color, Size.X);
 MoveChar(B[I], Sign, Color, 1);
 MoveStr(B[I + 1], Number, Color);
 WriteBuf(0, 0, Size.X, 1, B);
end;
function TCalcDisplay.GetPalette: PPalette;
const
 P: string[1] = #19;
begin
 GetPalette := @P;
end;
procedure TCalcDisplay.HandleEvent(var Event: TEvent);
begin
 inherited HandleEvent(Event);
  case Event.What of
    evKeyDown:
      begin
        CalcKey(Event.CharCode);
        ClearEvent(Event);
      end;
    evBroadcast:
      if Event.Command = cmCalcButton then
      begin
        CalcKey(PButton(Event.InfoPtr)^.Title^[1]);
        ClearEvent(Event);
      end;
  end;
end;
procedure TCalcDisplay.Store(var S: TStream);
begin
  TView.Store(S);
  S.Write(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) +
  SizeOf(Operator) + SizeOf(Operand));
end;
constructor TCalculator.Init;
const
  KeyChar: array[0..19] of Char = 'C'#27'%'#241'789/456*123-0.=+';
var
  I: Integer;
  P: PView;
  R: TRect;
begin
  R.Assign(5, 3, 29, 18);
  inherited Init(R, 'Task 2');
  Options := Options or ofFirstClick;
  for I := 0 to 19 do
  begin
    R.A.X := (I mod 4) * 5 + 2;
    R.A.Y := (I div 4) * 2 + 4;
    R.B.X := R.A.X + 5;
    R.B.Y := R.A.Y + 2;
    P := New(PButton, Init(R, KeyChar[I], cmCalcButton,
      bfNormal + bfBroadcast));
    P^.Options := P^.Options and not ofSelectable;
    Insert(P);
  end;
  R.Assign(3, 2, 21, 3);
  Insert(New(PCalcDisplay, Init(R)));
end;
procedure RegisterCalc;
begin
  RegisterType(RCalcDisplay);
  RegisterType(RCalculator);
end;
end.

@bublegums · 12.09.2015, 22:30

Vladislav_Mirom, Какой ужас, упрощайте код. Это делается гораздо проще.

ФедосеевПавел · 12.09.2015, 23:21

bublegums, ему (ТС) дали это задание внезапно, без подготовки, без обучения, и сейчас уже нет времени на чтение всей документации для понимания кода. А без этого - он бессилен, и даже не осознаёт свой код. Так что, если вы в состоянии - помогите ему в решении поставленной задачи:

Сообщение от Vladislav_Mirom

Написать программу, работающую как простейший калькулятор, выполняющий действия: "+","-","*","/".
Turbo Vision.

@bormant · 17.09.2015, 15:15

Pascal
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
unit TCalc;                                     {Название модуля}
interface                                       {Итерфейсная секция}
uses                                            {Подключение модулей ...}
  drivers, views, objects, dialogs;             {... по списку}
type                                            {Раздел типов}
  TCalcState = (csFirst, csValid, csError);     {Объявление перечислимого типа из 3-х значений}
  PCalcDisplay = ^TCalcDisplay;                 {Объявление типа PCalcDisplay как указателя на TCalcDisplay}
  TCalcDisplay = object(TView)                  {Объявление объектного типа TCalcDisplay как наследника TView}
    Status: TCalcState;  { Состояние }          {поле типа TCalcState}
    Number: string[15];  { Число     }          {поле типа String на 15 символов}
    Sign: Char;          { Знак      }          {поле типа Char}
    Operator: Char;      { Оператор  }          {поле типа Char}
    Operand: Real;       { Операнд   }          {поле типа Real}
    constructor Init(var Bounds: TRect);        {объявление конструктора}
    constructor Load(var S: TStream);{Загрузить}{объявление конструктора}
    procedure CalcKey(Key: Char);               {объявление метода}
    procedure Clear;                 {Очистить }{объявление метода}
    procedure Draw; virtual;                    {объявление виртуального метода}
    function GetPalette: PPalette; virtual;     {объявление виртуального метода}
    procedure HandleEvent(var Event: TEvent); virtual; {объявление виртуального метода}
    procedure Store(var S: TStream); {Сохранить}{объявление метода}
  end;                                          {конец объявления TCalcDisplay}
  PCalculator = ^TCalculator;                   {Объявление типа PCalculator как указателя на TCalculator}
  TCalculator = object(TDialog)                 {Объявление объектного типа TCalculator как наследника TDialog}
    constructor Init;                           {объявление конструктора}
  end;                                          {конец объявления TCalculator}
const                                           {Раздел констант}
  RCalcDisplay: TStreamRec = (                  {Типизированная константа для регистрации типа с TStream}
   ObjType: 10040;                              {поле ObjType равно 10040}
   VmtLink: Ofs(TypeOf(TCalcDisplay)^);         {поле VmtLink равно смещению таблицы вирт. методов TCalcDisplay}
   Load:    @TCalcDisplay.Load;                 {поле Load равно адресу конструктора TCalcDisplay.Load}
   Store:   @TCalcDisplay.Store                 {поле Store равно адресу метода TCalcDisplay.Store}
 );                                             {конец RCalcDisplay}
 RCalculator: TStreamRec = (                    {Типизированная константа для регистрации типа с TStream}
  ObjType: 10041;                               {поле ObjType равно 10041}
  VmtLink: Ofs(TypeOf(TCalculator)^);           {поле VmtLink равно смещению таблицы вирт. методов TCalculator}
  Load:    @TCalculator.Load;                   {поле Load равно адресу конструктора TCalculator.Load}
  Store:   @TCalculator.Store                   {поле Store равно адресу метода TCalculator.Store}
 );                                             {конец RCalculator}
procedure RegisterCalc;                         {Объявление процедуры}

@bormant · 17.09.2015, 15:16

Продолжение (лимит на длину сообщения)...

Pascal
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
implementation                                  {Секция реализации}
const                                           {Раздел констант}
  cmCalcButton = 100;                           {объявление константы cmCalcButton, равной 100}
constructor TCalcDisplay.Init(var Bounds: TRect);       {Определение конструктора Init типа TCalcDisplay}
begin                                                   {начало TCalcDisplay.Init}
  inherited Init(Bounds);                               {вызов унаследованного конструктора}
  Options := Options or ofSelectable;                   {установка в поле Options битов из ofSelectable}
  EventMask := evKeyDown + evBroadcast;                 {присвоить полю EventMask сумму evKeyDown и evBroadcast}
  Clear;                                                {вызов метода Clear}
end;                                                    {конец TCalcDisplay.Init}
constructor TCalcDisplay.Load(var S: TStream);  {Определение конструктора Load типа TCalcDisplay}
begin                                           {начало TCalcDisplay.Load}
  inherited Load(S);                            {вызов унаследованного конструктора}
   S.Read(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) + {вызов метода Read потока S для чтения ...}
   SizeOf(Operator) + SizeOf(Operand));         {... данных объекта согласно сумме размеров полей}
end;                                            {конец TCalcDisplay.Load}
procedure TCalcDisplay.CalcKey(Key: Char);      {Определение метода CalcKey типа TCalcDisplay}
var                                             {раздел локальных переменных}
  R: Real;                                      {переменная R типа Real}
procedure Error;                                {Определение вложенной процедуры}
begin                                           {начало Error}
  Status := csError;                            {полю присвоить значение}
  Number := 'Error';                            {полю присвоить значение}
  Sign := ' ';                                  {полю присвоить значение}
end;                                            {конец Error}
procedure SetDisplay(R: Real);                  {Определение вложенной процедуры}
var                                             {раздел локальных переменных}
  S: string[63];                                {строковая переменная на 63 символа}
begin                                           {начало SetDisplay}
  Str(R: 0: 10, S);                             {перевод R в строковое представление S по формату :0:10}
  if S[1] <> '-' then Sign := ' ' else          {если первый символ '-', то полю Sign присвоить ' ', иначе}
  begin                                         {начало}
    Delete(S, 1, 1);                            {удалить первый символ S}
    Sign := '-';                                {полю Sign присвоить значение '-'}
  end;                                          {конец}
  if Length(S) > 15 + 1 + 10 then Error         {если длина S больше 15+1+10, то вызвать Error}
  else                                          {иначе}
  begin                                         {начало}
    while S[Length(S)] = '0' do Dec(S[0]);      {пока последний символ S равен '0' уменьшать длину S}
    if S[Length(S)] = '.' then Dec(S[0]);       {если последний символ S равен '.', то уменьшить длину S}
    Number := S;                                {полю Number присвоить значение S}
  end;                                          {конец}
end;                                            {конец SetDisplay}
procedure GetDisplay(var R: Real);              {Определение вложенной процедуры}
var                                             {раздел локальных переменных}
  E: Integer;                                   {переменная E типа Integer}
begin                                           {начало GetDisplay}
  Val(Sign + Number, R, E);                     {склеить Sign и Number, преобразовать в число R}
end;                                            {конец GetDisplay}
procedure CheckFirst;                           {Определение вложенной процедуры}
begin                                           {начало CheckFirst}
  if Status = csFirst then                      {если поле Status равно csFirst, то}
  begin                                         {начало}
    Status := csValid;                          {полю присвоить значение}
    Number := '0';                              {полю присвоить значение}
    Sign := ' ';                                {полю присвоить значение}
  end;                                          {конец}
end;                                            {конец CheckFirst}
begin                                           {начало TCalcDisplay.CalcKey}
  Key := UpCase(Key);                           {Key присвоить значение Key в верхнем регистре}
  if (Status = csError) and (Key <> 'C') then Key := ' '; {если Status равно csError и Key не равно 'C', то Key присвоить ' '}
  case Key of                                   {выбрать Key из ...}
    '0'..'9':                                   {... от '0' по '9'}
      begin                                     {начало}
        CheckFirst;                             {вызов CheckFirst}
        if Number = '0' then Number := '';      {если поле Number равно '0', то Number присвоить ''}
        Number := Number + Key;                 {к полю Number приклеить справа Key}
      end;                                      {конец}
    '.':                                        {... '.'}
      begin                                     {начало}
        CheckFirst;                             {вызов CheckFirst}
        if Pos('.', Number) = 0 then Number := Number + '.'; {если поле Number не содержит '.', приклеить к нему справа '.'}
      end;                                      {конец}
    #8, #27:                                    {... коды клавиш "Backspace", "ESC"}
      begin                                     {начало}
        CheckFirst;                             {вызов CheckFirst}
        if Length(Number) = 1 then              {если длина Number 1,}
          Number := '0'                         {присвоить ему '0',}
        else                                    {иначе}
          Dec(Number[0]);                       {уменьшить длину Number на 1}
      end;                                      {конец}
    '_', #241:                                  {... '_', #241}
      if Sign = ' ' then Sign := '-' else Sign := ' '; {если поле Sign равно ' ', то присвоить ему '-', иначе присвоить ' '}
    '+', '-', '*', '/', '=', '%', #13:          {...  '+', '-', '*', '/', '=', '%', "Enter"}
      begin                                     {начало}
        if Status = csValid then                {если поле Status равно csValid, то}
        begin                                   {начало}
          Status := csFirst;                    {полю присвоить значение}
          GetDisplay(R);                        {вызвать GetDisplay, получить в R число}
          if Key = '%' then                     {если Key равно '%', то}
            case Operator of                    {выбрать Operator из ...}
              '+', '-': R := Operand * R / 100; {... '+', '-': R присвоить произведение Operand и R деленное на 100}
              '*', '/': R := R / 100;           {... '*', '/': R присвоить R деленное на 100}
            end;                                {конец case}
          case Operator of                      {выбрать Operator из ...}
            '+': SetDisplay(Operand + R);       {... '+': вызвать SetDisplay с суммой Operand и R}
            '-': SetDisplay(Operand - R);       {... '-': вызвать SetDisplay с разностью Operand и R}
            '*': SetDisplay(Operand * R);       {... '*': вызвать SetDisplay с произведением Operand и R}
            '/': if R = 0 then Error else SetDisplay(Operand / R); {если R равно 0, вызвать Error, иначе SetDisplay}
          end;                                  {конец case}
        end;                                    {конец}
        Operator := Key;                        {полю присвоить значение}
        GetDisplay(Operand);                    {вызвать GetDisplay, получить значение в поле Operand}
      end;                                      {конец}
    'C':                                        {... 'C'}
      Clear;                                    {вызвать метод Clear}
  end;                                          {конец case}
  DrawView;                                     {вызвать унаследованный метод DrawView}
end;                                            {конец TCalcDisplay.CalcKey}
procedure TCalcDisplay.Clear;                   {Определение метода Clear типа TCalcDisplay}
begin                                           {начало TCalcDisplay.Clear}
  Status := csFirst;                            {полю присвоить значение}
  Number := '0';                                {полю присвоить значение}
  Sign := ' ';                                  {полю присвоить значение}
  Operator := '=';                              {полю присвоить значение}
end;                                            {конец TCalcDisplay.Clear}
procedure TCalcDisplay.Draw;                    {Определение метода Draw типа TCalcDisplay}
var                                             {раздел локальных переменных}
  Color: Byte;                                  {переменная Color типа Byte}
  I: Integer;                                   {переменная I типа Integer}
  B: TDrawBuffer;                               {переменная B типа TDrawBuffer}
begin                                           {начало TCalcDisplay.Draw}
  Color := GetColor(1);                         {переменной присвоить результат вызова функции}
  I := Size.X - Length(Number) - 2;             {переменной присвоить результат выражения}
  MoveChar(B, ' ', Color, Size.X);              {заполнить буфер пробелами с цветом Color}
  MoveChar(B[I], Sign, Color, 1);               {вывести с позиции I в буфер Sign цветом Color}
  MoveStr(B[I + 1], Number, Color);             {вывести с позиции I+1 в буфер Number цветом Color}
  WriteBuf(0, 0, Size.X, 1, B);                 {вывести буфер B по координатам}
end;                                            {конец TCalcDisplay.Draw}
function TCalcDisplay.GetPalette: PPalette;     {Определение метода-функции}
const                                           {раздел локальных констант}
  P: string[1] = #19;                           {типизированная строковая константа длиной в 1 символ}
begin                                           {начало TCalcDisplay.GetPalette}
  GetPalette := @P;                             {вернуть указатель на P}
end;                                            {конец TCalcDisplay.GetPalette}
procedure TCalcDisplay.HandleEvent(var Event: TEvent);  {Определение метода}
begin                                           {начало TCalcDisplay.HandleEvent, обработчик событий}
  inherited HandleEvent(Event);                 {вызов унаследованного метода}
  case Event.What of                            {выбор поля What параметра Event из ...}
    evKeyDown:                                  {... evKeyDown}
      begin                                     {начало}
        CalcKey(Event.CharCode);                {вызвать метод CalkKey с параметром - поле CharCode параметра Event}
        ClearEvent(Event);                      {вызвать ClearEvent с параметром Event}
      end;                                      {конец}
    evBroadcast:                                {... evBroadcast}
      if Event.Command = cmCalcButton then      {если поле Command параметра Event равно cmCalcButton, то}
      begin                                     {начало}
        CalcKey(PButton(Event.InfoPtr)^.Title^[1]); {вызвать метод CalcKey с параметром - первый символ названия кнопки}
        ClearEvent(Event);                      {вызвать ClearEvent с параметром Event}
      end;                                      {конец}
  end;                                          {конец case}
end;                                            {конец TCalcDisplay.HandleEvent}
procedure TCalcDisplay.Store(var S: TStream);   {Определение метода}
begin                                           {начало TCalcDisplay.Store}
  TView.Store(S);                               {сохранение данных родителя в поток S}
  S.Write(Status, SizeOf(Status) + SizeOf(Number) + SizeOf(Sign) + {сохранение в поток S данных объекта ...}
  SizeOf(Operator) + SizeOf(Operand));                             {... по сумме размеров полей}
end;                                            {конец TCalcDisplay.Store}

@bormant · 17.09.2015, 15:20

Продолжение (лимит на длину сообщения):

Pascal
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
constructor TCalculator.Init;                   {Определение конструктора}
const                                           {раздел локальных констант}
  KeyChar: array[0..19] of Char = 'C'#27'%'#241'789/456*123-0.=+'; {типизир. константа, массив из 20 символов, кнопки}
var                                             {раздел локальных переменных}
  I: Integer;                                   {переменная типа Integer}
  P: PView;                                     {переменная типа PView}
  R: TRect;                                     {переменная типа TRect}
begin                                           {начало TCalculator.Init}
  R.Assign(5, 3, 29, 18);                       {вызов для R метода Assign с параметрами}
  inherited Init(R, 'Task 2');                  {вызов унаследованного конструктора TDialog.Init}
  Options := Options or ofFirstClick;           {в поле Options установить биты из ofFirstClick}
  for I := 0 to 19 do                           {цикл по I от 0 до 19}
  begin                                         {начало}
    R.A.X := (I mod 4) * 5 + 2;                 {присвоить полю X поля A переменной R результат выражения}
    R.A.Y := (I div 4) * 2 + 4;                 {присвоить полю Y поля A переменной R результат выражения}
    R.B.X := R.A.X + 5;                         {присвоить R.B.X значение R.A.X плюс 5}
    R.B.Y := R.A.Y + 2;                         {присвоить R.B.Y значение R.A.Y плюс 2}
    P := New(PButton, Init(R, KeyChar[I], cmCalcButton, {создание объекта TButton в куче, указатель на него присвоить P}
      bfNormal + bfBroadcast));
    P^.Options := P^.Options and not ofSelectable;      {в поле Options объекта по указателю P снять биты из ofSelectable}
    Insert(P);                                  {вставить указатель P в список объектов}
  end;                                          {конец for}
  R.Assign(3, 2, 21, 3);                        {вызов для R метода TRect.Assign}
  Insert(New(PCalcDisplay, Init(R)));           {создание объекта TCalcDisplay в куче, вставка указателя на него в список}
end;                                            {конец TCalculator.Init}
procedure RegisterCalc;                         {Определение процедуры}
begin                                           {начало RegisterCalc}
  RegisterType(RCalcDisplay);                   {вызов процедуры, регистрация типа для ввода/вывода с TStream}
  RegisterType(RCalculator);                    {вызов процедуры, регистрация типа для ввода/вывода с TStream}
end;                                            {конец RegisterCalc}
end.

Добавлено через 3 минуты
Можно немного сэкономить на поддержке TStream:

Pascal
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
unit TCalc;
interface
uses
  drivers, views, objects, dialogs;
type
  TCalcState = (csFirst, csValid, csError);
  PCalcDisplay = ^TCalcDisplay;
  TCalcDisplay = object(TView)
    Status: TCalcState;
    Number: string[15];
    Sign: Char;
    Operator: Char;
    Operand: Real;
    constructor Init(var Bounds: TRect);
    procedure CalcKey(Key: Char);
    procedure Clear;
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;
  PCalculator = ^TCalculator;
  TCalculator = object(TDialog)
    constructor Init;
  end;
implementation
const
  cmCalcButton = 100;
constructor TCalcDisplay.Init(var Bounds: TRect);
begin
  inherited Init(Bounds);
  Options := Options or ofSelectable;
  EventMask := evKeyDown + evBroadcast;
  Clear;
end;
procedure TCalcDisplay.CalcKey(Key: Char);
var
  R: Real;
procedure Error;
begin
  Status := csError;
  Number := 'Error';
  Sign := ' ';
end;
procedure SetDisplay(R: Real);
var
  S: string[63];
begin
  Str(R: 0: 10, S);
  if S[1] <> '-' then Sign := ' '
  else begin
    Delete(S, 1, 1);
    Sign := '-';
  end;
  if Length(S) > 15 + 1 + 10 then Error
  else begin
    while S[Length(S)] = '0' do Dec(S[0]);
    if S[Length(S)] = '.' then Dec(S[0]);
    Number := S;
  end;
end;
procedure GetDisplay(var R: Real);
var
  E: Integer;
begin
  Val(Sign + Number, R, E);
end;
procedure CheckFirst;
begin
  if Status = csFirst then begin
    Status := csValid;
    Number := '0';
    Sign := ' ';
  end;
end;
begin
  Key := UpCase(Key);
  if (Status = csError) and (Key <> 'C') then Key := ' ';
  case Key of
    '0'..'9':
      begin
        CheckFirst;
        if Number = '0' then Number := '';
        Number := Number + Key;
      end;
    '.':
      begin
        CheckFirst;
        if Pos('.', Number) = 0 then Number := Number + '.';
      end;
    #8, #27:
      begin
        CheckFirst;
        if Length(Number) = 1 then Number := '0' else Dec(Number[0]);
      end;
    '_', #241:
      if Sign = ' ' then Sign := '-' else Sign := ' ';
    '+', '-', '*', '/', '=', '%', #13:
      begin
        if Status = csValid then begin
          Status := csFirst;
          GetDisplay(R);
          if Key = '%' then
            case Operator of
              '+', '-': R := Operand * R / 100;
              '*', '/': R := R / 100;
            end;
          case Operator of
            '+': SetDisplay(Operand + R);
            '-': SetDisplay(Operand - R);
            '*': SetDisplay(Operand * R);
            '/': if R = 0 then Error else SetDisplay(Operand / R);
          end;
        end;
        Operator := Key;
        GetDisplay(Operand);
      end;
    'C':
      Clear;
  end;
  DrawView;
end;
procedure TCalcDisplay.Clear;
begin
  Status := csFirst;
  Number := '0';
  Sign := ' ';
  Operator := '=';
end;
procedure TCalcDisplay.Draw;
var
  Color: Byte;
  I: Integer;
  B: TDrawBuffer;
begin
  Color := GetColor(1);
  I := Size.X - Length(Number) - 2;
  MoveChar(B, ' ', Color, Size.X);
  MoveChar(B[I], Sign, Color, 1);
  MoveStr(B[I + 1], Number, Color);
  WriteBuf(0, 0, Size.X, 1, B);
end;
function TCalcDisplay.GetPalette: PPalette;
const
  P: string[1] = #19;
begin
  GetPalette := @P;
end;
procedure TCalcDisplay.HandleEvent(var Event: TEvent);
begin
  inherited HandleEvent(Event);
  case Event.What of
    evKeyDown:
      begin
        CalcKey(Event.CharCode);
        ClearEvent(Event);
      end;
    evBroadcast:
      if Event.Command = cmCalcButton then begin
        CalcKey(PButton(Event.InfoPtr)^.Title^[1]);
        ClearEvent(Event);
      end;
  end;
end;
constructor TCalculator.Init;
const
  KeyChar: array[0..19] of Char = 'C'#27'%'#241'789/456*123-0.=+';
var
  I: Integer;
  P: PView;
  R: TRect;
begin
  R.Assign(5, 3, 29, 18);
  inherited Init(R, 'Task 2');
  Options := Options or ofFirstClick;
  for I := 0 to 19 do begin
    R.A.X := (I mod 4) * 5 + 2;
    R.A.Y := (I div 4) * 2 + 4;
    R.B.X := R.A.X + 5;
    R.B.Y := R.A.Y + 2;
    P := New(PButton, Init(R, KeyChar[I], cmCalcButton, bfNormal + bfBroadcast));
    P^.Options := P^.Options and not ofSelectable;
    Insert(P);
  end;
  R.Assign(3, 2, 21, 3);
  Insert(New(PCalcDisplay, Init(R)));
end;
end.

Новые блоги и статьи Все статьи Все блоги /
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .

@Vladislav_Mirom 0 / 0 / 0 Регистрация: 29.08.2015 Сообщений: 2

	Написать калькулятор (Turbo Vision) 29.08.2015, 20:50. Показов 2013. Ответов 7 Метки нет (Все метки) Написать программу, работающую как простейший калькулятор, выполняющий действия: "+","-","*","/". Turbo Vision. 0

@volvo Супер-модератор 33398 / 21508 / 8236 Регистрация: 22.10.2011 Сообщений: 36,906 Записей в блоге: 12
	29.08.2015, 20:59
	В папке \Tp70\EXAMPLES\TVDEMO есть модуль calc.pas, который реализует функционал калькулятора. Как его подключить к основной программе и запустить - можно посмотреть в файле tvdemo.pas... 1

@bublegums 17 / 17 / 17 Регистрация: 31.10.2014 Сообщений: 79
	12.09.2015, 22:30
	Vladislav_Mirom, Какой ужас, упрощайте код. Это делается гораздо проще. 0