![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() |
BRS |
![]()
Сообщение
#1
|
![]() Новичок ![]() Группа: Пользователи Сообщений: 45 Пол: Мужской Репутация: ![]() ![]() ![]() |
Вобщем так, если кому не лень - помогите с программой.
Пишу данный проэкт исключительно из любопытства и для себя ))) Вобщем так. Вот код программы: Код program Paint; uses screen, myunit, crt, graph; var x, y,color, size : integer; key : char; brush : boolean; begin IG; logo; userscreen; brush := false;x := (getmaxx + 120) div 2; y := getmaxy div 2; size := 1; color := 15; repeat cursor(x,y); key := readkey; case ord(key) of 72: begin if (brush = true) and (y <> 16) then begin y := y - 1; putpoint(x,y,size,color); end; if (brush <> true) and (y <> 16) then y := y - 1; end; 75: begin if (brush = true) and (x <> 131) then begin x := x - 1; putpoint(x,y,size,color); end; if (brush <> true) and (x <> 131) then x := x - 1; end; 80: begin if (brush = true) and (y <> getmaxy - 16) then begin y := y + 1; putpoint(x,y,size,color); end; if (brush <> true) and (y <> getmaxy - 16) then y := y + 1; end; 77: begin if (brush = true) and (x <> getmaxx - 16) then begin x := x + 1; putpoint(x,y,size,color); end; if (brush <> true) and (x <> getmaxx - 16) then x := x + 1; end; 49: color := 1; 50: color := 9; 51: color := 2; 52: color := 4; 53: color := 5; 54: color := 6; 55: color := 14; 56: color := 15; 57: color := 0; 99: begin cleardevice; userscreen; brush := false;x := (getmaxx + 120) div 2; y := getmaxy div 2; size := 1; color := 15; end; 9: begin brush := not brush; if brush = true then putpoint(x,y,size,color); end; 61: if size < 10 then size := size + 1; 45: if size > 1 then size := size - 1; end; until ord(key) = 27; closeGraph; end. Вот модули: Код unit screen; interface uses crt, graph; var x, y : integer; procedure logo; procedure userscreen; procedure cursor(x,y : integer); implementation procedure logo; var i : integer; begin settextstyle(0,0,3); outtextxy(125,200, 'Turbo Brush v 1.0'); repeat for i := 1 to 10 do begin arc(getmaxx div 2,460,360,180,i*20); delay(2000); end; setcolor(0); for i := 1 to 10 do begin arc(getmaxx div 2,460,360,180,i*20); delay(2000); end; setcolor(15); until keypressed; cleardevice; settextstyle(0,0,0); end; procedure userscreen; begin y := 25; x := 15; line(120,5,120,getmaxy-5); line(120,5,getmaxx-5,5); line(getmaxx-5,5,getmaxx-5,getmaxy-5); line(getmaxx-5,getmaxy-5,120,getmaxy-5); setfillstyle(1,7); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Brush TAB');y := y + 25;setcolor(15); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Left <=');y := y + 25;setcolor(15); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Right =>');y := y + 25;setcolor(15); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Up /\');y := y + 25;setcolor(15); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Down \/');y := y + 25;setcolor(15); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Size +/-');y := y + 25;setcolor(15); bar3d(10,y-15,90,y,4,true);setcolor(0);outtextxy(x,y-10,'SetColor:');y := y + 25;setcolor(15); bar3d(10,y-15,20,y,4,true); bar3d(10+20,y-15,20+20,y,4,true); bar3d(10+40,y-15,20+40,y,4,true); setcolor(1);outtextxy(x-3,y-10, '1'); setcolor(9);outtextxy(x+17,y-10, '2'); setcolor(2);outtextxy(x+37,y-10, '3'); y := y + 25;setcolor(15); bar3d(10,y-15,20,y,4,true); bar3d(10+20,y-15,20+20,y,4,true); bar3d(10+40,y-15,20+40,y,4,true); setcolor(4);outtextxy(x-3,y-10, '4'); setcolor(5);outtextxy(x+17,y-10, '5'); setcolor(6);outtextxy(x+37,y-10, '6'); y := y + 25;setcolor(15); bar3d(10,y-15,20,y,4,true); bar3d(10+20,y-15,20+20,y,4,true); bar3d(10+40,y-15,20+40,y,4,true); setcolor(14);outtextxy(x-3,y-10, '7'); setcolor(15);outtextxy(x+17,y-10, '8'); setcolor(0);outtextxy(x+37,y-10, '9'); y := y + 25;setcolor(15); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Clear C');y := y + 25;setcolor(15); bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Quit ESC');y := y + 25;setcolor(15); end; procedure cursor(x,y : integer); var pix_0,pix_11,pix_12,pix_21,pix_22,pix_31,pix_32,pix_41,pix_42 : word; begin pix_0 := getpixel(x,y); pix_11 := getpixel(x-1,y);pix_12 := getpixel(x-2,y); pix_21 := getpixel(x+1,y);pix_22 := getpixel(x+2,y); pix_31 := getpixel(x,y-1);pix_32 := getpixel(x,y-2); pix_41 := getpixel(x,y+1);pix_42 := getpixel(x,y+2); repeat putpixel(x,y,8); putpixel(x-1,y,8);putpixel(x,y+2,8); putpixel(x+1,y,8);putpixel(x,y-2,8); putpixel(x,y-1,8);putpixel(x,y+2,8); putpixel(x,y+1,8);putpixel(x,y-2,8); until keypressed; putpixel(x,y, pix_0); putpixel(x-1,y, pix_11);putpixel(x-2,y, pix_12); putpixel(x+1,y, pix_21);putpixel(x+2,y, pix_22); putpixel(x,y-1, pix_31);putpixel(x,y-2, pix_32); putpixel(x,y+1, pix_41);putpixel(x,y+2, pix_42); end; end. Код unit MyUnit; interface uses graph,crt; procedure IG; procedure PutPoint(x,y,size,color : integer); function Grade(a,x : real) : real; implementation procedure IG; var GD, GM, Error : integer; begin GD := Detect; InitGraph(GD, GM,''); Error := GraphResult; if Error <> grOk then begin writeln('Graphics error:', GraphErrorMsg(Error)); writeln('Press any key...'); readkey; clrscr; halt; end; end; procedure PutPoint(x,y,size,color : integer); var i,j,k, center : integer; begin if size > 10 then size := 10; if size < 1 then size := 1; j := 1; for i := 1 to size do begin k := j; j := j + 2; end; size := k; center := size div 2 + 1; for i := 1 to size do for j := 1 to size do putpixel(i + x - center, j + y - center, color); end; function Grade(a, x: real): real; begin grade := Exp(a*Ln(x)); end; end. Пока что мне собственно необходима помощь вот в чем... Мне необходимо написать модуль работы с файлами. Процедура SaveIM(name) должна сохранять рабочую область (диагональ (120,5,getmaxx-5,getmaxy-5)) в файл name. Процедура OpenIm(name) дожна заполнять ту же рабочую область ранее сохраненным изображением в файле name. |
![]() ![]() |
BRS |
![]()
Сообщение
#2
|
![]() Новичок ![]() Группа: Пользователи Сообщений: 45 Пол: Мужской Репутация: ![]() ![]() ![]() |
Сенькс. Щас проверю
|
![]() ![]() |
![]() |
Текстовая версия | 20.07.2025 17:42 |