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

 

ПРИЛОЖЕНИЕ

Исходный текст программы

unit Unit1;

 

interface

 

uses

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

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

 

type

  TForm1 = class(TForm)

    Image1: TImage;  //компонент для отображения на форме графических изображений

    ColorGrid1: TColorGrid;  //компонент для выбора цвета

    MainMenu1: TMainMenu;  //компонент для подвешивания панели меню

    Panel1: TPanel;  //для подвешивания панели инструментов

    Panel2: TPanel;  //для панели выбора цвета

    Panel3: TPanel;  //для отображения выбранного цвета

    Label1: TLabel;

    Label2: TLabel;

    N1: TMenuItem;

    N5: TMenuItem;

    N6: TMenuItem;

    SpeedButton1: TSpeedButton;   //ластик

    SpeedButton2: TSpeedButton;   //заливка

    SpeedButton3: TSpeedButton;   //индикатор цвета

    SpeedButton4: TSpeedButton;   //масштаб

    SpeedButton5: TSpeedButton;   //карандаш

    SpeedButton6: TSpeedButton;   //кисть

    SpeedButton7: TSpeedButton;   //распылитель

    SpeedButton8: TSpeedButton;   //надпись

    SpeedButton9: TSpeedButton;   //прямая

    SpeedButton10: TSpeedButton;  //кривая

    SpeedButton11: TSpeedButton;  //прямоугольник

    SpeedButton12: TSpeedButton;  //многоугольник

    SpeedButton13: TSpeedButton;  //эллипс

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

    N7: TMenuItem;

    N8: TMenuItem;

    N9: TMenuItem;

    N10: TMenuItem;

    N11: TMenuItem;

    N21: TMenuItem;

    N52: TMenuItem;

    N53: TMenuItem;

    N54: TMenuItem;

    N55: TMenuItem;

    SpeedButton15: TSpeedButton;

    OpenPictureDialog1: TOpenPictureDialog;

    SavePictureDialog1: TSavePictureDialog;

    Panel4: TPanel;  //панель для задания размера ластика

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    Label6: TLabel;

    Panel5: TPanel;  //панель для выбора формы пятен распылителя

    SpeedButton18: TSpeedButton;

    SpeedButton19: TSpeedButton;

    SpeedButton20: TSpeedButton;

    Panel6: TPanel;   //панель для режима построения фигур

    SpeedButton21: TSpeedButton;

    SpeedButton22: TSpeedButton;

    SpeedButton23: TSpeedButton;

    Memo1: TMemo;

    ColorDialog1: TColorDialog;

    ScrollBox1: TScrollBox;

    Panel7: TPanel;   //панель для выбора масштаба

    Label7: TLabel;

    Label8: TLabel;

    Label9: TLabel;

    Label10: TLabel;

    Panel8: TPanel;   //панель для выбора размера кисти

    Label11: TLabel;

    Label12: TLabel;

    Label13: TLabel;

    Label14: TLabel;

    Label15: TLabel;

    Label16: TLabel;

    Label17: TLabel;

    Label18: TLabel;

    Label19: TLabel;

    Label20: TLabel;

    Label21: TLabel;

    Label22: TLabel;

    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure ColorGrid1Change(Sender: TObject);

    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure FormCreate(Sender: TObject);

    procedure SpeedButton5Click(Sender: TObject);

    procedure SpeedButton2Click(Sender: TObject);

    procedure SpeedButton3Click(Sender: TObject);

    procedure SpeedButton9Click(Sender: TObject);

    procedure N21Click(Sender: TObject);

    procedure N7Click(Sender: TObject);

    procedure N8Click(Sender: TObject);

    procedure N10Click(Sender: TObject);

    procedure SpeedButton1Click(Sender: TObject);

    procedure Label3Click(Sender: TObject);

    procedure Label4Click(Sender: TObject);

    procedure Label6Click(Sender: TObject);

    procedure Label5Click(Sender: TObject);

    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure SpeedButton7Click(Sender: TObject);

    procedure SpeedButton4Click(Sender: TObject);

    procedure SpeedButton6Click(Sender: TObject);

    procedure SpeedButton8Click(Sender: TObject);

    procedure SpeedButton10Click(Sender: TObject);

    procedure SpeedButton11Click(Sender: TObject);

    procedure SpeedButton12Click(Sender: TObject);

    procedure SpeedButton13Click(Sender: TObject);

    procedure SpeedButton14Click(Sender: TObject);

    procedure SpeedButton18Click(Sender: TObject);

    procedure SpeedButton19Click(Sender: TObject);

    procedure SpeedButton20Click(Sender: TObject);

    procedure SpeedButton21Click(Sender: TObject);

    procedure SpeedButton22Click(Sender: TObject);

    procedure SpeedButton23Click(Sender: TObject);

    procedure N52Click(Sender: TObject);

    procedure N55Click(Sender: TObject);

    procedure Label7Click(Sender: TObject);

    procedure Label8Click(Sender: TObject);

    procedure Label9Click(Sender: TObject);

    procedure Label10Click(Sender: TObject);

    procedure Label11Click(Sender: TObject);

    procedure Label12Click(Sender: TObject);

    procedure Label13Click(Sender: TObject);

    procedure Label14Click(Sender: TObject);

    procedure Label15Click(Sender: TObject);

    procedure Label16Click(Sender: TObject);

    procedure Label17Click(Sender: TObject);

    procedure Label18Click(Sender: TObject);

    procedure Label19Click(Sender: TObject);

    procedure Label20Click(Sender: TObject);

    procedure Label21Click(Sender: TObject);

    procedure Label22Click(Sender: TObject);

    procedure N53Click(Sender: TObject);

  

 

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

