Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей.
Здесь обсуждаются безопасность, программирование, технологии и многое другое.
Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
 |
|

05.02.2008, 01:59
|
|
Познающий
Регистрация: 31.08.2007
Сообщений: 94
Провел на форуме: 422909
Репутация:
200
|
|
Сообщение от MegaDeth
как в делфе сделать чтобы форму поделить на поле с прямоугольниками 15*15 и чтобы каждому мона было задавать цвет %)
зачем надо неспрашивайте :d
Довольно легко, вот сделал так, чтобы сразу задавался рендомный цвет
Код:
var
Form1: TForm1;
h,w,dh,dw:integer;
i,j:byte;
r,g,b:byte;
flox,floy:integer;
implementation
{$R *.dfm}
procedure TForm1.FormPaint(Sender: TObject);
begin
with form1 do
begin
h:=ClientHeight;
w:=ClientWidth;
dh:=round(h/15);
dw:=round(w/15);
flox:=dw-3;
floy:=dh-3;
for i:=1 to 15 do
for j:=1 to 15 do
begin
Canvas.Rectangle((j-1)*dw,(i-1)*dh,j*dw,i*dh);
randomize();
r:=random(255);
g:=random(255);
b:=random(255);
Canvas.Brush.Color:=rgb(r,g,b);
Canvas.FloodFill((j)*flox,(i)*floy,canvas.Pixels[(j)*flox,(i)*floy],fsSurface);
end;
end;
end;
//Работа с Canvas' ом идет не с первой космической скоростью 
|
|
|

05.02.2008, 23:31
|
|
Познающий
Регистрация: 06.11.2007
Сообщений: 30
Провел на форуме: 169550
Репутация:
9
|
|
ээ снова я ))
m: array[1..4] of char = ('T','E','S','T');
а как также только матрицу записать?
дапустим n : array [1..4,1..4] of char
построчно

|
|
|

06.02.2008, 00:10
|
|
Новичок
Регистрация: 15.01.2008
Сообщений: 4
Провел на форуме: 26687
Репутация:
1
|
|
насколько помню это можно сделать так
Код:
m: array[1..4, 1..4] of char = (('T','E','S','T'),
('q','w','e','e'),
('a','s','d','f'),
('z','x','c','v'));
|
|
|

06.02.2008, 17:23
|
|
Познающий
Регистрация: 06.11.2007
Сообщений: 30
Провел на форуме: 169550
Репутация:
9
|
|
Так в паскале
Код:
Uses Crt, Graph;
Var i,Driver,Mode,Regim: Integer;
Begin
Driver:=VGA;
Regim:=VGAmed;
InitGraph(Driver, Regim,'C:\Program Files\tp7\BGI');
Setbkcolor (red);
ClearDevice;
а как теперь это в дельфу в 7ую подогнать? 
|
|
|

06.02.2008, 18:23
|
|
Новичок
Регистрация: 10.11.2006
Сообщений: 24
Провел на форуме: 59656
Репутация:
17
|
|
если тебе нужна работа с графикой то юзай directx ir OpenGL
кусок кода твоего работает в консоли в дельфи он бесполезен
если хочешь на форме рисовать юзай TCanvas
|
|
|

07.02.2008, 21:54
|
|
Постоянный
Регистрация: 12.12.2006
Сообщений: 906
Провел на форуме: 4205500
Репутация:
930
|
|
Кто бы мог подумать, но вот понадобился Паскаль снова =(
Стандартная задача про счастливый билет:
Задается билет (шесть цифарок), нужно вывести на экран следующий после этого счастливый билет. Например: юзер ввел '123320' вывелось '123321'.
До конца отладить прогу так и не получается=(
P.S. На кривоту кода не обращайте внимания, Паскаль не юзал хз скоко времени =(
Огромное спасибо тому кто сделает, ну и конечно +++ =)
Код:
program lucky;
uses Crt;
Var
a,b,c,d,e,f : byte;
aw,bw,cw,dw,ew,fw,nw : string;
er1,er2,er3,er4,er5,er6 : integer;
begin
ClrScr;
writeln('Enter your lucky-number');
readln(nw);
if Length(nw)<>6 then
writeln('Enter valid number')
else
begin
aw:=Copy(nw,1,1);
bw:=Copy(nw,2,1);
cw:=Copy(nw,3,1);
dw:=Copy(nw,4,1);
ew:=Copy(nw,5,1);
fw:=Copy(nw,6,1);
Val(aw,a,er1);
Val(bw,b,er2);
Val(cw,c,er3);
Val(dw,d,er4);
Val(ew,e,er5);
Val(fw,f,er6);
if a+b+c+d+e+f = 54 then
begin
writeln('Congratulation! It is lucky-number!');
writeln('Next lucky-number is 000000')
end
else
if a+b+c=d+e+f then
writeln('Congratulation! It is lucky-number!');
for a:=a to 9 do
for b:=b to 9 do
for c:=c to 9 do
for d:=d to 9 do
for e:=e to 9 do
for f:=f+1 to 9 do // !!!!!!!!!!!!!!!!!!!!!!
if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
break;
end
end
end.
//123320 прекрасно
//111111 ничего кроме это лаки
//000001 ничего
|
|
|

07.02.2008, 23:21
|
|
Участник форума
Регистрация: 03.01.2008
Сообщений: 104
Провел на форуме: 400001
Репутация:
111
|
|
У вас ошибко в алгоритме Сэр)):
Код:
//Выше просто обрезано ;)
if a+b+c+d+e+f = 54 then
begin
writeln('Congratulation! It is lucky-number!');
writeln('Next lucky-number is 000000')
end
else begin
if a+b+c=d+e+f then begin
writeln('Congratulation! It is lucky-number!');
f:=f+1; //Увеличиваем последнюю цифру здесь а не в цикле
end;
for a:=a to 9 do begin
for b:=b to 9 do begin
for c:=c to 9 do begin
for d:=d to 9 do begin
for e:=e to 9 do begin
for f:=f to 9 do begin // !!!!!!!!!!!!!!!!!!!!!!
if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
exit;
end;
end; {сбрасываем счётчики на 0 после 9)
f:=0;
end;
e:=0;
end;
d:=0;
end;
c:=0;
end;
b:=0;
end;
end;
end;
end.
|
|
|

