Форум программистов, компьютерный форум, киберфорум
PascalABC.NET
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.65/34: Рейтинг темы: голосов - 34, средняя оценка - 4.65
 Аватар для Poiz0N
5 / 5 / 2
Регистрация: 13.02.2013
Сообщений: 76

Задание цвета в Паскале АВС

29.05.2016, 14:41. Показов 6681. Ответов 3
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Добрый день уважаемые форумчане!
Возникла маленькая проблемка. с Паскалем работал, с АВС опыт не большой. задание цвета в Паскале возможен буквено и численно. а в АВС не могу числами задать. Помогите, там я в цикле меняю цвета.
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
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
program zad3;
uses graphabc;
var
f:text;
p:array[1..7] of integer;
nazv:array[1..7] of String;
znach:array[1..7] of real;
i,j,t,cvet:integer;
tmps:string;
sum,z,x,y,zd,zd1,tmp:Real;
c:char;
begin
assign(f,'file.txt');
reset(f);
       Coordinate.Origin:=new Point(0,0);
       setpencolor(clblack);
       Setbrushcolor(clwhite);
       line(8,8,260,8);
       line(8,90,260,90);
       line(8,8,8,90);
       line(260,8,260,90);
       TextOut(15, 10,'Управление:');
       TextOut(15, 30,'Введите + для вывода по возрастанию');
       TextOut(15, 50,'Введите - для вывода по убыванию');
       TextOut(15, 70,'Введите = для вывода без сортировки');
       
       Coordinate.Origin:=new Point(300,150);
       setpencolor(clblack);
       Setbrushcolor(clwhite);
       line(8,8,260,8);
       line(8,30,260,30);
       line(8,8,8,30);
       line(260,8,260,30);
       TextOut(15, 12,'НПДК максимальний разовий вплив');
       readln(c);
       
 
if c='=' then
begin
sum:=0;
Writeln;Writeln;Writeln;Writeln;
cvet:=0;
For i:=1 to 7 do
  begin
    readln(f,znach[i],c,nazv[i]);
    sum:=sum+znach[i];
  end;
For i:=1 to 7 do
  begin
    setpencolor(clblack);{Вот здесь я хочу сделать разного цвета вывод}
    z:=znach[i]/sum*100;
    Writeln('            ',i,'. ',Nazv[i], ' ', znach[i],' - ',z:2:1,' %');
    cvet:=cvet+1;
  end;
{Начало работы с графикой} 
          Coordinate.Origin:=new Point(150,250);
          {Рисуем круг}
          for i:=1 to 7 do
          begin
          t:=t+round(znach[i]*100);
          p[i]:=360*t div 79;          
          end;    
          
          setpencolor(clblack);
          Brush.Color := clgreen;
          Pie(0,0,100,0,p[1]);
          Brush.Color := clred;
          Pie(0,0,100,p[1],p[2]);
          Brush.Color := clyellow;
          Pie(0,0,100,p[2],p[3]);
          Brush.Color := clgray;
          Pie(0,0,100,p[3],p[4]);
          Brush.Color := clblue;
          Pie(0,0,100,p[4],p[5]); 
          Brush.Color := clnavy;
          Pie(0,0,100,p[5],p[6]);
          Brush.Color := clbrown;
          Pie(0,0,100,p[6],p[7]);
 
          setbrushstyle(bsclear);
          zd:=(360/78)*3.14/180;
          zd1:=zd;
          zd:=0;          
          for i:=1 to 78 do
          begin
            x:=-4+110*sin(i);
            y:=-10-110*cos(i);            
            if (i=7) then
            textout(round(x),round(y),'1');  
            if (i=8) then
            textout(round(x),round(y),'7');
            if (i=10) then
            textout(round(x),round(y),'3');  
            if (i=18) then
            textout(round(x),round(y),'2');  
            if (i=9) then
            textout(round(x),round(y),'4');
            if (i=40) then
            textout(round(x),round(y),'5');
            if (i=46) then
            textout(round(x),round(y),'6');
          end;
          
end;
if c='+' then
begin
sum:=0;
Writeln;Writeln;Writeln;Writeln;
For i:=1 to 7 do
begin
readln(f,znach[i],c,nazv[i]);
sum:=sum+znach[i];
end;
for i:=2 to 7 do
for j:=1 to (i-1) do
if znach[i]<znach[j] then
begin
tmp:=znach[i];
znach[i]:=znach[j];
znach[j]:=tmp;
 
tmps:=nazv[i];
nazv[i]:=nazv[j];
nazv[j]:=tmps;
end;
For i:=1 to 7 do
begin
z:=znach[i]/sum*100;
Writeln(' ',i,'. ',Nazv[i], ' ', znach[i],' - ',z:2:1,' %');
end;
{Начало работы с графикой} 
Coordinate.Origin:=new Point(150,250);
{Рисуем круг}
for i:=1 to 7 do
begin
t:=t+round(znach[i]*100);
p[i]:=360*t div 84; 
end; 
 