const

  funcpencil  = 1;  //функция карандаш

  funcfill    = 2;   //функция заливка

  funcgetcol  = 3;   //функция индикатор цвета

  funcline    = 4;  //функция прямая линия

  funcerase   = 5;   //функция стирания (ластик)

  funcspray   = 6;  //функция распылитель

  funcrect    = 7;   //функция прямоугольник

  funcellip   = 8;   //функция эллипс

  funcrrect   = 9;   //функция прямоугольник со скругленными краями

  funcwrite   = 10;   //функция надпись

  funcbezier  = 11;  //функция кривая

  funcpolygon = 12;  //функция многоугольник

  funcbrush   = 13;   //функция кисть

var

  Form1   : TForm1;

  func    : byte;   //для выбора одной из функций

  fcol    : tcolor;   //для цвета рисования

  bcol    : tcolor;   //для цвета фона

  Image   : TImage;

  fx,fy  : integer;   //для запоминания

  stx,sty : integer;   //положения курсора

  eraser  : integer;  //для задания размера ластика

  but     : TShiftState; //для определения какая клавиша нажата

  rad     : byte;   //для определения размера распылителя

  stil    : byte;   //для формы фигуры

  points  : array [1..4] of TPoint;

  NumP    : byte;

  wid,het : LongInt;    //для задания высоты и ширины

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

  polyg   : array of TPoint;   //массив для многоугольника

  brkind,brsize : byte;    //для задания размера и  вида кисти

 

implementation

{$R *.dfm}

uses proc, AbPr;

 

//процедура перемещения  курсора мыши по компоненту Image1

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

 if ssLeft in shift then   //если нажата левая кнопка мыши

   case func of      //если func равно одному из следующих значений

    funcpencil : pencil(x,y,fcol);   //функция рисования карандашом

    funcline   : begin   //функция рисования прямой линии

                  line(fx,fy,stx,sty,fcol{clwhite});

                  line(fx,fy,x,y,fcol);

                  stx:=x;sty:=y;

                 end;

    funcerase  : erase(x,y,eraser,bcol);  //функция стирания

    funcspray  : spray(x,y,fcol);    //функция рисования распылителя

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

                  rectan(fx,fy,stx,sty,fcol{clwhite});

                  rectan(fx,fy,x,y,fcol);

                  stx:=x;sty:=y;

                 end;

    funcellip  : begin  //функция рисования эллипса

                  ellips(fx,fy,stx,sty,fcol{clwhite});

                  ellips(fx,fy,x,y,fcol);

                  stx:=x;sty:=y;

                 end;

    funcrrect  : begin  //функция рисования прямоугольника со скругленными краями

                  rrect(fx,fy,stx,sty,fcol{clwhite});

                  rrect(fx,fy,x,y,fcol);

                  stx:=x;sty:=y;

                 end;

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

                  if nump<>0 then

                   begin

                      bezier(stx,sty,fcol);

                   end;

                  bezier(x,y,fcol);

                  stx:=x;sty:=y;

                 end;

    funcbrush   : brushdo(x,y,fcol);   //функция рисования кистью

 

   end;

 if ssright in shift then    //если нажата правая кнопка мыши

   case func of     //если func равно одному из следующих значений

    funcpencil : pencil(x,y,bcol);   //функция рисования карандашом

    funcline   : begin     //функция рисования прямой линии

                  line(fx,fy,stx,sty,bcol{clwhite});

                  line(fx,fy,x,y,bcol);

                  stx:=x;sty:=y;

                 end;

    funcerase  : erase(x,y,eraser,fcol);    //функция стирания

    funcspray  : spray(x,y,bcol);   //функция рисования распылителя

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

                  rectan(fx,fy,stx,sty,bcol{clwhite});

                  rectan(fx,fy,x,y,bcol);

                  stx:=x;sty:=y;

                 end;

    funcellip  : begin   //функция рисования эллипса

                  ellips(fx,fy,stx,sty,bcol{clwhite});

                  ellips(fx,fy,x,y,bcol);

                  stx:=x;sty:=y;

                 end;

    funcrrect  : begin   //функция рисования прямоугольника со скругленными краями

                  rrect(fx,fy,stx,sty,bcol{clwhite});

                  rrect(fx,fy,x,y,bcol);

                  stx:=x;sty:=y;

                 end;

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

                  if nump<>0 then

                   begin

                    bezier(stx,sty,bcol);

                  end;

                  bezier(x,y,bcol);

                  stx:=x;sty:=y;

                 end;

    funcbrush   : brushdo(x,y,bcol);   //функция рисования кистью

 

   end;

 