07.02.2008, 23:50
|
|
Познающий
Регистрация: 31.08.2007
Сообщений: 94
Провел на форуме: 422909
Репутация:
200
|
|
У вас ошибко в алгоритме Сэр)):
О. ребят! интересненькая задачка! Pir4tt, замечание верное. но тогда получается, что выводятся все следующие счастливые числа. Надо ведь только одно следующее!  Тут есть маленькая загвоздка. Лучше воспользоваться дополнительными процедурами.
Короче убил, аж целый час. Было интересно!  Проверяй
Код:
Var
a,b,c,d,e,f : byte;
aw,bw,cw,dw,ew,fw,nw : string;
er1,er2,er3,er4,er5,er6 : integer;
left,right:integer;
procedure patch(v1,v2,v3:byte;var ot:integer);
var
buf:string;
code:integer;
begin
if (v1=0) and (v2=0) then buf:=inttostr(v3)
else
if v1=0 then buf:=inttostr(v2)+inttostr(v3)
else
buf:=inttostr(v1)+inttostr(v2)+inttostr(v3);
Val(buf,ot,code);
end;
procedure dispatch(digit:integer; var s1,s2,s3:byte);
var
buf:string;
code:integer;
begin
buf:=inttostr(digit);
if digit<10 then begin
s1:=0;s2:=0;s3:=digit;
end
else
if digit<100 then begin
s1:=0;
Val(copy(buf,2,1),s2,code);
Val(copy(buf,3,1),s3,code);
end
else begin
Val(copy(buf,1,1),s1,code);
Val(copy(buf,2,1),s2,code);
Val(copy(buf,3,1),s3,code);
end;
end;
begin
ClrScr;
writeln('Enter your lucky-number');
readln(nw);
if Length(nw)<>6 then
writeln('Enter valid number')
else
begin
aw:=Copy(nw,1,1);
bw:=Copy(nw,2,1);
cw:=Copy(nw,3,1);
dw:=Copy(nw,4,1);
ew:=Copy(nw,5,1);
fw:=Copy(nw,6,1);
Val(aw,a,er1);
Val(bw,b,er2);
Val(cw,c,er3);
Val(dw,d,er4);
Val(ew,e,er5);
Val(fw,f,er6);
if a+b+c+d+e+f = 54 then
begin
writeln('Congratulation! It is lucky-number!');
writeln('Next lucky-number is 000000');
end
else
if a+b+c=d+e+f then
writeln('Congratulation! It is lucky-number!')
else begin
patch(d,e,f,right);
patch(a,b,c,left);
if left=0 then begin
left:=1;
dispatch(left,a,b,c);
right:=0;
end;
while a+b+c<>d+e+f do
begin
inc(right);
dispatch(right,d,e,f);
if (d=10) and (e=10) and (f=10) then begin
patch(a,b,c,left);
inc(left);
dispatch(left,a,b,c);
end;
end;
writeln('Next lucky-number is ',a,b,c,d,e,f);
end;
readln;
end;
end.
Последний раз редактировалось A2GIL; 07.02.2008 в 23:54..
|
|
|

07.02.2008, 23:58
|
|
Участник форума
Регистрация: 03.01.2008
Сообщений: 104
Провел на форуме: 400001
Репутация:
111
|
|
Сообщение от A2GIL
но тогда получается, что выводятся все следующие счастливые числа.
Нет)) специально проверял, выводится одно следуещее число, обеспечивается заменой брейка на экст
Код:
if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
exit;
end;
A2GIL, вариант интересный, но усложнённый имхо))
//пошёл рассматривать
Последний раз редактировалось Pir4tt; 08.02.2008 в 00:02..
|
|
|

08.02.2008, 00:58
|
|
Познающий
Регистрация: 31.08.2007
Сообщений: 94
Провел на форуме: 422909
Репутация:
200
|
|
Сообщение от Pir4tt
Нет)) специально проверял, выводится одно следуещее число, обеспечивается заменой брейка на экст
Код:
if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
exit;
end;
A2GIL, вариант интересный, но усложнённый имхо))
//пошёл рассматривать
Pir4tt, все таки ты прав  Просто я забыл что в Паскале так можно. Значит твой вариант полегче будет  Молодец.
|
|
|
|
 |
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|