setpencolor(clblack);
Brush.Color := clgreen;
Pie(0,0,100,0,p[1]);
Brush.Color := clred;
Pie(0,0,100,p[1],p[2]);
Brush.Color := clyellow;
Pie(0,0,100,p[2],p[3]);
Brush.Color := clgray;
Pie(0,0,100,p[3],p[4]);
Brush.Color := clblue;
Pie(0,0,100,p[4],p[5]); 
Brush.Color := clnavy;
Pie(0,0,100,p[5],p[6]);
Brush.Color := clbrown;
Pie(0,0,100,p[6],p[7]);
setbrushstyle(bsclear);
zd:=(360/83)*3.14/180;
zd1:=zd;
zd:=0; 
for i:=1 to 83 do
begin
x:=-4+110*sin(i);
y:=-10-110*cos(i); 
if (i=14) then
textout(round(x),round(y),'1'); 
if (i=21) then
textout(round(x),round(y),'7');
if (i=1) then
textout(round(x),round(y),'3'); 
if (i=20) then
textout(round(x),round(y),'2'); 
if (i=44) then
textout(round(x),round(y),'4');
if (i=18) then
textout(round(x),round(y),'5');
if (i=5) then
textout(round(x),round(y),'6');
end;
end;
if c='-' then
begin
sum:=0;
Writeln;Writeln;Writeln;Writeln;
For i:=1 to 7 do
  begin
    readln(f,znach[i],c,nazv[i]);
    sum:=sum+znach[i];
 end;
for i:=2 to 7 do
              for j:=1 to (i-1) do
                if znach[i]>znach[j] then
                begin
                  tmp:=znach[i];
                  znach[i]:=znach[j];
                  znach[j]:=tmp;
                  
                  tmps:=nazv[i];
                  nazv[i]:=nazv[j];
                  nazv[j]:=tmps;
                end;
For i:=1 to 7 do
  begin
    z:=znach[i]/sum*100;
    Writeln('    ',i,'. ',Nazv[i], ' ', znach[i],' - ',z:2:1,' %');
  end;
{Начало работы с графикой} 
          Coordinate.Origin:=new Point(150,250);
          {Рисуем круг}
          for i:=1 to 7 do
          begin
          t:=t+round(znach[i]*100);
          p[i]:=360*t div 79;          
          end;    
          
          setpencolor(clblack);
          Brush.Color := clgreen;
          Pie(0,0,100,0,p[1]);
          Brush.Color := clred;
          Pie(0,0,100,p[1],p[2]);
          Brush.Color := clyellow;
          Pie(0,0,100,p[2],p[3]);
          Brush.Color := clgray;
          Pie(0,0,100,p[3],p[4]);
          Brush.Color := clblue;
          Pie(0,0,100,p[4],p[5]); 
          Brush.Color := clnavy;
          Pie(0,0,100,p[5],p[6]);
          Brush.Color := clbrown;
          Pie(0,0,100,p[6],p[7]);
 
          setbrushstyle(bsclear);
          zd:=(360/78)*3.14/180;
          zd1:=zd;
          zd:=0;          
          for i:=1 to 78 do
          begin
            x:=-4+110*sin(i);
            y:=-10-110*cos(i);            
            if (i=18) then
            textout(round(x),round(y),'1');  
            if (i=20) then
            textout(round(x),round(y),'7');
            if (i=10) then
            textout(round(x),round(y),'3');  
            if (i=11) then
            textout(round(x),round(y),'2');  
            if (i=9) then
            textout(round(x),round(y),'4');
            if (i=46) then
            textout(round(x),round(y),'5');
            if (i=39) then
            textout(round(x),round(y),'6');
          end;
end; 
close(f);
end.
0
Лучшие ответы (1)
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
29.05.2016, 14:41
Ответы с готовыми решениями:

Как сохранить в Паскале АВС NET исполняемый файл
Как сохранить в Паскале АВС NET файл с расширением .exe

задание на паскале
народ задали 20 прог на паскальз! вот некоторые я не могу решить! 4: Даны числовой ряд и некоторое число ε. Найти наименьший...

Задание по файлам в паскале
1. В заданном предложении в конце каждого слова поставить многоточие. Напечатать исходный и преобразованный тексты, а также длину...

3
 Аватар для Cyber_Monster_
148 / 129 / 155
Регистрация: 22.03.2016
Сообщений: 502
29.05.2016, 15:00
Pascal
1
System.Drawing.Color.FromArgb(r,g,b: integer);
1
 Аватар для Poiz0N
5 / 5 / 2
Регистрация: 13.02.2013
Сообщений: 76
29.05.2016, 15:10  [ТС]
не до конца понял как мне им в цикле можно будет изменить цвет?
0
 Аватар для Cyber_Monster_
148 / 129 / 155
Регистрация: 22.03.2016
Сообщений: 502
29.05.2016, 16:06
Лучший ответ Сообщение было отмечено Poiz0N как решение

Решение

Подпрограмма возвращает тип system.drawing.color
Посылаете вместо r,g,b - цифровые значения цвета:
r - параметр красного
g - параметр зеленого
b - параметр синего

