Прикладная программа «MyPaint»

                  memo1.Font.Color:=bcol;   //задать цветом шрифта цвет фона

                  form1.memo1.Left:=x;

                  form1.memo1.Top:=y;

                  form1.memo1.Show;   //открыть поле для ввода текста

                  func:=100;

                 end;

    100        : begin

                  Memo1.Hide;   //скрываем поле для ввода текста

                  image.Canvas.Font:=memo1.Font;

                  count:=form1.Memo1.Lines.Count;  //количество строк, введенных в поле Memo

                  for i:=0 to count do   //цикл ввода текста

                   image.canvas.TextOut(memo1.Left-Image.Left,memo1.Top+i*memo1.Font.Size*2-image.Top,memo1.Lines[i]);

                 end;

    funcbezier : begin    //функция рисования кривой

                  but:=[ssright];   //нажата правая кнопка мыши

                  if nump<>0 then

                   begin

                    bezier(stx,sty,bcol);

                   end;

                  inc(nump);

                  if nump>4 then nump:=0;

                  bezier(x,y,bcol);

                  stx:=x;sty:=y;

                 end;

    funcpolygon : begin    //функция рисования многоугольника

                   inc(nump);

                   polygn(x,y,bcol);

                  end;

 

   end;

 

 

end;

 

 

 

procedure TForm1.FormCreate(Sender: TObject);

begin

 

memo1.Hide;    //скрыть поле для ввода текста

eraser:=3;

openpicturedialog1.FilterIndex:=4;  //номер фильтра для диалога Открыть

openpicturedialog1.InitialDir:=extractfilepath(paramstr(0));   //начальный каталог //для Открыть

savepicturedialog1.InitialDir:=extractfilepath(paramstr(0));   //начальный каталог //для Сохранить

 

 panhide;

Image:=form1.image1;

 wid:=image.Width;

 het:=image.Height;

image.Canvas.Pen.Mode:= pmcopy;

form1.Label2.Color:=colorgrid1.ForegroundColor;   //загрузить в Label2

//цвет рисования

form1.Label1.Color:=colorgrid1.BackgroundColor;   //загрузить в Label1

//цвет фона

 bcol:=clwhite;   //цветом фона назаначить белый

 

//задание ширины элемента  палитры цветов

Image.Canvas.FillRect(rect(0,0,image1.Width,image1.Height));

end;

 

procedure TForm1.SpeedButton5Click(Sender: TObject);

begin

func:=funcpencil;   //при нажатии кнопки реализуем

//функцию рисования карандашом

panhide;   //скрыть панель выбора толщины

setprop;   //добавляет или изменяет элемент

end;

 

procedure TForm1.SpeedButton2Click(Sender: TObject);

begin

func:=funcfill;   //при нажатии кнопки реализуем функцию заливки

panhide;

setprop;

end;

 

procedure TForm1.SpeedButton3Click(Sender: TObject);

begin

func:=funcgetcol;  //при нажатии  кнопки реализуем функцию индикатор  цвета

panhide;

setprop;

end;

 

procedure TForm1.SpeedButton9Click(Sender: TObject);

begin

func:=funcline;    //при нажатии кнопки реализуем функцию

//рисования прямой линии

image.Canvas.Pen.Mode:= pmnotXOR;

panhide;

setprop;

end;

 

procedure TForm1.N21Click(Sender: TObject);    //выход из программы

begin

application.Terminate;

end;

 

//заполнение окон основного  и вспомогательного цветов

procedure TForm1.N7Click(Sender: TObject);

begin

image.Canvas.Brush.Color:=CLWHITE;

clear;

end;

 

//процедура загрузки файла для открытия

procedure TForm1.N8Click(Sender: TObject);

begin

if openpicturedialog1.Execute then

   begin

    image.AutoSize:=true;

    image.Picture.LoadFromFile(openpicturedialog1.FileName);

   end;

end;

 

//процедура сохранения файла

procedure TForm1.N10Click(Sender: TObject);

begin

if savepicturedialog1.Execute then

   begin

    image.Picture.SaveToFile(savepicturedialog1.FileName+'.bmp');

   end;

end;

 

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

panhide;    //скрыть панель

setprop;   //добавляет или изменяет элемент

panel4.Show;    //открыть панель для выбора размера ластика

func:=funcerase;   //при нажатии кнопки реализуем функцию стирания

end;

 

procedure TForm1.Label3Click(Sender: TObject);

begin

eraser:=label3.Width div 2;  //задание ширины ластика

end;

 

procedure TForm1.Label4Click(Sender: TObject);

begin

eraser:=label4.Width div 2;  //задание ширины ластика

