Список використанИх джерел
http://www.yandex.ru
http://www.wikipedia.ua
Т.В.Ковалюк “ Основи програмування ”
В.В. Фаронов Turbo Pascal
Павловський Г.Ю. Підручник з інформатики 10 – 11 клас
Глинський Я.М., В.Є.Анохін, В.А.Ряжська Turbo Pascal & Delphi.
Додаток A
Лістинг
(paint.pas)
program paint(output, input);
uses crt, graph, dos, m_mouse;
const enter = #13;
esc = #27;
up = #72;
down = #80;
PageUp = #73;
PageDown = #81;
BackSpace = #8;
F1 = #59;
x = 550;
y = 350;
Directory = $10;
type_file = '*.*';
fon_clr = white;
var text_, key_prs:string;
size, i, i_, size_char, size_bl1, size_bl2, size_mbl:integer;
img, img_char:^integer;
m_x, m_y, size_cur, v_x, v_y, opr_vol:integer;
mouse_x_, mouse_y_, color, scr_x, scr_y,
oper, cur_x, cur_y, mop_x, mop_y:integer;
dos_cor, dos_1, dos_2, dos_3, dos_4,
dos_5, dos_6, dos_7, dos_8, dos_9,
dos_10, dos_11, dos_12, dos_13:boolean;
bl_1, bl_2, mbl:^pointer;
dir:string;
procedure menu_oper(zx, on_k:boolean; lin, lim, o_x, o_y:integer); forward;
{показ, включення кнопок, починаючи з, закинчуючи з, координати початку x, координати початку y}
procedure menu_vol; forward;
procedure Fil_op(txt:boolean); forward;
procedure cnf_delete_f(x1, y1, x2, y2:integer); forward;
procedure delete_f; forward;
procedure open_mblocks(om_x, om_y:integer); forward;
procedure sleep_mouse;
begin
repeat
until key_left_mouse = False;
end;
procedure save_blocks;
begin
off_mouse;
freemem(bl_1, size_bl1);
size_bl1:=imagesize(scr_x+1, scr_y+1, 300+scr_x-1, y+scr_y-1);
getmem(bl_1, size_bl1);
getimage(scr_x+1, scr_y+1, 300+scr_x-1, y+scr_y-1, bl_1^);
freemem(bl_2, size_bl2);
size_bl2:=imagesize(scr_x+300, scr_y+1, 550+scr_x-1, y+scr_y-1);
getmem(bl_2, size_bl2);
getimage(scr_x+300, scr_y+1, 550+scr_x-1, y+scr_y-1, bl_2^);
on_mouse;
end;
procedure open_blocks;
begin
off_mouse;
putimage(scr_x+1, scr_y+1, bl_1^, normalput);
putimage(scr_x+300, scr_y+1, bl_2^, normalput);
on_mouse;
end;
procedure config_graph;
var dr, mode:integer;
begin
getdir(0, dir);
insert('\bgi\', dir, length(dir)+1);
dr:=detect;
initgraph(dr, mode, dir);
SetColor(red);
SetTextStyle(7, 0, 1);
end;
procedure del_grp(d_x, d_y, d_x_, d_y_, col_del:integer);
begin
for i_:=d_y to d_y_ do begin
for i:=d_x to d_x_ do begin
putpixel(i, i_, col_del);
end;
end;
end;
procedure krd_mouse;
begin
if(Mouse_X >= scr_x)and(scr_x+x >= Mouse_X)and
(Mouse_Y >= scr_y)and(scr_y+y >= Mouse_Y)then begin
dos_cor:=True;
if(Mouse_X-scr_x <> m_x)or(Mouse_Y-scr_y <> m_y)then begin
del_grp(470, 430, 635, 470, 11);
m_x:=Mouse_X-scr_x;
m_y:=Mouse_Y-scr_y;
str(m_x, text_);
SetColor(red);
SetTextStyle(1, 0, 1);
OutTextXY(480, 440, 'X = ');
OutTextXY(520, 440, text_);
OutTextXY(550, 440, ' Y = ');
str(m_y, text_);
OutTextXY(600, 440, text_);
end;
end
else begin
if(dos_cor = True)then begin
dos_cor:=False;
del_grp(470, 430, 635, 470, 11);
end;
end;
end;
procedure stena;
begin
SetColor(11);
Rectangle(scr_x-1, scr_y-1, scr_x+x+10, scr_y+y+1);
SetFillStyle(1, 11);
FloodFill(1, 1, 11);
end;
procedure naw_color(col:byte);
begin
SetColor(col);
Rectangle(410, 440, 460, 460);
SetFillStyle(1, col);
FloodFill(411, 441, col);
SetColor(red);
Rectangle(410, 440, 460, 460);
end;
procedure menu_color(on:boolean);
begin
if((10+20*(i+1) >= mouse_x)and(mouse_x <= 30+20*(i+1))and
(mouse_y >= 440)and(mouse_y <= 460)and(key_mouse = True))or(on = True)then begin
naw_color(color);
for i:=0 to 15 do begin
off_mouse;
while(10+20*(i+1) >= mouse_x)and(mouse_x <= 30+20*(i+1))and
(mouse_y >= 440)and(mouse_y <= 460)and(key_mouse = True)do begin
color:=i;
naw_color(color);
end;
SetColor(i);
Rectangle(10+20*i, 440, 30+20*i, 460);
SetFillStyle(1, i);
FloodFill(10+20*i+1, 441, i);
on_mouse;
if(KeyPressed = True)then begin
key_prs:=readkey;
break;
end;
end;
off_mouse;
SetColor(red);
rectangle(10, 439, 331, 461);
on_mouse;
end;
end;
procedure out_text(col_ex, col_sp:integer);
begin
SetColor(red);
SetTextStyle(1, 0, 1);
OutTextXY(335, 440, 'Дан.кол.');
SetColor(col_sp);
Rectangle(40, 1, 180, 20);
SetFillStyle(1, col_sp);
FloodFill(41, 2, col_sp);
SetColor(8);
Rectangle(40, 1, 180, 20);
OutTextXY(50, 0, 'F1 - довiдка');
SetColor(col_ex);
Rectangle(40, 20, 180, 40);
SetFillStyle(1, col_ex);
FloodFill(41, 21, col_ex);
SetColor(8);
Rectangle(40, 20, 180, 40);
OutTextXY(50, 20, 'ESC - вихiд');
SetTextStyle(7, 0, 5);
SetColor(7);
OutTextXY(233, 3, 'P A I N T');
SetColor(red);
OutTextXY(230, 0, 'P A I N T');
OutTextXY(231, 1, 'P A I N T');
end;
procedure open_mblocks(om_x, om_y:integer);
begin
off_mouse;
putimage(om_x, om_y, mbl^, normalput);
on_mouse;
end;
procedure save_mblocks(sm_x, sm_y, sm_x_, sm_y_:integer);
begin
freemem(mbl, size_mbl);
size_mbl:=imagesize(sm_x, sm_y, sm_x_, sm_y_);
getmem(mbl, size_mbl);
getimage(sm_x, sm_y, sm_x_, sm_y_, mbl^);
end;
procedure Drow;
var mouse_x__, p_x_nal, p_y_nal, p_x_kon, p_y_kon,
p_x_kon_, p_y_kon_, zal, zal_,
zal_x, zal_y:integer;
begin
dos_1:=False;
dos_2:=False;
p_x_nal:=mouse_x+1;
p_y_nal:=mouse_y+1;
p_x_kon:=mouse_x+1;
p_y_kon:=mouse_y+1;
p_x_kon_:=mouse_x+1;
p_y_kon_:=mouse_y+1;
case oper+1 of {таблица операций в не нажатия на екран}
1:begin
dos_11:=True;
dos_10:=False;
off_mouse;
open_mblocks(mop_x+10, mop_y+10);
del_grp(scr_x, scr_y, scr_x+x+10, scr_y+y, fon_clr);
oper:=99; {збиваем счётчик таблици операций}
save_blocks;
stena;
out_text(7, 7);
mouse_goto_xy(mouse_x+30, mouse_y);
menu_oper(True, True, 1, 10, 20, 50);
menu_color(True);
on_mouse;
end;
2:begin
dos_11:=True;
dos_10:=False;
off_mouse;
open_mblocks(mop_x+10, mop_y+10);
oper:=99;
open_blocks;
mouse_goto_xy(mouse_x+30, mouse_y);
menu_oper(True, True, 1, 10, 20, 50);
on_mouse;
end;
6, 7:begin
if(dos_7 = False)then dos_5:=False;
dos_7:=True;
menu_vol;
end;
9:begin
dos_11:=True;
dos_10:=False;
open_mblocks(mop_x+10, mop_y+10);
Fil_op(False); {True - зберегти, False - вiдкрити}
oper:=99;
menu_oper(True, True, 1, 10, 20, 50);
end;
10:begin
dos_11:=True;
dos_10:=False;
open_mblocks(mop_x+10, mop_y+10);
Fil_op(True);
oper:=99;
menu_oper(True, True, 1, 10, 20, 50);
end;
end;
if(oper+1 <> opr_vol)then begin
opr_vol:=oper+1;
dos_7:=False;
del_grp(50, 405, 400, 435, 11);
end;
dos_3:=True;
while(key_mouse = True)and(mouse_x >= scr_x)and(mouse_x <= x+scr_x)and
(mouse_y >= scr_y)and(mouse_y <= y+scr_y)do begin
dos_11:=True;
dos_10:=False;
if(dos_3 <> False)then begin
dos_3:=False;
save_blocks;
end;
if(mouse_x <> p_x_kon)or(mouse_y <> p_y_kon)or(dos_4 <> True)then begin
dos_4:=True; {переменная для рисования одним нажатием (с первого раза)}
case oper+1 of {таблица операция на нажатия на екран}
3:begin
while (key_mouse = True)do begin
p_x_kon:=mouse_x;
p_y_kon:=mouse_y;
if(p_x_kon <> p_x_kon_)or(p_y_kon <> p_y_kon_)then begin
p_x_kon_:=p_x_kon;
p_y_kon_:=p_y_kon;
if((p_x_nal-(p_x_kon-p_x_nal) > scr_x)and(p_x_nal+(p_x_kon-p_x_nal) < x+scr_x)
and(p_y_nal-(p_x_kon-p_x_nal) > scr_y)and(p_y_nal+(p_x_kon-p_x_nal) < y+scr_y))and
((mouse_x > scr_x)and(mouse_x < x+scr_x)and
(mouse_y > scr_y)and(mouse_y < y+scr_y))
and((p_x_nal-(mouse_x-p_x_nal) > scr_x)and(p_x_nal+(mouse_x-p_x_nal) < x+scr_x))
and((p_y_nal-(mouse_x-p_x_nal) > scr_y)and(p_y_nal+(mouse_x-p_x_nal) < y+scr_y))
then begin
off_mouse;
SetColor(fon_clr);
open_blocks;
circle(p_x_nal, p_y_nal, p_x_kon-p_x_nal);
SetColor(color);
circle(p_x_nal, p_y_nal, p_x_kon-p_x_nal);
on_mouse;
end
else begin
sleep_mouse;
break;
end;
end;
on_mouse;
if(p_y_nal <> mouse_y)then mouse_goto_xy(mouse_x, p_y_nal);
end;
end;
4:begin
while (key_mouse = True)do begin
p_x_kon:=mouse_x;
p_y_kon:=mouse_y;
if((mouse_x > scr_x)and(mouse_x < x+scr_x)and
(mouse_y > scr_y)and(mouse_y < y+scr_y))then begin
if(p_x_kon <> p_x_kon_)or(p_y_kon <> p_y_kon_)then begin
p_x_kon_:=p_x_kon;
p_y_kon_:=p_y_kon;
off_mouse;
SetColor(fon_clr);
open_blocks;
line(p_x_nal, p_y_nal, p_x_kon, p_y_kon);
SetColor(color);
line(p_x_nal, p_y_nal, p_x_kon, p_y_kon);
on_mouse;
end;
end;
end;
end;
5:begin
while (key_mouse = True)do begin
p_x_kon:=mouse_x;
p_y_kon:=mouse_y;
if((mouse_x > scr_x)and(mouse_x < x+scr_x)and
(mouse_y > scr_y)and(mouse_y < y+scr_y))then begin
if(p_x_kon <> p_x_kon_)or(p_y_kon <> p_y_kon_)then begin
p_x_kon_:=p_x_kon;
p_y_kon_:=p_y_kon;
off_mouse;
SetColor(fon_clr);
open_blocks;
Rectangle(p_x_nal, p_y_nal, p_x_kon, p_y_kon);
SetColor(color);
Rectangle(p_x_nal, p_y_nal, p_x_kon, p_y_kon);
on_mouse;
end;
end;
end;
end;
6:begin
while (key_mouse = True) do begin
p_x_kon:=mouse_x;
p_y_kon:=mouse_y;
if(p_x_kon-size_cur > scr_x)and(p_x_kon+size_cur < x+scr_x)and
(p_y_kon-size_cur > scr_y)and(p_y_kon+size_cur < y+scr_y)then begin
if(p_x_kon <> p_x_kon_)or(p_y_kon <> p_y_kon_)then begin
off_mouse;
p_x_kon_:=p_x_kon;
p_y_kon_:=p_y_kon;
SetColor(7);
circle(p_x_kon, p_y_kon, size_cur);
SetFillStyle(1, 7);
FloodFill(p_x_kon, p_y_kon, 7);
SetColor(fon_clr);
circle(p_x_kon, p_y_kon, size_cur);
SetFillStyle(1, fon_clr);
FloodFill(p_x_kon, p_y_kon, fon_clr);
SetColor(color);
circle(p_x_kon, p_y_kon, size_cur);
SetFillStyle(1, color);
FloodFill(p_x_kon, p_y_kon, color);
on_mouse;
end;
end;
end;
end;
7:begin
off_mouse;
if(dos_8 = True)then begin
dos_8:=False;
SetColor(fon_clr);
circle(p_x_kon, p_y_kon, size_cur);
SetFillStyle(1, fon_clr);
FloodFill(p_x_kon, p_y_kon, fon_clr);
end;
while (key_mouse = True) do begin
p_x_kon:=mouse_x;
p_y_kon:=mouse_y;
if(p_x_kon-size_cur > scr_x)and(p_x_kon+size_cur < x+scr_x)and
(p_y_kon-size_cur > scr_y)and(p_y_kon+size_cur < y+scr_y)then begin
if(p_x_kon <> p_x_kon_)or(p_y_kon <> p_y_kon_)then begin
dos_8:=True;
off_mouse;
SetColor(fon_clr);
circle(p_x_kon_, p_y_kon_, size_cur);
SetFillStyle(1, fon_clr);
FloodFill(p_x_kon_, p_y_kon_, fon_clr);
SetColor(7);
circle(p_x_kon, p_y_kon, size_cur);
SetFillStyle(1, 7);
FloodFill(p_x_kon, p_y_kon, 7);
p_x_kon_:=p_x_kon;
p_y_kon_:=p_y_kon;
SetColor(fon_clr);
circle(p_x_kon, p_y_kon, size_cur);
SetFillStyle(1, fon_clr);
FloodFill(p_x_kon, p_y_kon, fon_clr);
if(key_mouse = True)then begin
SetColor(7);
circle(p_x_kon, p_y_kon, size_cur);
SetFillStyle(1, 7);
FloodFill(p_x_kon, p_y_kon, 7);
end;
on_mouse;
end;
end;
end;
if(key_mouse <> True)then begin
SetColor(fon_clr);
circle(p_x_kon_, p_y_kon_, size_cur);
SetFillStyle(1, fon_clr);
FloodFill(p_x_kon_, p_y_kon_, fon_clr);
end;
end;
8:begin
off_mouse;
zal:=getpixel(mouse_x, mouse_y);
zal_:=zal;
if((mouse_x > scr_x)and(mouse_x < scr_x+x))
and((mouse_y > scr_y)and(mouse_y < scr_y+y))then begin
zal_x:=mouse_x;
zal_y:=mouse_y;
end;
while(zal = zal_)do begin
zal_x:=zal_x + 1;
zal_:=getpixel(zal_x, zal_y);
if(zal_x = scr_x+x-1)then begin
zal_:=color;
break;
end;
end;
zal:=zal_;
SetColor(zal);
Rectangle(scr_x-1, scr_y-1, scr_x+x+10, scr_y+y+1);
SetColor(zal);
SetFillStyle(1, zal);
FloodFill(zal_x-1, zal_y, zal);
SetColor(11);
Rectangle(scr_x-1, scr_y-1, scr_x+x+10, scr_y+y+1);
sleep_mouse;
end;
end;
end;
if(KeyPressed = True)then if(readkey = esc)then break;
end;
dos_4:=False;
dos_8:=False;
end;
procedure menu_oper(zx, on_k:boolean; lin, lim, o_x, o_y:integer);
var tol:byte;
begin
if(dos_10 <> True)then begin
dos_10:=True;
mop_x:=600;
save_mblocks(mop_x+10, mop_y+10, mop_x+71, mop_y+20);
end;
if(((mouse_x <> mop_x)or(mouse_y <> mop_y))and
((mouse_x >= o_x)and(mouse_x <= o_x+20)and
(mouse_y >= o_y+25*(0))and(mouse_y <= o_y+20+25*(lim-1))))then begin
dos_11:=False;
open_mblocks(mop_x+10, mop_y+10);
mop_x:=mouse_x;
mop_y:=mouse_y;
save_mblocks(mop_x+10, mop_y+10, mop_x+71, mop_y+20);
SetColor(white);
Rectangle(mop_x+10, mop_y+10, mop_x+71, mop_y+20);
del_grp(mop_x+10, mop_y+10, mop_x+71, mop_y+20, 15);
SetColor(black);
Rectangle(mop_x+10, mop_y+10, mop_x+71, mop_y+20);
SetTextStyle(2, 0, 4);
for i:=lin to lim do begin
if((mouse_x >= o_x)and(mouse_x <= o_x+20)
and(mouse_y >= o_y+25*(i-1))and(mouse_y <= o_y+20+25*(i-1)))then begin
case i of
1:OutTextXY(mop_x+12, mop_y+10, 'Новий файл');
2:OutTextXY(mop_x+12, mop_y+10, 'Назад');
3:OutTextXY(mop_x+12, mop_y+10, 'Круг');
4:OutTextXY(mop_x+12, mop_y+10, 'Лiнiя');
5:OutTextXY(mop_x+12, mop_y+10, 'Прямокутн.');
6:OutTextXY(mop_x+12, mop_y+10, 'Олiвець');
7:OutTextXY(mop_x+12, mop_y+10, 'Гумка');
8:OutTextXY(mop_x+12, mop_y+10, 'Заливка');
9:begin
OutTextXY(mop_x+12, mop_y+10, 'вiд');
OutTextXY(mop_x+30, mop_y+10, 'крити');
end;
10:OutTextXY(mop_x+12, mop_y+10, 'Зберегти');
end;
end;
end;
end
else begin
if(((mouse_x >= o_x+20)or(mouse_x <= o_x)
or(mouse_y <= o_y)or(mouse_y >= o_y+20+25*(lim-1)))
and(dos_11 <> True))then begin
dos_11:=True;
open_mblocks(mop_x+10, mop_y+10);
end;
end;
if((((key_mouse = True)and(mouse_x >= o_x)and(mouse_x <= o_x+20)and
(mouse_y >= o_y)and(o_y+25*lim >= mouse_y))or(zx = True)))then begin
if(zx <> True)then open_mblocks(mop_x+10, mop_y+10);
naw_color(color);
for i:=lin to lim do begin
off_mouse;
tol:=8;
while(o_y+25*i >= mouse_y)and(mouse_y <= o_y+20+25*i)and
(mouse_x >= o_x)and(mouse_x <= o_x+20)and(key_mouse = True)
and(on_k = True)do begin
oper:=i-1;
while(key_mouse = True)do tol:=white;
end;
SetColor(tol);
Rectangle(o_x, o_y+25*(i-1), o_x+20, o_y+20+25*(i-1));
SetFillStyle(1, tol);
FloodFill(o_x+20-1, o_y+20+25*(i-1)-1, tol);
SetColor(3);
if(zx <> True)then save_mblocks(mop_x+10, mop_y+10, mop_x+70, mop_y+20);
case i of
1:begin
rectangle(o_x+6, o_y+3+25*(i-1), o_x+14, o_y+17+25*(i-1));
line(o_x+10, o_y+3+25*(i-1), o_x+14, o_y+10+25*(i-1));
end;
2:begin
line(o_x+5, o_y+10+25*(i-1), o_x+14, o_y+10+25*(i-1));
line(o_x+5, o_y+10+25*(i-1), o_x+10, o_y+5+25*(i-1));
line(o_x+5, o_y+10+25*(i-1), o_x+10, o_y+15+25*(i-1));
end;
3:begin
Circle(o_x+10, o_y+10+25*(i-1), 7);
end;
4:begin
line(o_x+15, o_y+5+25*(i-1), o_x+5, o_y+15+25*(i-1));
end;
5:begin
rectangle(o_x+5, o_y+5+25*(i-1), o_x+15, o_y+15+25*(i-1));
end;
6:begin
dos_5:=False;
rectangle(o_x+7, o_y+5+25*(i-1), o_x+13, o_y+12+25*(i-1));
line(o_x+13, o_y+12+25*(i-1), o_x+10, o_y+17+25*(i-1));
line(o_x+10, o_y+17+25*(i-1), o_x+7, o_y+12+25*(i-1));
end;
7:begin
dos_5:=False;
rectangle(o_x+5, o_y+10+25*(i-1), o_x+13, o_y+15+25*(i-1));
line(o_x+5, o_y+10+25*(i-1), o_x+10, o_y+5+25*(i-1));
line(o_x+13, o_y+10+25*(i-1), o_x+18, o_y+5+25*(i-1));
line(o_x+10, o_y+5+25*(i-1), o_x+18, o_y+5+25*(i-1));
line(o_x+13, o_y+15+25*(i-1), o_x+18, o_y+10+25*(i-1));
line(o_x+18, o_y+10+25*(i-1), o_x+18, o_y+5+25*(i-1));
end;
8:begin
rectangle(o_x+4, o_y+7+25*(i-1), o_x+12, o_y+15+25*(i-1));
line(o_x+8, o_y+3+25*(i-1), o_x+8, o_y+7+25*(i-1));
arc(o_x+12, o_y+10+25*(i-1), 350, 90, 3);
arc(o_x+12, o_y+10+25*(i-1), 180, 350, 3);
end;
9:begin
rectangle(o_x+6, o_y+16+25*(i-1), o_x+14, o_y+4+25*(i-1));
line(o_x+6, o_y+4+25*(i-1), o_x+11, o_y+9+25*(i-1));
line(o_x+11, o_y+9+25*(i-1), o_x+11, o_y+15+25*(i-1));
end;
10:begin
rectangle(o_x+6, o_y+16+25*(i-1), o_x+14, o_y+4+25*(i-1));
rectangle(o_x+8, o_y+16+25*(i-1), o_x+12, o_y+10+25*(i-1));
end;
end;
on_mouse;
if(KeyPressed = True)then begin
key_prs:=readkey;
break;
end;
end;
off_mouse;
SetColor(red);
rectangle(30, 439, 331, 461);
on_mouse;
end;
end;
procedure window(w_x, w_y, w_x_, w_y_, w_col:integer);
begin
off_mouse;
SetColor(w_col);
Rectangle(w_x, w_y, w_x_, w_y_);
SetFillStyle(1, w_col);
FloodFill(w_x+1, w_y+1, w_col);
on_mouse;
end;
procedure button(p_x, p_y, p_x_, p_y_, col_p:integer;p_text:string);
begin
SetColor(col_p);
Rectangle(p_x, p_y, p_x_, p_y_);
SetFillStyle(1, col_p);
FloodFill(p_x+1, p_y+1, col_p);
SetColor(6);
SetTextStyle(2, 0, 4);
OutTextXY(p_x+5, p_y, p_text);
SetColor(8);
Rectangle(p_x, p_y, p_x_, p_y_);
end;
procedure about;
var ab_lim, ab_lim_, cases:byte;
begin
save_blocks;
ab_lim:=1;
key_prs:='';
dos_9:=False;
ab_lim:=1;
cases:=4;
repeat
if(dos_9 <> True)then begin
dos_9:=True;
off_mouse;
window(150, 100, 500, 350, 9);
SetTextStyle(2, 0, 4);
button(370, 110, 490, 120, 7, 'F1 або ESC - вихiд');
button(390, 130, 490, 140, 7, 'Page Up - вгору');
button(390, 305, 495, 315, 7, 'Page Down - вниз');
SetColor(red);
SetTextStyle(1, 0, 2);
OutTextXY(270, 120, 'P A I N T');
if(ab_lim <> ab_lim_)then begin
ab_lim_:=ab_lim;
del_grp(150, 150, 500, 300, 9);
SetColor(red);
SetTextStyle(2, 0, 4);
del_grp(440, 320, 485, 330, 9);
str(ab_lim, text_);
OutTextXY(445, 320, text_);
OutTextXY(460, 320, '/');
str(cases, text_);
OutTextXY(470, 320, text_);
end;
case ab_lim of
1:begin
OutTextXY(170, 150, 'Paint - графiчний ред');OutTextXY(293, 150, 'актор, який розробленний на мовi');
OutTextXY(170, 170, 'Pascal. В лiвому меню можна обрати операцs.');
OutTextXY(170, 190, 'Программа зберiгае картинку в .BMP форматi');
OutTextXY(170, 210, 'А в нижньому кутку можна обрати колiр.');
end;
2:begin
menu_oper(True, False, 1, 4, 160, 160);
OutTextXY(185, 165, '- Новий файл');
OutTextXY(185, 190, '- повернутися назад');
OutTextXY(185, 215, '- круг');
OutTextXY(185, 240, '- вiд');OutTextXY(215, 240, 'рiзки');
end;
3:begin
menu_oper(True, False, 5, 8, 160, 60);
OutTextXY(185, 165, '- прямокутник');
OutTextXY(185, 190, '- олiвець');
OutTextXY(185, 215, '- гумка');
OutTextXY(185, 240, '- заливка');
end;
4:begin
menu_oper(True, False, 9, 10, 160, -40);
OutTextXY(185, 165, '- вiд');OutTextXY(215, 165, 'крити файл');
OutTextXY(185, 190, '- зберегть в файл');
end;
end;
SetTextStyle(2, 0, 5);
OutTextXY(170, 300, 'Автор:Малишев Дмитро');
OutTextXY(170, 315, 'Група:РПЗ-21');
OutTextXY(170, 330, '2010 рiк');
on_mouse;
end;
if((key_mouse = True)and(mouse_x >= 380)and(mouse_x <= 490)
and(mouse_y >= 110)and(mouse_y <= 120))then begin
off_mouse;
button(370, 110, 490, 120, 15, 'F1 або ESC - вихiд');
sleep_mouse;
key_prs:=F1;
on_mouse;
end;
if(KeyPressed = True)then key_prs:=readkey;
if(((key_prs = PageUp))or((mouse_x >= 390)and(mouse_x <= 490)
and(mouse_y >= 130)and(mouse_y <= 140)and(key_mouse = True)))then begin
dos_9:=False;
off_mouse;
button(390, 130, 490, 140, 15, 'Page Up - вгору');
sleep_mouse;
on_mouse;
ab_lim:=ab_lim - 1;
if(ab_lim <= 0)then ab_lim:=cases;
key_prs:='';
end;
if((key_prs = PageDown)or((mouse_x >= 390)and(mouse_x <= 495)
and(mouse_y >= 305)and(mouse_y <= 315)and(key_mouse = True)))then begin
dos_9:=False;
off_mouse;
button(390, 305, 495, 315, 15, 'Page Down - вниз');
sleep_mouse;
ab_lim:=ab_lim + 1;
if(ab_lim > cases)then ab_lim:=1;
on_mouse;
key_prs:='';
end;
until ((key_prs = F1)or(key_prs = ESC));
key_prs:='';
open_blocks;
end;
const rub:array[0..3] of PointType=(
(x:50;y:435),
(x:80;y:435),
(x:80;y:405),
(x:50;y:435));
var vol_x, vol_x_:integer;
procedure menu_vol;
begin
if(dos_5 <> True)then begin
size_cur:=15;
dos_5:=True;
vol_x_:=80;
SetColor(8);
DrawPoly(4, rub);
SetFillStyle(1, 8);
FloodFill(70, 430, 8);
SetColor(red);
line(vol_x_, 435, vol_x_, 405);
SetTextStyle(1, 0, 1);
OutTextXY(90, 410, 'Встановiть дiаметр кола');
end;
while(key_mouse = True)and(mouse_y >= 405)and(mouse_y <= 435)
and(mouse_x >= 50)and(mouse_x <= 80)do begin vol_x:=mouse_x;
if(vol_x <> vol_x_)then begin
off_mouse;
SetColor(8);
if(vol_x > vol_x_)then line(vol_x_, 435, vol_x_, 405-vol_x+80+vol_x-vol_x_)
else line(vol_x_, 435, vol_x_, 405-vol_x+80-vol_x_+vol_x);
if((key_mouse = True)and(mouse_y >= 405)and(mouse_y <= 435)
and(mouse_x >= 50)and(mouse_x <= 80))then begin
vol_x_:=vol_x;
SetColor(red);
line(vol_x_, 435, vol_x_, 405-mouse_x+80);
end;
on_mouse;
end;
size_cur:=(435 - (405-mouse_x+80)+1) div 2;
end;
end;
procedure up_bar;
begin
if(mouse_x >= 40)and(mouse_x <= 180)and
(mouse_y >= 20)and(mouse_y <= 40)and(key_mouse = True)then begin
off_mouse;
out_text(15, 7);
sleep_mouse;
out_text(7, 7);
key_prs:=esc;
end;
if(key_prs = F1)or((mouse_x >= 40)and(mouse_x <= 180)
and(mouse_y >= 0)and(mouse_y <= 20)and(key_mouse = True))then begin
off_mouse;
out_text(7, 15);
sleep_mouse;
out_text(7, 7);
open_mblocks(mop_x+10, mop_y+10);
on_mouse;
about;
end;
end;
procedure button_f(p_x, p_y, p_x_, p_y_, col_p:integer;p_text:string);
begin
SetColor(col_p);
Rectangle(p_x, p_y, p_x_, p_y_);
SetFillStyle(1, col_p);
FloodFill(p_x+1, p_y+1, col_p);
SetColor(red);
SetTextStyle(1, 0, 1);
OutTextXY(p_x+5, p_y, p_text);
SetColor(8);
Rectangle(p_x, p_y, p_x_, p_y_);
end;
procedure curlop(cur_nal, cur_kon, cur_col, cur_col_:integer);
var cur_nal_, cur_kon_:real;
int_a, int_d:integer;
int_b, int_c:real;
begin
off_mouse;
SetColor(green);
Rectangle(scr_x+x-120, scr_y+60, scr_x+x-100, scr_y+y-20);
SetFillStyle(1, green);
FloodFill(scr_x+x-120+1, scr_y+60+1, green);
SetColor(7);
Rectangle(scr_x+x-120, scr_y+60, scr_x+x-100, scr_y+80);
SetFillStyle(1, 7);
FloodFill(scr_x+x-120+1, scr_y+60+1, 7);
SetColor(cur_col);
Line(scr_x+x-115, scr_y+75, scr_x+x-105, scr_y+75);
Line(scr_x+x-115, scr_y+75, scr_x+x-110, scr_y+65);
Line(scr_x+x-110, scr_y+65, scr_x+x-105, scr_y+75);
SetFillStyle(1, cur_col);
FloodFill(scr_x+x-110, scr_y+70, cur_col);
SetColor(7);
Rectangle(scr_x+x-120, scr_y+310, scr_x+x-100, scr_y+330);
SetFillStyle(1, 7);
FloodFill(scr_x+x-120+1, scr_y+310+1, 7);
SetColor(cur_col_);
Line(scr_x+x-115, scr_y+315, scr_x+x-105, scr_y+315);
Line(scr_x+x-115, scr_y+315, scr_x+x-110, scr_y+325);
Line(scr_x+x-110, scr_y+325, scr_x+x-105, scr_y+315);
SetFillStyle(1, cur_col_);
FloodFill(scr_x+x-110+1, scr_y+315+1, cur_col_);
cur_nal_:=cur_nal;
cur_kon_:=cur_kon;
cur_nal_:=((100 / cur_nal_)*cur_kon_)*2;
int_c:=cur_nal_;
int_a:=0;
int_d:=0;
while int_d<>1 do begin
if(int_b < int_c)then begin
int_a:=int_a + 1;
int_b:=int_b + 1;
end
else begin
int_d:=1;
end;
end;
cur_nal:=int_a;
SetColor(green);
Rectangle(cur_x, cur_y, cur_x+20, cur_y+20);
SetFillStyle(1, green);
FloodFill(cur_x+1, cur_y+1, green);
cur_x:=scr_x+x-120;
cur_y:=scr_y+80+cur_nal;
SetColor(7);
Rectangle(scr_x+x-120, scr_y+80+cur_nal, scr_x+x-100, scr_y+100+cur_nal);
SetFillStyle(1, 7);
FloodFill(scr_x+x-120+1, scr_y+80+cur_nal+1, 7);
on_mouse;
end;
var d_x_f, d_y_f:integer;
procedure cnf_delete_f(x1, y1, x2, y2:integer);
begin
freemem(img, size); {звильнення кеша img}
size:=imagesize(x1, y1, x2, y2);
getmem(img, size);
getimage(x1, y1, x2, y2, img^);
d_x_f:=x1;
d_y_f:=y1;
end;
procedure delete_f;
begin
putimage(d_x_f, d_y_f, img^, xorput);
end;
procedure out_disk(dk_x, dk_y:integer);
var ad:char;
col_disk:integer;
disk, disk_:string;
chr:searchrec;
begin
col_disk:=0;
delete(disk, 1, 255);
for ad:='A' to 'Z' do begin
col_disk:=col_disk + 1;
if(diskfree(col_disk) >= 0)then begin
insert(ad, disk, 1);
end;
end;
SetColor(red);
OutTextXY(555, 160, 'Диск');
GetDir(0, disk_);
for i:=1 to length(disk)do begin
off_mouse;
if((dk_x >= 575)and(dk_x <= 595)and(dk_y >= 160+(25*i))and(dk_y <= 180+(25*i)))then begin
button_f(575, 160+(25*i), 595, 180+(25*i), 15, disk[i]);
sleep_mouse;
delete(disk_, 1, 255);
insert(disk[i], disk_, 1);
insert(':\', disk_, 2);
ChDir(disk_);
for i_:=1 to length(disk)do begin
if(disk_[1] = disk[i_])then button_f(575, 160+(25*i_), 595, 180+(25*i_), 2, disk[i_])
else button_f(575, 160+(25*i_), 595, 180+(25*i_), 7, disk[i_]);
end;
end;
GetDir(0, disk_);
if(disk_[1] = disk[i])then button_f(575, 160+(25*i), 595, 180+(25*i), 2, disk[i])
else button_f(575, 160+(25*i), 595, 180+(25*i), 7, disk[i]);
end;
end;
procedure up_fil(uf_col:integer);
begin
SetColor(uf_col);
Rectangle(scr_x+x-19, scr_y+20, scr_x+x-1, scr_y+50);
SetFillStyle(1, uf_col);
FloodFill(scr_x+x-19+1, scr_y+20+1, uf_col);
SetColor(8);
Line(scr_x+x-10, scr_y+45, scr_x+x-10, scr_y+30);
Line(scr_x+x-10, scr_y+30, scr_x+x-15, scr_y+35);
Line(scr_x+x-10, scr_y+30, scr_x+x-5, scr_y+35);
end;
function case_color(cc:integer):integer;
begin
case cc of
0:case_color:=0;
1:case_color:=12;
2:case_color:=2;
3:case_color:=6;
4:case_color:=1;
5:case_color:=5;
6:case_color:=3;
7:case_color:=8;
8:case_color:=7;
9:case_color:=4;
10:case_color:=10;
11:case_color:=14;
12:case_color:=9;
13:case_color:=13;
14:case_color:=11;
15:case_color:=15;
end;
end;
procedure save_proc(spr:string);
var fi:text;
cnf:string;
buf_w, buf_w_:integer;
sbuf_1:boolean;
begin
off_mouse;
for i:=1 to 118 do begin
cnf[i]:=chr($00);
case i of
1:cnf[i]:=chr($42);
2:cnf[i]:=chr($4D);
3:cnf[i]:=chr($CE);
4:cnf[i]:=chr($79);
5:cnf[i]:=chr($01);
11:cnf[i]:=chr($76);
15:cnf[i]:=chr($28);
19:cnf[i]:=chr($26);
20:cnf[i]:=chr($02);
23:cnf[i]:=chr($5E);
24:cnf[i]:=chr($01);
27:cnf[i]:=chr($01);
29:cnf[i]:=chr($04);
35:cnf[i]:=chr($58);
36:cnf[i]:=chr($79);
37:cnf[i]:=chr($01);
39:cnf[i]:=chr($C4);
40:cnf[i]:=chr($0E);
43:cnf[i]:=chr($C4);
44:cnf[i]:=chr($0E);
61, 64, 68, 69, 71, 75, 77, 79, 80, 83, 84, 85:cnf[i]:=chr($80);
87, 88, 89:cnf[i]:=chr($C0);
93, 96, 100, 101, 103, 107, 109, 111, 112, 115, 116, 117:cnf[i]:=chr($FF);
end;
end;
sbuf_1:=False;
open_blocks;
Assign(fi, spr);
{$I-}rewrite(fi);{$I+}
for i:=1 to 120 do begin
write(fi, cnf[i]);
end;
for i_:=scr_y+y downto scr_y do begin
for i:=scr_x to scr_x+x+1 do begin
if(sbuf_1 <> True)then begin
sbuf_1:=True;
buf_w:=(case_color(getpixel(i+5, i_)) * $10)+case_color(getpixel(i+6, i_));
write(fi, chr(buf_w));
end
else begin
sbuf_1:=False;
end;
end;
end;
close(fi);
on_mouse;
end;
procedure error_bmp(ach, eror:integer);
begin
if((((ach = 1)and(eror <> $42))
or((ach = 2)and(eror <> $4D)))and(dos_13 <> True))then begin
dos_12:=True;
dos_13:=True;
window(200, 150, 450, 200, red);
SetColor(9);
OutTextXY(210, 170, 'Файл не BMP формат');
readkey;
open_blocks;
end;
if(((ach = 29)and(eror <> $04))and(dos_13 <> True))then begin
dos_12:=True;
dos_13:=True;
window(180, 150, 470, 200, red);
SetColor(9);
OutTextXY(190, 170, 'Картинка не 16-кольорова');
readkey;
open_blocks;
end;
end;
procedure open_proc(opr:string);
var fi:text;
xxx:char;
l_b, r_b:integer;
mbuf_1:longint;
a1, a2, a3, a4, im_x, im_y:longint;
begin
open_blocks;
Assign(fi, opr);
{$I-}reset(fi);{$I+}
for i:=1 to $13 do begin
read(fi, xxx);
error_bmp(i, ord(xxx));
end;
if(dos_12 <> True)then begin
a1:=ord(xxx);
read(fi, xxx);
a2:=ord(xxx);
read(fi, xxx);
a3:=ord(xxx);
read(fi, xxx);
a4:=ord(xxx);
a4:=a4 * $1000000;
a3:=a3 * $10000;
a2:=a2 * $100;
im_x:=a1+a2+a3+a4; {шырына изображения}
read(fi, xxx);
a1:=ord(xxx);
read(fi, xxx);
a2:=ord(xxx);
read(fi, xxx);
a3:=ord(xxx);
read(fi, xxx);
a4:=ord(xxx);
a4:=a4 * $1000000;
a3:=a3 * $10000;
a2:=a2 * $100;
im_y:=a1+a2+a3+a4; {высота изображения}
mbuf_1:=0;
repeat
mbuf_1:=mbuf_1 + 8;
until mbuf_1 >= im_x;
writeln;
for i:=1 + 26 to 119 - $1B + 26 do begin
read(fi, xxx);
error_bmp(i, ord(xxx));
end;
if(im_y > y)then im_y:=y;
if(dos_13 <> True)then begin
for i_:=im_y downto 1 do begin
for i:=1 to mbuf_1 div 2 do begin
read(fi, xxx);
if(i > (x div 2))then continue;
l_b:=ord(xxx) div $10; {лива частына байта}
putpixel(scr_x+(i*2)-1, scr_y+i_, case_color(l_b));
r_b:=ord(xxx) mod $10; {права частына байта}
putpixel(scr_x+(i*2), scr_y+i_, case_color(r_b));
end;
end;
close(fi);
save_blocks;
end
else close(fi);
end
else close(fi);
end;
procedure Fil_op(txt:boolean);
var srh:SearchRec;
fil_col, fil_y, fil_cof, f_x, f_y,
koli, koli_, fil_con, col_name:integer;
fdos_1, fdos_2, fdos_3, fdos_4, fdos_5,
fdos_6, fdos_7, fdos_8, fdos_9, fdos_10, fdos_11:boolean;
buf_fil, put_str, buf_name:string;
f:file;
attr, attr_:byte;
begin
repeat
open_mblocks(mop_x+10, mop_y+10);
getdir(0, dir);
dos_13:=False;
off_mouse;
save_blocks;
del_grp(scr_x+1, scr_y+1, scr_x+x-1, scr_y+y-1, 3);
cur_x:=scr_x+x-120; {начальное положение ползунка}
cur_y:=scr_y+80;
fil_col:=0;
SetTextStyle(1, 0, 1);
window(scr_x+1, scr_y+1, scr_x+x-1, scr_y+y-1, 3);
SetColor(11);
Rectangle(scr_x+20, scr_y+20, scr_x+x-20, scr_y+50);
SetFillStyle(1, 11);
FloodFill(scr_x+21, scr_y+21, 11);
SetColor(red);
SetColor(11);
Rectangle(scr_x+20, scr_y+60, scr_x+x-100, scr_y+y-20);
SetFillStyle(1, 11);
FloodFill(scr_x+21, scr_y+61, 11);
Button_f(505, 110, 595, 130, 7, 'Вiдкрит.');
if(txt = True)then Button_f(505, 140, 595, 160, 7, 'Зберегт.');
Button_f(505, 330, 595, 350, 7, 'Закрить');
Button_f(505, 360, 595, 380, 7, 'Стерти');
fdos_1:=True;
fdos_2:=False;
fil_cof:=0;
FindFirst(type_file, AnyFile, srh);
koli:=0;
koli_:=0;
while DosError = 0 do begin
with srh do koli:=koli + 1;
FindNext(srh);
end;
curlop(koli, koli_, 8, 8);
fdos_5:=True;
fdos_6:=True; {достеп для обновление диска}
fdos_7:=True; {первоначальний показ дисков}
fdos_8:=True; {показа вверх}
fdos_9:=False; {доступ до кнопки зберегти}
fdos_10:=False;{достеп к зберегти}
dos_12:=False;
up_fil(green);
repeat
up_bar;
SetTextStyle(1, 0, 1);
GetDir(0, text_);
SetColor(red);
if(fdos_5 = True)then begin
fdos_5:=False;
cnf_delete_f(scr_x+20, scr_y+20, scr_x+x-20, scr_y+50);
delete_f;
SetColor(11);
SetFillStyle(1, 11);
Rectangle(scr_x+20, scr_y+20, scr_x+x-20, scr_y+50);
FloodFill(scr_x+21, scr_y+21, 11);
SetColor(red);
OutTextXY(scr_x+30, scr_y+25, text_);
end;
fil_y:=60;
fil_col:=0; {----------кнопки---------}
if((f_x >= 505)and(f_x <= 595)and(f_y >= 360)and(f_y <= 380)and(fdos_2 = True))then begin
fdos_1:=True; {------удалiть-----}
fdos_2:=False;
off_mouse;
assign(f, buf_fil);
{$I-}reset(f);{$I-}
if(IoResult <> 0)then begin end
else erase(f);
Button_f(505, 360, 595, 380, 15, 'Стерти');
sleep_mouse;
Button_f(505, 360, 595, 380, 7, 'Стерти');
on_mouse;
end;
if((f_x >= 505)and(f_x <= 595)and(f_y >= 330)and(f_y <= 350)and(fdos_2 = True))then begin
off_mouse;
Button_f(505, 330, 595, 350, 15, 'Закрить');
sleep_mouse;
Button_f(505, 330, 595, 350, 7, 'Закрить');
on_mouse;
key_prs:=esc;
end;
if((f_x >= 505)and(f_x <= 595)and(f_y >= 110)and(f_y <= 130)and(fdos_2 = True))then begin
fdos_1:=True; {-------вiдкрити---------}
fdos_2:=False;
fdos_5:=True; {для обновение тукущего поля...}
off_mouse;
fil_con:=0;
FindFirst(type_file, AnyFile, srh); {знаходимо який по щчёту файл чи папка}
while((text_ <> buf_fil)and(DosError = 0))do begin
with srh do begin
text_:=name;
fil_con:=fil_con + 1;
end;
FindNext(srh);
end;
FindFirst(type_file, AnyFile, srh);
while(DosError = 0)do begin {определяемо тып файла}
for i:=2 to fil_con do FindNext(srh);
with srh do begin
assign(f, name);
setfattr(f, attr);
attr_:=attr;
break;
end;
end;
if(attr_ = Directory)then begin
if(buf_fil <> '.')then begin
GetDir(0, put_str);
if(put_str[length(put_str)] <> '\')then insert('\', put_str, length(put_str)+1);
insert(buf_fil, put_str, length(put_str)+1);
ChDir(put_str);
end
else begin
GetDir(0, put_str);
delete(put_str, 4, 255);
ChDir(put_str);
end;
koli_:=0;
curlop(koli, koli_, 8, 8);
sleep_mouse;
fdos_1:=True;
fdos_4:=True;
fil_cof:=0; {збиваем щчётчик просмотра...}
end
else begin
if(pos('.BMP', buf_fil) <> 0)then begin
off_mouse;
Button_f(505, 110, 595, 130, 15, 'Вiдкрит.');
sleep_mouse;
Button_f(505, 110, 595, 130, 7, 'Вiдкрит.');
open_proc(buf_fil);
break;
on_mouse;
end;
end;
Button_f(505, 110, 595, 130, 15, 'Вiдкрит.');
sleep_mouse;
Button_f(505, 110, 595, 130, 7, 'Вiдкрит.');
on_mouse;
end;
FindFirst(type_file, AnyFile, srh);
fdos_3:=False;
on_mouse;
while (DosError = 0) do begin
with srh do begin
if(fdos_3 <> True)then begin
fdos_3:=True;
for i:=1 to fil_cof do FindNext(srh);
end;
if(((fdos_1 = True))or((fdos_2 = True)))then begin
off_mouse;
cnf_delete_f(scr_x+20, scr_y+fil_y, scr_x+x-125, scr_y+fil_y+20);
delete_f;
SetColor(11);
SetFillStyle(1, 11);
Rectangle(scr_x+20, scr_y+fil_y, scr_x+x-125, scr_y+fil_y+20);
FloodFill(scr_x+20+1, scr_y+fil_y+1, 11);
SetColor(red);
Assign(f, name);
SetFAttr(f, attr);
OutTextXY(scr_x+25, scr_y+fil_y, name);
if(attr = Directory)then begin
SetColor(8);
OutTextXY(scr_x+25+340, scr_y+fil_y, 'Папка');
end
else begin
SetColor(8);
OutTextXY(scr_x+25+350, scr_y+fil_y, 'Файл');
end;
on_mouse;
if((f_x >= scr_x+25)and(f_x <= scr_x+x-125)and(fdos_2 = True)
and(f_y >= scr_y+fil_y)and(f_y <= scr_y+fil_y+20))then begin
fdos_2:=False;
off_mouse;
SetColor(blue);
Rectangle(scr_x+20, scr_y+fil_y, scr_x+x-125, scr_y+fil_y+20);
SetFillStyle(1, 1);
FloodFill(scr_x+21, scr_y+fil_y+1, 1);
SetColor(red);
OutTextXY(scr_x+25, scr_y+fil_y, name);
Assign(f, name);
SetFAttr(f, attr);
OutTextXY(scr_x+25, scr_y+fil_y, name);
if(attr = Directory)then begin
SetColor(8);
OutTextXY(scr_x+25+340, scr_y+fil_y, 'Папка');
end
else begin
SetColor(8);
OutTextXY(scr_x+25+350, scr_y+fil_y, 'Файл');
end;
on_mouse;
buf_fil:=name;
end;
fil_y:=fil_y + 30;
end;
fil_col:=fil_col + 1;
end;
FindNext(srh);
if(((fil_col >= 9)or(DosError <> 0))and(fdos_1 = True))then begin
del_grp(scr_x+20, scr_y+fil_y, scr_x+x-125, scr_y+y-20, 11);
fdos_1:=False;
fdos_2:=False;
fil_col:=0;
break;
end;
end;
if(Key_Mouse = True)then begin
f_x:=mouse_x;
f_y:=mouse_y;
fdos_1:=True;
fdos_2:=True;
fdos_6:=True;
fdos_8:=True;
fdos_9:=True;
end;
if((txt = True)and(fdos_9 = True)and(f_x >= 505)and(f_x <= 595)
and(f_y >= 140)and(f_y <= 160))then begin
fdos_9:=False;
fdos_10:=True;
off_Mouse;
Button_f(505, 140, 595, 160, 15, 'Зберегт.');
sleep_mouse;
Button_f(505, 140, 595, 160, 7, 'Зберегт.');
on_mouse;
delete(buf_name, 1, 255);
fdos_11:=True;
col_name:=0;
buf_name:='.BMP';
repeat
if(fdos_11 = True)then begin
off_mouse;
fdos_11:=False;
window(200, 150, 400, 250, 9);
SetColor(red);
cnf_delete_f(220, 210, 380, 230);
delete_f;
window(220, 210, 380, 230, 7);
SetColor(red);
OutTextXY(225, 210, buf_name);
button_f(250, 170, 350, 190, 7, 'Зберегти');
on_mouse;
end;
if((mouse_x >= 250)and(mouse_x <= 350)and(Key_Mouse = True)
and(mouse_y >= 170)and(mouse_y <= 190)and(col_name > 0))then begin
off_mouse;
button_f(250, 170, 350, 190, 15, 'Зберегти');
sleep_mouse;
button_f(250, 170, 350, 190, 7, 'Зберегти');
key_prs:=enter;
on_mouse;
break;
end;
if(KeyPressed = True)then begin
fdos_11:=True;
key_prs:=readkey;
if(key_prs = BackSpace)then begin
if(col_name > 0)then begin
delete(buf_name, col_name, 255);
insert('.BMP', buf_name, col_name);
col_name:=col_name - 1;
end;
end;
if(((col_name <= 8)and(key_prs <> BackSpace))
and(((key_prs >= #65)and(key_prs <= #90)) {A - Z}
or((key_prs >= #97)and(key_prs <= #122))
or((key_prs >= #48)and(key_prs <= #57)))
)then begin
col_name:=col_name + 1;
insert(key_prs, buf_name, col_name);
end;
end;
until ((key_prs = enter)and(col_name > 0));
key_prs:=esc;
end;
if((fdos_8 = True)and(f_x >= scr_x+x-19)and(f_x <= scr_x+x-1)
and(f_y >= scr_y+20)and(f_y <= scr_y+50))then begin
fdos_8:=False;
fdos_5:=True;
up_fil(15);
sleep_mouse;
ChDir('..');
fil_cof:=0;
koli_:=0;
curlop(koli, koli_, 8, 8);
up_fil(green);
end;
if(KeyPressed = True)then key_prs:=readkey;
if((key_prs = PageDown)or((f_x >= scr_x+x-120)and(f_x <= scr_x+x-100)
and(f_y >= scr_y+310)and(f_y <= scr_y+330)and(Key_Mouse = True)))then begin
if(koli > koli_+9)then begin
koli_:=koli_ + 9;
FindFirst(type_file, AnyFile, srh);
koli:=0;
while DosError = 0 do begin
with srh do koli:=koli + 1;
FindNext(srh);
end;
fil_cof:=fil_cof + 9;
curlop(koli, koli_, 8, 15);
sleep_mouse;
fdos_1:=True;
fdos_4:=True;
fil_y:=60;
end
else begin
curlop(koli, koli, 8, 15);
sleep_mouse;
curlop(koli, koli, 8, 8);
end;
key_prs:='';
end;
if((key_prs = PageUp)or((f_x >= scr_x+x-120)and(f_x <= scr_x+x-100)
and(f_y >= scr_y+60)and(f_y <= scr_y+80)and(Key_Mouse = True)))then begin
if(fil_cof > 0)then begin
koli_:=koli_ - 9;
fil_cof:=fil_cof - 9;
curlop(koli, koli_, 15, 8);
sleep_mouse;
fdos_1:=True;
fdos_4:=True;
fil_y:=60;
end;
key_prs:='';
end;
if(((fdos_6 = True)and(f_x >= 575)and(f_x <= 595)and(f_y >= 185))or(fdos_7 = True))then begin
fdos_7:=False;
fdos_6:=False;
fdos_5:=True;
out_disk(f_x, f_y);
end;
if(fdos_4 = True)then begin
fdos_4:=False;
curlop(koli, koli_, 8, 8);
end;
until key_prs = esc;
until dos_12 <> True;
if((txt = True)and(fdos_10 = True))then save_proc(buf_name);
chdir(dir); {возвращаем текущий каталог}
key_prs:='';
open_blocks;
end;
begin
config_graph;
SetBkColor(0);
SetColor(fon_clr);
Rectangle(scr_x, scr_y, scr_x+x+60, scr_y+y+50);
SetFillStyle(1, fon_clr);
FloodFill(scr_x+2, scr_y+2, fon_clr);
mouse_x_:=mouse_x;
color:=0;
oper:=99;
scr_x:=50;
scr_y:=50;
size_cur:=15;
dos_4:=False;
stena;
menu_oper(True, True, 1, 10, 20, 50);
menu_color(True);
out_text(7, 7);
save_blocks;
while key_prs <> esc do begin
on_mouse;
krd_mouse;
menu_oper(False, True, 1, 10, 20, 50);
menu_color(False);
Drow;
if(KeyPressed = True)then key_prs:=readkey;
up_bar;
end;
closegraph;
end.
Додаток B