API tools faq
paste
Advertisement
Guest User

Untitled

a guest
May 22nd, 2019
92
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 24.48 KB | None | 0 0
raw download clone embed print report
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ColorGrd, ComCtrls, StdCtrls, Buttons, ExtCtrls, Menus, ExtDlgs;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     mm1: TMainMenu;
  12.     mmiFile: TMenuItem;
  13.     mmiCreate: TMenuItem;
  14.     mmiOpen: TMenuItem;
  15.     mmiSave: TMenuItem;
  16.     mmiSaveAs: TMenuItem;
  17.     mmiExit: TMenuItem;
  18.     mmiStep: TMenuItem;
  19.     pnl1: TPanel;
  20.     btn1: TSpeedButton;
  21.     btn2: TSpeedButton;
  22.     btn3: TSpeedButton;
  23.     btn4: TSpeedButton;
  24.     btn8: TSpeedButton;
  25.     edt1: TEdit;
  26.     ud1: TUpDown;
  27.     pnl2: TPanel;
  28.     clrgrd1: TColorGrid;
  29.     bvl1: TBevel;
  30.     pnl3: TPanel;
  31.     pnl4: TPanel;
  32.     scrlbx1: TScrollBox;
  33.     img1: TImage;
  34.     stat1: TStatusBar;
  35.     dlgOPic1: TOpenPictureDialog;
  36.     dlg1: TSavePictureDialog;
  37.     lbl1: TLabel;
  38.     img2: TImage;
  39.     img3: TImage;
  40.     mmiStepBack: TMenuItem;
  41.     mmiStepForward: TMenuItem;
  42.     N9: TMenuItem;
  43.     mmiWipeOff: TMenuItem;
  44.     mmiSize: TMenuItem;
  45.     mmiHelp: TMenuItem;
  46.     mmiAboutDeveloper: TMenuItem;
  47.     btnRoundRect: TSpeedButton;
  48.     btnRombus: TSpeedButton;
  49.     btnProcedure: TSpeedButton;
  50.     btnHandEnter: TSpeedButton;
  51.     btnUpCycle: TSpeedButton;
  52.     btnDownCycle: TSpeedButton;
  53.     SpeedButton1: TSpeedButton;
  54.     FontDialog1: TFontDialog;
  55.     SpeedButton2: TSpeedButton;
  56.     SpeedButton3: TSpeedButton;
  57.     SpeedButton4: TSpeedButton;
  58.     SpeedButton5: TSpeedButton;
  59.     procedure CreateMemo(x, y, x1, y1: Integer);
  60.     procedure FormCreate(Sender: TObject);
  61.     procedure mmiOpenClick(Sender: TObject);
  62.     procedure ud1Click(Sender: TObject; Button: TUDBtnType);
  63.     procedure clrgrd1Change(Sender: TObject);
  64.     procedure btn1MouseMove(Sender: TObject; Shift: TShiftState; X,
  65.       Y: Integer);
  66.     procedure btn2MouseMove(Sender: TObject; Shift: TShiftState; X,
  67.       Y: Integer);
  68.     procedure btn3MouseMove(Sender: TObject; Shift: TShiftState; X,
  69.       Y: Integer);
  70.     procedure btn4MouseMove(Sender: TObject; Shift: TShiftState; X,
  71.       Y: Integer);
  72.     procedure btn5MouseMove(Sender: TObject; Shift: TShiftState; X,
  73.       Y: Integer);
  74.     procedure btn6MouseMove(Sender: TObject; Shift: TShiftState; X,
  75.       Y: Integer);
  76.     procedure btn7MouseMove(Sender: TObject; Shift: TShiftState; X,
  77.       Y: Integer);
  78.     procedure btn8MouseMove(Sender: TObject; Shift: TShiftState; X,
  79.       Y: Integer);
  80.     procedure edt1MouseMove(Sender: TObject; Shift: TShiftState; X,
  81.       Y: Integer);
  82.     procedure clrgrd1MouseMove(Sender: TObject; Shift: TShiftState; X,
  83.       Y: Integer);
  84.     procedure pnl4MouseMove(Sender: TObject; Shift: TShiftState; X,
  85.       Y: Integer);
  86.     procedure pnl3MouseMove(Sender: TObject; Shift: TShiftState; X,
  87.       Y: Integer);
  88.     procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  89.       Y: Integer);
  90.     procedure edt1Change(Sender: TObject);
  91.     procedure img1MouseDown(Sender: TObject; Button: TMouseButton;
  92.       Shift: TShiftState; X, Y: Integer);
  93.     procedure btn5Click(Sender: TObject);
  94.     procedure mmiStepBackClick(Sender: TObject);
  95.     procedure mmiStepForwardClick(Sender: TObject);
  96.     procedure mmiWipeOffClick(Sender: TObject);
  97.     procedure mmiSizeClick(Sender: TObject);
  98.     procedure btn6Click(Sender: TObject);
  99.     procedure btn8Click(Sender: TObject);
  100.     procedure btn7Click(Sender: TObject);
  101.     procedure btn4Click(Sender: TObject);
  102.     procedure btn1Click(Sender: TObject);
  103.     procedure btn3Click(Sender: TObject);
  104.     procedure btn2Click(Sender: TObject);
  105.     procedure mmiSaveClick(Sender: TObject);
  106.     procedure mmiSaveAsClick(Sender: TObject);
  107.     procedure mmiCreateClick(Sender: TObject);
  108.     procedure mmiExitClick(Sender: TObject);
  109.     procedure img1MouseUp(Sender: TObject; Button: TMouseButton;
  110.       Shift: TShiftState; X, Y: Integer);
  111.     procedure mmiAboutDeveloperClick(Sender: TObject);
  112.     procedure btnRoundRectClick(Sender: TObject);
  113.     procedure btnRoundRectMouseMove(Sender: TObject; Shift: TShiftState; X,
  114.       Y: Integer);
  115.     procedure btnRombusClick(Sender: TObject);
  116.     procedure btnProcedureClick(Sender: TObject);
  117.     procedure btnHandEnterClick(Sender: TObject);
  118.     procedure btnDownCycleClick(Sender: TObject);
  119.     procedure SpeedButton1Click(Sender: TObject);
  120.     procedure SpeedButton2Click(Sender: TObject);
  121.     procedure SpeedButton3Click(Sender: TObject);
  122.     procedure SpeedButton4Click(Sender: TObject);
  123.     procedure PNG1Click(Sender: TObject);
  124.   private
  125.     { Private declarations }
  126.   public
  127.     { Public declarations }
  128.   end;
  129.  
  130. var
  131.   Form1   : TForm1;
  132.   a, b, c, d: Integer;
  133.   x3,y3   : Real;
  134.   x1,y1,
  135.   x2,y2,
  136.   fat     : integer;
  137.   mb      : char;
  138.   flag,
  139.   front   : integer;
  140.   fname   : string;
  141.   backp,
  142.   nextp,
  143.   fopen,
  144.   fsave   : boolean;
  145.  
  146. implementation
  147.  
  148. uses Unit2, Unit3, Unit4;
  149.  
  150. {$R *.dfm}
  151.  
  152. procedure TForm1.FormCreate(Sender: TObject); // Область рисования
  153. begin
  154.   fsave := true;
  155.   img1.Canvas.FillRect(img1.Canvas.ClipRect);  //Заполняет пpямоугольник, используя кисть Brush, до пpавой и нижней гpаниц, прямоугольник, на котором происходит графический вывод.
  156.   img2.Canvas.FillRect(img2.Canvas.ClipRect);
  157.   img3.Canvas.FillRect(img3.Canvas.ClipRect);
  158. end;
  159.  
  160. procedure TForm1.mmiOpenClick(Sender: TObject);
  161. begin
  162.    img1.AutoSize := true; //Свойство AutoSize  вкл
  163.    fopen := true;
  164.    dlgOPic1.Execute;
  165.    img1.Picture.LoadFromFile(dlgOPic1.FileName); //Загрузка изображения
  166.    fname := dlgOPic1.FileName;
  167.    img1.AutoSize := false; //AutoSize image'a выкл
  168. end;
  169.  
  170. procedure TForm1.ud1Click(Sender: TObject; Button: TUDBtnType);
  171. begin
  172.   //if not btn5.Down then
  173.   begin
  174.     front := StrToInt(edt1.Text);
  175.     if front <> 0 then
  176.     begin
  177.     if Button = btprev then
  178.      begin
  179.        dec(front);
  180.        if front = 0 then
  181.         front := 1;
  182.       edt1.Text := IntToStr(front);
  183.      end;
  184.      if Button = btnext then
  185.      begin
  186.        Inc(front);
  187.        edt1.Text := IntToStr(front);
  188.      end;
  189.     end;
  190.   end;
  191. end;
  192.  
  193. procedure TForm1.clrgrd1Change(Sender: TObject);
  194. begin
  195.   pnl4.Color := clrgrd1.ForegroundColor;
  196.   pnl3.color := clrgrd1.BackgroundColor;
  197. end;
  198.  
  199. procedure TForm1.btn1MouseMove(Sender: TObject; Shift: TShiftState; X,
  200.   Y: Integer);
  201. begin
  202.   stat1.Panels[0].Text := 'Стирание части рисунка с помощью '+
  203.                            'ластика выбраного цвета';
  204. end;
  205.  
  206. procedure TForm1.btn2MouseMove(Sender: TObject; Shift: TShiftState; X,
  207.   Y: Integer);
  208. begin
  209.   stat1.Panels[0].Text := 'Заполнение области одним из текущих цветов';
  210. end;
  211.  
  212. procedure TForm1.btn3MouseMove(Sender: TObject; Shift: TShiftState; X,
  213.   Y: Integer);
  214. begin
  215.   stat1.Panels[0].text := 'Выбор цветов из имеющихся на рисунке';
  216. end;
  217.  
  218. procedure TForm1.btn4MouseMove(Sender: TObject; Shift: TShiftState; X,
  219.   Y: Integer);
  220. begin
  221.   stat1.panels[0].text := 'Проведение прямой линии выбраной толщины';
  222. end;
  223.  
  224. procedure TForm1.btn5MouseMove(Sender: TObject; Shift: TShiftState; X,
  225.   Y: Integer);
  226. begin
  227.   stat1.Panels[0].Text := 'Проведение произвольной линии толщиной в одну точку';
  228. end;
  229.  
  230. procedure TForm1.btn6MouseMove(Sender: TObject; Shift: TShiftState; X,
  231.   Y: Integer);
  232. begin
  233.   stat1.panels[0].text := 'Рисование кистью выброной толщины';
  234. end;
  235.  
  236. procedure TForm1.btn7MouseMove(Sender: TObject; Shift: TShiftState; X,
  237.   Y: Integer);
  238. begin
  239.   stat1.Panels[0].Text := 'Рисование эллипса';
  240. end;
  241.  
  242. procedure TForm1.btn8MouseMove(Sender: TObject; Shift: TShiftState; X,
  243.   Y: Integer);
  244. begin
  245.   stat1.Panels[0].text := 'Рисование прямоугольника';
  246. end;
  247.  
  248. procedure TForm1.edt1MouseMove(Sender: TObject; Shift: TShiftState; X,
  249.   Y: Integer);
  250. begin
  251.   stat1.Panels[0].text := 'Выбор толщины ';
  252. end;
  253. procedure TForm1.clrgrd1MouseMove(Sender: TObject; Shift: TShiftState; X,
  254.   Y: Integer);
  255. begin
  256.   stat1.Panels[0].Text := 'Выбор цветов';
  257. end;
  258.  
  259. procedure TForm1.pnl4MouseMove(Sender: TObject; Shift: TShiftState; X,
  260.   Y: Integer);
  261. begin
  262.   stat1.Panels[0].Text := 'Цвет левой кнопки мыши';
  263. end;
  264.  
  265. procedure TForm1.pnl3MouseMove(Sender: TObject; Shift: TShiftState; X,
  266.   Y: Integer);
  267. begin
  268.   stat1.Panels[0].Text := 'Цвет правой кнопки мыши';
  269. end;
  270.  
  271. procedure TForm1.CreateMemo(x, y, x1, y1: Integer);
  272. var
  273.    Memo: TMemo;
  274. begin
  275.    Memo := TMemo.Create(Form1);
  276.    Memo.Parent := Form1;
  277.    Memo.Alignment := taCenter;
  278.    Memo.Color := clWindow;
  279.    Memo.BorderStyle := bsNone;
  280.  
  281.    //Memo.Font.Style := Memo.Font.Style + [fsBold];
  282.    //Memo.Font.Style := Bold;
  283.  
  284.    //Memo.SendToBack;
  285.    //Memo.BorderStyle := bsNone;
  286.    //Memo.Alignment := taLeftJustify;
  287.    //Memo.Left := x1 + 5;
  288.    //Memo.Top := y + 5;
  289.    //Memo.Width := x - x1 - 5;
  290.    //Memo.Height := y1 - y - 5;
  291.    Memo.Left := a;
  292.    Memo.Top := b;
  293.    Memo.Width := c;
  294.    Memo.Height := d;
  295. end;
  296.  
  297. procedure TForm1.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  298.   Y: Integer);
  299.  
  300. begin
  301.   stat1.Panels[0].Text := 'Область для рисования';
  302.   stat1.Panels[1].text := 'x:'+inttostr(x)+ ' y:'+inttostr(y);
  303.   if ((ssRight in Shift) or (ssLeft in Shift)) then
  304.   begin
  305.     fsave := false;
  306.     backp := true;
  307.     nextp := false;
  308.     if btn1.Down then
  309.     begin
  310.       img1.Canvas.Pen.color:=pnl3.Color;
  311.       img1.Canvas.pen.Width:=strtoint((edt1.text));
  312.       Img1.Canvas.lineto(x,y);
  313.     end;
  314.  
  315.     {if btn5.down then     //pencil
  316.     begin
  317.       if mb = 'l' then
  318.        img1.Canvas.Pen.Color := pnl4.Color
  319.       else
  320.        img1.Canvas.Pen.Color := pnl3.Color;
  321.       img1.Canvas.LineTo(x,y);
  322.     end;   }
  323.  
  324.     {if btn6.Down then
  325.     begin
  326.       img1.canvas.Pen.Width := strtoint(edt1.Text);
  327.       if mb = 'l' then
  328.        img1.Canvas.Pen.Color := pnl4.Color
  329.       else
  330.        img1.Canvas.Pen.Color := pnl3.Color;
  331.       img1.canvas.lineto(x,y);
  332.     end;     }
  333.  
  334.  
  335.  
  336.     {if btn7.Down then
  337.     begin
  338.       img1.picture.Assign(img2.picture);
  339.       img1.Canvas.pen.Width := strtoint(edt1.text);
  340.       if mb = 'r' then
  341.        img1.Canvas.Pen.color := pnl3.Color
  342.       else
  343.  
  344.        img1.Canvas.Brush.Style := bsSolid;
  345.       Img1.Canvas.ellipse(x,y,x1,y1);
  346.     end;}
  347.  
  348.     if btn8.Down then
  349.     begin
  350.       img1.picture.Assign(img2.picture);
  351.       img1.Canvas.pen.Width := strtoint(edt1.text);
  352.       if mb = 'r' then
  353.        img1.Canvas.Pen.color := pnl3.Color
  354.       else
  355.  
  356.        img1.Canvas.Brush.Style := bsSolid;
  357.       img1.Canvas.Rectangle(x,y,x1,y1);
  358.  
  359.     end;
  360.  
  361.  
  362.     if btnProcedure.Down then
  363.     begin
  364.       img1.picture.Assign(img2.picture);
  365.       img1.Canvas.pen.Width := strtoint(edt1.text);
  366.       if mb = 'r' then
  367.        img1.Canvas.Pen.color := pnl3.Color
  368.       else
  369.       //x3 := (x1+x)/4;
  370.       x3 := (x-x1)/3;
  371.        img1.Canvas.Brush.Style := bsSolid;
  372.        //img1.Canvas.Polygon([Point(x1,y1), Point(x1-round(x3),y), Point(x,y), Point(x+round(x3),y1)]);
  373.        img1.Canvas.Polygon([Point(x1,y1), Point(x1-round(x3),y), Point(x,y), Point(x+round(x3), y1)]);
  374.       //img1.Canvas.Polygon([Point(round(x3), y), Point(round(x3), y1)],
  375.        //       Point(x, y1), Point(x, y),
  376.         // Point(x1-round(x3), y), Point(x1-round(x3), y1), Point(round(x3), y1)]);
  377.       //img1.Canvas.Polygon([Point(100,100), Point(200,200), Point(250,145), Point(300,350)]);
  378.     end;
  379.  
  380.     if btnHandEnter.Down then
  381.     begin
  382.       img1.picture.Assign(img2.picture);
  383.       img1.Canvas.pen.Width := strtoint(edt1.text);
  384.       if mb = 'r' then
  385.        img1.Canvas.Pen.color := pnl3.Color
  386.       else
  387.       //x3 := (x+x1)/5;
  388.       //y3 := (y+y1)/4;
  389.        y3 := (y-y1)/2;
  390.        img1.Canvas.Brush.Style := bsSolid;
  391.        img1.Canvas.Polygon([Point(x1,y1), Point(x1,y), Point(x,y), Point(x,y1),
  392.        Point(x,y1- round(y3))]);
  393.     end;
  394.  
  395.     if btnUpCycle.Down then
  396.     begin
  397.       img1.picture.Assign(img2.picture);
  398.       img1.Canvas.pen.Width := strtoint(edt1.text);
  399.       if mb = 'r' then
  400.        img1.Canvas.Pen.color := pnl3.Color
  401.       else
  402.       //x3 := (x+x1)/8;
  403.       x3 := (x-x1)/5;
  404.       y3 := (y-y1)/5;
  405.       //y3 := 3*y/4;
  406.       //y3 := (y+y1)/14;
  407.        img1.Canvas.Brush.Style := bsSolid;
  408.        img1.Canvas.Polygon([Point(x1,y1), Point(x1,y), Point(x,y), Point(x,y1),
  409.        Point(x- round(x3),y1- round(y3)), Point(x1+round(x3),y1- round(y3))]);
  410.  
  411.        //img1.Canvas.Polygon([Point(x1,y1), Point(x1,y), Point(x- round(x3),y + round(y3)),
  412.        //Point(x1 + 2*round(x3), y + round(y3)), Point(x+ round(x3), y), Point(x+ round(x3), y1)]);
  413.     end;
  414.  
  415.     if btnDownCycle.Down then
  416.     begin
  417.       img1.picture.Assign(img2.picture);
  418.       img1.Canvas.pen.Width := strtoint(edt1.text);
  419.       if mb = 'r' then
  420.        img1.Canvas.Pen.color := pnl3.Color
  421.       else
  422.       //x3 := (x+x1)/8;
  423.       x3 := (x-x1)/5;
  424.       //y3 := 3*y/4;
  425.       //y3 := (y+y1)/14;
  426.       y3 := (y-y1)/5;
  427.        img1.Canvas.Brush.Style := bsSolid;
  428.        //img1.Canvas.Polygon([Point(x1,y1), Point(x1,y), Point(x,y), Point(x,y1),
  429.        //Point(x- round(x3),y1- round(y3)), Point(x1+round(x3),y1- round(y3))]);
  430.  
  431.        img1.Canvas.Polygon([Point(x1,y1), Point(x1,y), Point(x1 + round(x3),y + round(y3)),
  432.        Point(x - round(x3), y + round(y3)), Point(x, y), Point(x, y1)]);
  433.     end;
  434.  
  435.     a := x1+87;
  436.     b := y1+15;
  437.     c := x-x1-8;
  438.     d := y-y1-8;
  439.  
  440.     if btn4.down then
  441.     begin
  442.       img1.picture.Assign(img2.picture);
  443.       if mb = 'l' then
  444.        Img1.Canvas.Pen.color := pnl4.Color
  445.       else
  446.        Img1.Canvas.Pen.color := pnl3.Color;
  447.       Img1.Canvas.Pen.width := strtoint(edt1.text);
  448.       Img1.Canvas.moveto(x,y);
  449.       Img1.Canvas.lineto(x1,y1);
  450.       a := 0;
  451.       b := 0;
  452.       c := 0;
  453.       d := 0;
  454.     end;
  455.  
  456.     if btnRoundRect.Down then
  457.     begin
  458.       img1.picture.Assign(img2.picture);
  459.       img1.Canvas.pen.Width := strtoint(edt1.text);
  460.       if mb = 'r' then
  461.        img1.Canvas.Pen.color := pnl3.Color
  462.       else
  463.  
  464.        img1.Canvas.Brush.Style := bsSolid;
  465.       img1.Canvas.RoundRect(x,y,x1,y1, 100, 100);
  466.       a := x1+119;
  467.       b := y1+15;
  468.       c := x-x1-71;
  469.       d := y-y1-8;
  470.     end;
  471.  
  472.     if btnRombus.Down then
  473.     begin
  474.       img1.picture.Assign(img2.picture);
  475.       img1.Canvas.pen.Width := strtoint(edt1.text);
  476.       if mb = 'r' then
  477.        img1.Canvas.Pen.color := pnl3.Color
  478.       else
  479.       //x3 := (x+x1)/2;
  480.       //y3 := (y+y1)/2;
  481.       x3 := (x-x1)/2;
  482.       y3 := (y-y1)/2;
  483.        img1.Canvas.Brush.Style := bsSolid;
  484.       //img1.Canvas.Polygon([Point(x, round(y3)), Point(round(x3), y), Point(x1, round(y3)), Point(round(x3), y1)]);
  485.       img1.Canvas.Polygon([Point(x1, y1), Point(x1+round(x3), y1-round(y3)), Point(x, y1),
  486.       Point(x+round(x3), y1+round(y3)), Point(x, y), Point(x1+round(x3), y+round(y3)), Point(x1, y),
  487.       Point(x1-round(x3), y1+round(y3))]);
  488.       //img1.Canvas.Polygon([Point(100,100), Point(200,200), Point(250,145), Point(300,350)]);
  489.       a := x1+84;
  490.       b := y1+10;
  491.       c := x-x1-3;
  492.       d := y-y1;
  493.     end;
  494.  
  495.  end;
  496.   x2 := x;
  497.   y2 := y;
  498. end;
  499.  
  500. procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
  501.   Shift: TShiftState; X, Y: Integer);
  502. begin
  503.     if btn2.Down then
  504.     begin
  505.       if button = mbRight then
  506.        Img1.Canvas.brush.color := pnl3.Color
  507.       else
  508.        Img1.Canvas.brush.color := pnl4.Color;
  509.       Img1.Canvas.FloodFill(x, y,Img1.Canvas.Pixels[x,y], fssurface);
  510.     end;
  511.  
  512.     if btn3.Down then
  513.     begin
  514.       if button = mbRight then
  515.        pnl3.Color := Img1.Canvas.pixels[x,y]
  516.       else
  517.        pnl4.color := Img1.Canvas.pixels[x,y];
  518.     end;
  519.     CreateMemo(a, b, c, d);
  520. end;
  521.  
  522. procedure TForm1.img1MouseDown(Sender: TObject; Button: TMouseButton;
  523.   Shift: TShiftState; X, Y: Integer);
  524. begin
  525.   img2.picture.Assign(img1.Picture);
  526.   x1 := x;
  527.   y1 := y;
  528.   if button = mbRight then
  529.    mb := 'r'
  530.   else
  531.    mb := 'l';
  532.   img1.Canvas.MoveTo(x,y);
  533.   Img1MouseMove(Sender,Shift,X,Y);
  534. end;
  535.  
  536. procedure TForm1.edt1Change(Sender: TObject);
  537. begin
  538.   fat := strtoint(edt1.text);
  539.   //if not btn5.Down then
  540.   // img1.Canvas.Pen.Width := fat;
  541.  
  542.    If edt1.text='0' then Messagedlg('Толщина не может быть равна 0!',
  543. mtInformation,[mbok],0);
  544.    If edt1.text='0' then Edt1.Text := '1';
  545.  
  546. end;
  547.  
  548. procedure TForm1.btn5Click(Sender: TObject);
  549. begin
  550.   img1.Canvas.Pen.Width := 1;
  551.   lbl1.Visible := false;
  552.   edt1.Visible := false;
  553.  
  554.  
  555. end;
  556.  
  557. procedure TForm1.mmiStepBackClick(Sender: TObject);
  558. begin
  559.   if backp = true then
  560.   begin
  561.     img3.picture.Assign(img1.Picture);
  562.     img1.picture.Assign(img2.Picture);
  563.     nextp := true;
  564.   end;
  565.   backp := false;
  566. end;
  567.  
  568. procedure TForm1.mmiStepForwardClick(Sender: TObject);
  569. begin
  570.   if nextp = true then
  571.   begin
  572.     img2.Picture.Assign(img1.Picture);
  573.     img1.Picture.Assign(img3.Picture);
  574.     backp := true;
  575.   end;
  576.   nextp := false;
  577. end;
  578.  
  579. procedure TForm1.mmiWipeOffClick(Sender: TObject);
  580. var
  581.    i:Integer;
  582.    //Memo1: TMemo;
  583.    c: TControl;
  584. begin
  585.   img1.Picture := nil;
  586.   img1.Canvas.FillRect(img1.Canvas.ClipRect);
  587.   img2.Picture := nil;
  588.   img2.Canvas.FillRect(img2.Canvas.ClipRect);
  589.   img3.Picture := nil;
  590.   img3.Canvas.FillRect(img3.Canvas.ClipRect);
  591.   backp := false;
  592.   nextp := false;
  593.   for i:= self.ControlCount - 1 downto 0 do
  594.   begin
  595.      c := self.Controls[i];
  596.      if c is TMemo then
  597.      begin
  598.         c.Parent := nil;
  599.         c.Free;
  600.      end;
  601.   end;
  602.  
  603.   //Memo.SendToBack;
  604.   //Memo.Parent := Form1;;
  605. end;
  606.  
  607. procedure TForm1.mmiSizeClick(Sender: TObject);
  608. begin
  609.   Form2.ShowModal;
  610. end;
  611.  
  612. procedure TForm1.btn6Click(Sender: TObject);
  613. begin
  614.   lbl1.Visible := true;
  615.   edt1.Visible := true;
  616.   ud1.Visible := true;
  617.  
  618. end;
  619.  
  620.  
  621.  
  622. procedure TForm1.btn8Click(Sender: TObject);
  623. begin
  624.   lbl1.Visible := true;
  625.   edt1.Visible := true;
  626.   ud1.Visible := true;
  627.  
  628.  
  629. end;
  630.  
  631. procedure TForm1.btnRombusClick(Sender: TObject);
  632. begin
  633.   lbl1.Visible := true;
  634.   edt1.Visible := true;
  635.   ud1.Visible := true;
  636. end;
  637.  
  638. procedure TForm1.btnRoundRectClick(Sender: TObject);
  639. begin
  640.   lbl1.Visible := true;
  641.   edt1.Visible := true;
  642.   ud1.Visible := true;
  643. end;
  644.  
  645. procedure TForm1.btnRoundRectMouseMove(Sender: TObject; Shift: TShiftState;
  646.   X, Y: Integer);
  647. begin
  648.    stat1.Panels[0].Text := 'Рисование круглого прямоугольника';
  649. end;
  650.  
  651. procedure TForm1.btn7Click(Sender: TObject);
  652. begin
  653.   lbl1.Visible := true;
  654.   edt1.Visible := true;
  655.   ud1.Visible := true;
  656.  
  657. end;
  658.  
  659. procedure TForm1.btn4Click(Sender: TObject);
  660. begin
  661.   lbl1.Visible := true;
  662.   edt1.Visible := true;
  663.   ud1.Visible := true;
  664.  
  665. end;
  666.  
  667. procedure TForm1.btn1Click(Sender: TObject);
  668. begin
  669.   lbl1.Visible := true;
  670.   edt1.Visible := true;
  671.   ud1.Visible := true;
  672.  
  673. end;
  674.  
  675. procedure TForm1.btn3Click(Sender: TObject);
  676. begin
  677.   lbl1.Visible := true;
  678.   edt1.Visible := true;
  679.   ud1.Visible := true;
  680.  
  681. end;
  682.  
  683. procedure TForm1.btn2Click(Sender: TObject);
  684. begin
  685.   lbl1.Visible := true;
  686.   edt1.Visible := true;
  687.   ud1.Visible := true;
  688.  
  689. end;
  690.  
  691. procedure TForm1.mmiSaveClick(Sender: TObject);
  692. var
  693.   bmp:  TBitmap;
  694. begin
  695.   if fopen then
  696.    begin
  697.       try
  698.          bmp := TBitmap.Create;
  699.          bmp.Assign(img1.Picture);
  700.          bmp.SaveTofile(ChangeFileExt(fname, '.bmp'));
  701.       finally
  702.          bmp.Free;
  703.       end;
  704.    end
  705.   else
  706.    begin
  707.      dlg1.Execute;
  708.      try
  709.         bmp := TBitmap.Create;
  710.         bmp.Assign(img1.Picture);
  711.         bmp.SaveTofile(ChangeFileExt(dlg1.FileName, '.bmp'));
  712.      finally
  713.         bmp.Free;
  714.      end;
  715.      fopen := true;
  716.    end;
  717.    fsave := true;
  718. end;
  719.  
  720. procedure TForm1.mmiSaveAsClick(Sender: TObject);
  721. var
  722.   bmp: TBitmap;
  723. begin
  724.   dlg1.Execute;
  725.   try
  726.     bmp := TBitmap.Create;
  727.     bmp.Assign(img1.Picture);
  728.     bmp.SaveTofile(ChangeFileExt(dlg1.FileName, '.bmp'));
  729.   finally
  730.     bmp.Free;
  731.   end;
  732.   fsave := true;
  733. end;
  734.  
  735. procedure TForm1.mmiCreateClick(Sender: TObject);
  736. begin
  737.   if fsave <> true then
  738.   begin
  739.     Form4.ShowModal;
  740.   end
  741.   else
  742.   begin
  743.     fopen := false;
  744.     img1.Picture := nil;
  745.     img1.Canvas.FillRect(img1.Canvas.ClipRect);
  746.     img2.Picture := nil;
  747.     img2.Canvas.FillRect(img2.Canvas.ClipRect);
  748.     img3.Picture := nil;
  749.     img3.Canvas.FillRect(img3.Canvas.ClipRect);
  750.     backp := false;
  751.     nextp := false;
  752.   end;
  753. end;
  754.  
  755. procedure TForm1.mmiExitClick(Sender: TObject);
  756. begin
  757.   if fsave <> true then
  758.   begin
  759.     Form4.ShowModal;
  760.   end;
  761.   if fsave = true then
  762.    form1.Close;
  763. end;
  764.  
  765. procedure TForm1.mmiAboutDeveloperClick(Sender: TObject);
  766. begin
  767. Messagedlg('Программа разработана Буйко Викторией, гр.851002',
  768. mtInformation,[mbok],0);
  769. end;
  770.  
  771.  
  772.  
  773.  
  774.  
  775. procedure TForm1.btnProcedureClick(Sender: TObject);
  776. begin
  777.   lbl1.Visible := true;
  778.   edt1.Visible := true;
  779.   ud1.Visible := true;
  780. end;
  781.  
  782. procedure TForm1.btnHandEnterClick(Sender: TObject);
  783. begin
  784.   lbl1.Visible := true;
  785.   edt1.Visible := true;
  786.   ud1.Visible := true;
  787. end;
  788.  
  789. procedure TForm1.btnDownCycleClick(Sender: TObject);
  790. begin
  791.   lbl1.Visible := true;
  792.   edt1.Visible := true;
  793.   ud1.Visible := true;
  794. end;
  795.  
  796.  
  797.  
  798. procedure TForm1.SpeedButton1Click(Sender: TObject);
  799. var
  800.    i: Integer;
  801.    Memo: TMemo;
  802.    c: TControl;
  803. begin
  804.    if FontDialog1.Execute then
  805.      for i:= self.ControlCount - 1 downto 0 do
  806.      begin
  807.         c := self.Controls[i];
  808.         if c is TMemo then
  809.         begin
  810.            //Font.Style := Font.Style + [fsBold];
  811.            Font.size := FontDialog1.Font.Size;
  812.            Font.style := FontDialog1.Font.Style;
  813.            Font.color := FontDialog1.Font.Color;
  814.  
  815.            //c.Font.Style := Font.Style + [fsBold];
  816.            //c.
  817.         end;
  818.      end;
  819.      edt1.Font.Size := 8;
  820.      clrgrd1.Font.Size := 8;
  821.      lbl1.Font.Size := 8;
  822.      edt1.Font.Style := edt1.Font.Style - [fsBold];
  823.      edt1.Font.Style := edt1.Font.Style - [fsItalic];
  824.      edt1.Font.Style := edt1.Font.Style - [fsUnderline];
  825.      lbl1.Font.Style := lbl1.Font.Style - [fsBold];
  826.      lbl1.Font.Style := lbl1.Font.Style - [fsItalic];
  827.      lbl1.Font.Style := lbl1.Font.Style - [fsUnderline];
  828.      //lbl1.Font.Style := lbl1.Font.Style + [fsNormal];
  829.       //if FontDialog1.Execute then
  830.       //with Sender as TMemo do
  831.       {begin
  832.          (Sender as TMemo).Font.size := FontDialog1.Font.Size;
  833.          Font.style := FontDialog1.Font.Style;
  834.          Font.color := FontDialog1.Font.Color;
  835.         // Font := FontDialog1.Font;
  836.       end; }
  837.    //Memo.Parent := Form1;
  838.    //with Sender as TMemo do
  839.    //Font.Style := Font.Style + [fsBold];
  840.    //Memo.Font.Style := Memo.Font.Style + [fsBold];
  841. end;
  842.  
  843. procedure TForm1.SpeedButton2Click(Sender: TObject);
  844. var
  845.    i: Integer;
  846.    c: TControl;
  847. begin
  848.      for i:= self.ControlCount - 1 downto 0 do
  849.      begin
  850.         c := self.Controls[i];
  851.         if c is TMemo then
  852.         begin
  853.            Font.Style := Font.Style + [fsBold];
  854.         end;
  855.      end;
  856.      clrgrd1.Font.Size := 8;
  857.      edt1.Font.Style := edt1.Font.Style - [fsBold];
  858.      lbl1.Font.Style := lbl1.Font.Style - [fsBold];
  859. end;
  860.  
  861. procedure TForm1.SpeedButton3Click(Sender: TObject);
  862. var
  863.    i: Integer;
  864.    c: TControl;
  865. begin
  866.      for i:= self.ControlCount - 1 downto 0 do
  867.      begin
  868.         c := self.Controls[i];
  869.         if c is TMemo then
  870.         begin
  871.            Font.Style := Font.Style + [fsItalic];
  872.            Font.Name := 'TimesNewRoman';
  873.         end;
  874.      end;
  875.      clrgrd1.Font.Size := 8;
  876.      edt1.Font.Name := 'MS Sans Serif';
  877.      lbl1.Font.Name := 'MS Sans Serif';
  878.      edt1.Font.Style := edt1.Font.Style - [fsItalic];
  879.      lbl1.Font.Style := lbl1.Font.Style - [fsItalic];
  880. end;
  881.  
  882. procedure TForm1.SpeedButton4Click(Sender: TObject);
  883. var
  884.    i: Integer;
  885.    c: TControl;
  886. begin
  887.      for i:= self.ControlCount - 1 downto 0 do
  888.      begin
  889.         c := self.Controls[i];
  890.         if c is TMemo then
  891.         begin
  892.            Font.Style := Font.Style + [fsUnderline];
  893.            Font.Name := 'TimesNewRoman';
  894.         end;
  895.      end;
  896.      clrgrd1.Font.Size := 8;
  897.      edt1.Font.Name := 'MS Sans Serif';
  898.      lbl1.Font.Name := 'MS Sans Serif';
  899.      edt1.Font.Style := edt1.Font.Style - [fsUnderline];
  900.      lbl1.Font.Style := lbl1.Font.Style - [fsUnderline];
  901. end;
  902.  
  903. procedure TForm1.PNG1Click(Sender: TObject);
  904. var
  905.   bmp: TBitmap;
  906. begin
  907.   dlg1.Execute;
  908.   try
  909.     bmp := TBitmap.Create;
  910.     bmp.Assign(img1.Picture);
  911.     bmp.SaveTofile(ChangeFileExt(dlg1.FileName, '.jpg'));
  912.   finally
  913.     bmp.Free;
  914.   end;
  915.   fsave := true;
  916. end;
  917.  
  918. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!