end;

 

procedure TForm1.Label6Click(Sender: TObject);

begin

eraser:=label6.Width div 2;   //задание ширины ластика

end;

 

procedure TForm1.Label5Click(Sender: TObject);

begin

eraser:=label5.Width div 2;   //задание ширины ластика

end;

 

//процедура отпускания  кнопки мыши в конечной точке

//и запоминание координат этой точки

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

//процедура прорисовки

image.Canvas.Pen.Mode:= pmcopy;

 if ssleft in but then

   case func of

    funcline   : line(fx,fy,stx,sty,fcol);

    funcrect   : begin

                  rectan(fx,fy,stx,sty,fcol);

                  image.Canvas.Brush.Style:=bssolid;   //стиль кисти (сплошная линия)

                  image.Canvas.Pen.Style:=pssolid;    //стиль пера (сплошная линия)

                 end;

    funcellip  : begin

                  ellips(fx,fy,stx,sty,fcol);

                  image.Canvas.Brush.Style:=bssolid;

                  image.Canvas.Pen.Style:=pssolid;

                 end;

    funcrrect  : begin

                  rrect(fx,fy,stx,sty,fcol);

                  image.Canvas.Brush.Style:=bssolid;

                  image.Canvas.Pen.Style:=pssolid;

                 end;

    funcbezier : if nump>=4 then bezier(stx,sty,fcol)

                            else image.Canvas.Pen.Mode:=pmnotXOR;

   end;

  if ssright in but then

   case func of

    funcline   : line(fx,fy,stx,sty,bcol);

    funcrect   : begin

                  rectan(fx,fy,stx,sty,bcol);

                  image.Canvas.Brush.Style:=bssolid;

                  image.Canvas.Pen.Style:=pssolid;

                 end;

    funcellip  : begin

                  ellips(fx,fy,stx,sty,bcol);

                  image.Canvas.Brush.Style:=bssolid;

                  image.Canvas.Pen.Style:=pssolid;

                 end;

    funcrrect  : begin

                  rrect(fx,fy,stx,sty,bcol);

                  image.Canvas.Brush.Style:=bssolid;

                  image.Canvas.Pen.Style:=pssolid;

                 end;

    funcbezier : if nump>=4 then bezier(stx,sty,bcol)

                            else image.Canvas.Pen.Mode:=pmnotXOR;

 

   end;

 

end;

 

procedure TForm1.SpeedButton7Click(Sender: TObject);

begin

func:=funcSpray;  //при нажатии  кнопки реализуем функцию распылителя

panhide;

setprop;

panel5.Show;   //открыть панель для выбора размера

end;

 

procedure TForm1.SpeedButton4Click(Sender: TObject);

begin

panhide;

setprop;

panel7.Show;   //открыть панель для выбора масштаба

image.Picture.SaveToFile(extractfilepath(paramstr(0))+'\tmp.bmp');

image.Stretch:=true;  //подгон рисунка под размер компонента

wid:=image.Width;

het:=image.Height;

end;

 

procedure TForm1.SpeedButton6Click(Sender: TObject);

begin

panhide;

setprop;

panel8.Show;   //открыть панель для выбора ширины кисти

func:=funcbrush;  //при нажатии  кнопки реализуем функцию рисования  кистью

end;

 

procedure TForm1.SpeedButton8Click(Sender: TObject);

begin

panhide;

setprop;

func:=funcwrite;   //при нажатии кнопки реализуем функцию ввода текста

end;

 

procedure TForm1.SpeedButton10Click(Sender: TObject);

begin

panhide;

setprop;

func:=funcbezier;   //при нажатии кнопки реализуем функцию рисования кривой

image.Canvas.Pen.Mode:= pmnotXOR;

end;

 

procedure TForm1.SpeedButton11Click(Sender: TObject);

begin

panhide;

setprop;

panel6.show;   //открыть панель для выбора формы прямоугольника

func:=funcrect;   //при нажатии кнопки реализуем функцию рисования прямоугольника

end;

 

procedure TForm1.SpeedButton12Click(Sender: TObject);

begin

panhide;

setprop;

panel6.show;    //открыть панель для выбора формы многоугольника

func:=funcpolygon; //при нажатии кнопки реализуем функцию рисования многоугольника

nump:=0;

end;

 

procedure TForm1.SpeedButton13Click(Sender: TObject);

begin

panhide;

setprop;

panel6.show;  //открыть панель для выбора формы эллипса

func:=funcellip;   //при нажатии кнопки реализуем функцию рисования эллипса

end;

 

procedure TForm1.SpeedButton14Click(Sender: TObject);

begin

panhide;