К примеру:
Pascal
1
2
3
4
5
6
7
 For i:=1 to 7 do
  begin
    setpencolor(System.Drawing.Color.FromArgb(Random(integer.MaxValue)));{Вот здесь я хочу сделать разного цвета вывод}
    z:=znach[i]/sum*100;
    Writeln('            ',i,'. ',Nazv[i], ' ', znach[i],' - ',z:2:1,' %');
    cvet:=cvet+1;
  end;
Добавлено через 4 минуты
Пример:
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
uses ABCObjects, GraphABC;
const
  rmn = 5;  //Минимальный радиус окружности
  rmx = 40;  //Максимальный радиус окружности
type
  circles = class
    public x: integer;
    public y: integer;
    public r: integer;
    public c_obj_: ABCObjects.CircleABC;
    public procedure Print_(cl: integer);
      begin
        self.c_obj_:= ABCObjects.CircleABC.Create(x,y,r,System.Drawing.Color.FromArgb(cl));
      end;
    constructor create(x,y,r,cl: integer);
      begin
        self.x:= x;
        self.y:= y;
        self.r:= r;
        Print_(cl);
      end;
    public procedure erase_();
      begin
        self.c_obj_.Destroy;
        ABCObjects.RedrawObjects
      end;
  end;
var
  obj_: array of circles:= new circles[0];
procedure main();
  begin
    var o:= ABCObjects.TextABC.Create(1,1,12,'Введите количество окружностей');
    for var i:= 0 to ReadInteger() do
      begin
        SetLength(obj_,obj_.Length+1);
        obj_[i]:= circles.create(Random(graphABC.Window.Width-rmx*2+1)+rmx,Random(graphABC.Window.Height-rmx*2+1)+rmx,Random(rmx-rmn*2+1)+rmn,Random(integer.MaxValue));
      end;
    //Этот блок можно опустить
    o.Destroy;
    ABCObjects.RedrawObjects;
    var i: integer:= 0;
    While true do
      begin
        if i >= obj_.Length
          then
            i:= 0;
        obj_[i].erase_;
        obj_[i]:= circles.create(Random(graphABC.Window.Width-rmx*2+1)+rmx,Random(graphABC.Window.Height-rmx*2+1)+rmx,Random(rmx-rmn*2+1)+rmn,Random(integer.MaxValue));
        i += 1;
      end;
    //Этот блок можно опустить
  end;
begin
  Randomize;
  main;
end.
Строка №13, 4ый параметр, где cl - псевдо случайное число
1
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
29.05.2016, 16:06
Помогаю со студенческими работами здесь

Школьное задание на ПАСКАЛЕ
Вообщем попросили сделать задание на паскале, а я не шарю вообще в нем. Короч кому не трудно, сделайте? Если что, как вознаграждение -...

Экзаменационное задание на Паскале
Составить тесты программ для проверки программы, используя метод эквивалентного разбиения. Сформировать список ошибок, которые могут быть...

задание на двумерный массив в Паскале.
Здравствуйте!Помогите,пожалуйста!Не получается решить следующую задачку в паскале!Условие: известно количество сделанных столов тремя...

задание, походу, легкое, но я в паскале полный ноль
y=ln(x), если x&lt;(a-1) y=cos(x-a), если x&gt;=(a-1) x Є ;x] x=x+(дельта)x

составить программу на паскале . Программирование циклических алгоритмов (задание во вложении)
условие


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

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Новые блоги и статьи
1С: Контроль уникальности заводского номера
Maks 23.03.2026
Алгоритм контроля уникальности заводского (или серийного) номера на примере документа выдачи шин для спецтехники с табличной частью. Данные берутся из регистра сведений, по которому настроено. . .
Хочу заставить корпорации вкладываться в здоровье сотрудников: делаю мат модель здравосохранения
anaschu 22.03.2026
e7EYtONaj8Y Z4Tv2zpXVVo https:/ / github. com/ shumilovas/ med2. git
1С: Программный отбор элементов справочника по группе
Maks 22.03.2026
Установка программного отбора элементов справочника "Номенклатура" из модуля формы документа. В качестве фильтра для отбора справочника служит группа номенклатуры. Отбор по наименованию группы. . .
Как я обхитрил таблицу Word
Alexander-7 21.03.2026
Когда мигает курсор у внешнего края таблицы, и нам надо перейти на новую строку, а при нажатии Enter создается новый ряд таблицы с ячейками, то мы вместо нервных нажатий Энтеров мы пишем любые буквы. . .
Krabik - рыболовный бот для WoW 3.3.5a
AmbA 21.03.2026
без регистрации и смс. Это не торговля, приложение не содержит рекламы. Выполняет свою непосредственную задачу - автоматизацию рыбалки в WoW - и ничего более. Однако если админы будут против -. . .
1С: Программный отбор элементов справочника по значению перечисления
Maks 21.03.2026
Установка программного отбора элементов справочника "Сотрудники" из модуля формы документа. В качестве фильтра для отбора служит значение перечислений. / / Событие "НачалоВыбора" реквизита на форме. . .
Переходник USB-CAN-GPIO
Eddy_Em 20.03.2026
Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .
Оттенки серого
Argus19 18.03.2026
Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru