Правила форума
Прочтите прежде чем задавать вопрос!
Пишу данный проэкт исключительно из любопытства и для себя )))
Вобщем так. Вот код программы:
Код
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.