setprop;

panel6.show;   //открыть панель для выбора формы прямоугольника

//со скругленными краями

func:=funcrrect;   //при нажатии кнопки реализуем функцию рисования

                    //прямоугольника со скругленными краями

end;

 

procedure TForm1.SpeedButton18Click(Sender: TObject);

begin

rad:=speedbutton18.Width; //задает размер распылителя

end;

 

procedure TForm1.SpeedButton19Click(Sender: TObject);

begin

rad:=speedbutton19.Width; //задает размер распылителя

end;

 

procedure TForm1.SpeedButton20Click(Sender: TObject);

begin

rad:=speedbutton20.Width; //задает размер распылителя

end;

 

procedure TForm1.SpeedButton21Click(Sender: TObject);

begin

stil:=1;   //задает форму фигуры

image.Canvas.Brush.Color:=clwhite;   //задает заливку фигуры - белый

end;

 

procedure TForm1.SpeedButton22Click(Sender: TObject);

begin

stil:=2; //задает форму фигуры

image.Canvas.Brush.Color:=bcol;   //задает заливку фигуры - цвет фона

end;

 

procedure TForm1.SpeedButton23Click(Sender: TObject);

begin

stil:=3;  //задает форму фигуры

image.Canvas.Brush.Color:=bcol;   //задает заливку фигуры - цвет фона

end;

 

procedure TForm1.N52Click(Sender: TObject);   //меню - палитра

begin

if colordialog1.Execute then    //если выполняем диалог вызова окна

//для выбора цвета

   begin

    fcol:=colordialog1.Color;     //то в fcol загружаем цвет выбранный

                                   //на диалоговом окне выбора цвета

    label2.Color:=fcol;     //и загружаем этот цвет в Label2

   end;

end;

 

procedure TForm1.N55Click(Sender: TObject);

begin

form2.show;  //откроем окно, содержащий информацию О программе

end;

 

procedure TForm1.Label7Click(Sender: TObject);

begin

mastab:=1;    //задаем режим масштабирования

Loadim;

end;

 

procedure TForm1.Label8Click(Sender: TObject);

begin

mastab:=2;    //задаем режим масштабирования

Loadim;

end;

 

procedure TForm1.Label9Click(Sender: TObject);

begin

mastab:=6;    //задаем режим масштабирования

Loadim;

end;

 

procedure TForm1.Label10Click(Sender: TObject);

begin

mastab:=8;    //задаем режим масштабирования

Loadim;

end;

 

procedure TForm1.Label11Click(Sender: TObject);

begin

brkind:=1;   //задаем вид кисти

brsize:=5;   //задаем размер кисти

end;

 

procedure TForm1.Label12Click(Sender: TObject);

begin

brkind:=1;  //задаем вид кисти

brsize:=4;   //задаем размер кисти

 

end;

 

procedure TForm1.Label13Click(Sender: TObject);

begin

brkind:=1;    //задаем вид кисти

brsize:=3;    //задаем размер кисти

 

end;

 

procedure TForm1.Label14Click(Sender: TObject);

begin

brkind:=2;   //задаем вид кисти

brsize:=5;   //задаем размер кисти

 

end;

 

procedure TForm1.Label15Click(Sender: TObject);

begin

brkind:=2;   //задаем вид кисти

brsize:=4;   //задаем размер кисти

 

end;

 

procedure TForm1.Label16Click(Sender: TObject);

begin

brkind:=2;   //задаем вид кисти

brsize:=3;    //задаем размер кисти

 

end;

 

procedure TForm1.Label17Click(Sender: TObject);

begin

brkind:=3;    //задаем вид кисти

brsize:=3;    //задаем размер кисти

 

end;

 

procedure TForm1.Label18Click(Sender: TObject);

begin

brkind:=3;    //задаем вид кисти

brsize:=2;    //задаем размер кисти

 

end;

 

procedure TForm1.Label19Click(Sender: TObject);

begin

brkind:=3;    //задаем вид кисти

brsize:=1;    //задаем размер кисти

 

end;

 

procedure TForm1.Label20Click(Sender: TObject);

begin

brkind:=4;    //задаем вид кисти

brsize:=3;    //задаем размер кисти

 

end;

 

procedure TForm1.Label21Click(Sender: TObject);

begin

brkind:=4;   //задаем вид кисти

brsize:=2;    //задаем размер кисти

 

end;

 

procedure TForm1.Label22Click(Sender: TObject);

begin

brkind:=4;    //задаем вид кисти

brsize:=1;    //задаем размер кисти

 

end;

 

procedure TForm1.N53Click(Sender: TObject);

begin