Image.Canvas.MoveTo(x,y);    //рисуем текущие позиции

end;

 

 

//при изменении компонента ColorGrid1 будем изменять цвет пера

//и кисти для Image1

procedure TForm1.ColorGrid1Change(Sender: TObject);

begin

 fcol:=colorgrid1.ForegroundColor;  //загрузить в fcol выбранный цвет //рисования на панели

 bcol:=colorgrid1.BackgroundColor;   //загрузить в bcol цвет фона

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

form1.Label1.Color:=colorgrid1.BackgroundColor;  //загрузить цвет фона в Label1

end;

 

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

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

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

  Shift: TShiftState; X, Y: Integer);

var i:integer;

    st:string;

    count:integer;

begin

 if ssLeft in shift then     //если нажата левая кнопка мыши

   case func of    //если func равно одному из следующих значений

    funcfill   : fill(x,y,fcol);     //функция заливка

    funcgetcol : begin    //функция индикатор цвета

                  getcol(x,y,fcol);

                  label2.Color:=fcol;

                 end;

    funcline   : begin    //функция  прямая линия

                  image.Canvas.Pen.Mode:= pmnotXOR;   //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                 end;

    funcspray  : spray(x,y,fcol);    //функция распылитель

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

                  image.Canvas.Pen.Mode:= pmnotXOR;   //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                  setstyle;    //установка стиля

                 end;

    funcellip  : begin    //функция рисования  эллипса

                  image.Canvas.Pen.Mode:= pmnotXOR;   //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                  setstyle;

                 end;

    funcrrect  : begin    //функция рисования прямоугольника со скругленными краями

                  image.Canvas.Pen.Mode:= pmnotXOR;   //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                  setstyle;

                 end;

    funcwrite  : begin    //функция ввода текста

                  memo1.Font.Color:=fcol;

                  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:=[ssleft];    //нажата левая кнопка мыши

                  if nump<>0 then

                   begin

                    bezier(stx,sty,fcol);

                   end;

                  inc(nump);   //функция увеличения переменной

                  if nump>4 then nump:=0;

                  bezier(x,y,fcol);

                  stx:=x;sty:=y;

                 end;

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

                   inc(nump);

                   polygn(x,y,fcol);

                  end;

   end;

 if ssright in shift then    //если нажата правая кнопка мыши

   case func of    //если func равно одному из следующих значений

    funcfill   : fill(x,y,bcol);    //функция заливка

    funcgetcol : begin    //функция индикатор цвета

                  getcol(x,y,bcol);

                  label1.Color:=bcol;    //значение цвета фона загружаем в Label1

                 end;

    funcline   : begin   //функция рисования прямой линии

                  image.Canvas.Pen.Mode:= pmnotXOR;  //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                 end;

    funcspray  : spray(x,y,bcol);   //функция рисования распылителем

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

                  image.Canvas.Pen.Mode:= pmnotXOR;  //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                  setstyle;

                 end;

    funcellip  : begin    //функция рисования эллипса

                  image.Canvas.Pen.Mode:= pmnotXOR;   //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                  setstyle;

                 end;

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

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

                  image.Canvas.Pen.Mode:= pmnotXOR;   //растягивание фигуры

                  fx:=x;

                  fy:=y;

                  stx:=x;sty:=y;

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

                  setstyle;

                 end;

    funcwrite  : begin    //функция ввода текста