//процедура открытия справочной системы

winhelp(Form1.Handle,'HELP.hlp',HELP_CONTEXT,1);

end;

 

 

end.

 

 

 

 

 

unit AbPr;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, jpeg;

 

type

  TForm2 = class(TForm)

    Label1: TLabel;

    Image1: TImage;

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form2: TForm2;

 

implementation

 

{$R *.dfm}

 

 

end.

 

 

 

 

 

unit proc;

 

interface

uses// Graphics, Classes;

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ColorGrd, StdCtrls, Spin, ExtCtrls, Menus, Buttons, ExtDlgs;

 

procedure pencil(x,y:integer;col:tcolor);

procedure line(x1,y1,x2,y2:integer;col:tcolor);

procedure erase(x,y,t:integer;col:tcolor);

procedure spray(x,y:integer;col:tcolor);

procedure rectan(x1,y1,x2,y2:integer;col:tcolor);

procedure ellips(x1,y1,x2,y2:integer;col:tcolor);

procedure rrect(x1,y1,x2,y2:integer;col:tcolor);

procedure fill(x,y:integer;col:tcolor);

procedure getcol(x,y:integer;var col:tcolor);

procedure setstyle;

procedure panhide;

procedure clear;

procedure bezier(x,y:integer;col:tcolor);

procedure loadim;

procedure setprop;

procedure polygn(x,y:integer;col:tcolor);

procedure brushdo(x,y:integer;col:tcolor);

 

implementation

 

uses unit1;

 

procedure clear;

begin

with image do canvas.fillrect(rect(0,0,width,height));

end;

 

 

procedure pencil(x,y:integer;col:tcolor);

begin

with image.Canvas do

 begin

  Pen.Color:=col;

  lineto(x,y);

 end;

end;

 

procedure line(x1,y1,x2,y2:integer;col:tcolor);

begin

with image.Canvas do

 begin

  Pen.Color:=col;

  moveto(x1,y1);

  lineto(x2,y2);

 end;

end;

 

procedure erase(x,y,t:integer;col:tcolor);

begin

with image.Canvas do

 begin

  Brush.Color:=col;

  fillrect(rect(x-t,y-t,x+t,y+t));

 end;

 

end;

 

procedure spray(x,y:integer;col:tcolor);

var i:integer;

   tx,ty : integer;

begin

 for i:=1 to rad do

  begin

   tx:=random(2*rad)-rad;

   ty:=random(2*rad)-rad;

   if tx*tx+ty*ty<=rad*rad then image.Canvas.Pixels[x+tx,y+ty]:=col;

  end;

end;

 

procedure rectan(x1,y1,x2,y2:integer;col:tcolor);

begin

with image.Canvas do

 begin

  pen.Color:=col;

  rectangle(rect(x1,y1,x2,y2));

 end;

end;

 

procedure ellips(x1,y1,x2,y2:integer;col:tcolor);

begin

with image.Canvas do

 begin

  pen.Color:=col;

  ellipse(x1,y1,x2,y2);

 end;

end;

 

procedure rrect(x1,y1,x2,y2:integer;col:tcolor);

begin

with image.Canvas do

 begin

  pen.Color:=col;

  roundrect(x1,y1,x2,y2,(x1+x2) div 4,(y1+y2)div 4);

 end;

end;

 

procedure fill(x,y:integer;col:tcolor);

begin

with image.Canvas do

 begin

  brush.Color:=col;

  FloodFill(x,y,pixels[x,y],fsSurface);

 end;

end;

 

procedure getcol(x,y:integer;var col:tcolor);

begin

col:=image.Canvas.Pixels[x,y];

end;

 

procedure setstyle;

begin

with image.Canvas do

 case stil of

  1 : begin

       pen.Style:=psSolid;

       brush.Style:=bsClear;

      end;

  2 : begin

       pen.Style:=psSolid;

       brush.Style:=bsSolid;

      end;

  3 : begin

       pen.Style:=psClear;

       brush.Style:=bsSolid;

      end;

 end;

 

end;

 

procedure panhide;

begin

form1.Panel4.Hide;

form1.Panel5.Hide;

form1.Panel6.Hide;

form1.Panel7.Hide;

form1.Panel8.Hide;

end;

 

procedure bezier(x,y:integer;col:tcolor);

begin

points[nump].X:=x;

points[nump].Y:=y;

image.Canvas.Pen.Color:=col;

image.Canvas.PolyBezier(points);

end;

 

procedure loadim;

begin

image.Width:=mastab*wid;

image.height:=mastab*het;

image.Picture.LoadFromFile(extractfilepath(paramstr(0))+'tmp.bmp');