Advertisement
Guest User

Untitled

a guest
May 20th, 2019
102
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 14.19 KB | None | 0 0
  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.     btn5: TSpeedButton;
  25.     btn6: TSpeedButton;
  26.     btn7: TSpeedButton;
  27.     btn8: TSpeedButton;
  28.     edt1: TEdit;
  29.     ud1: TUpDown;
  30.     pnl2: TPanel;
  31.     clrgrd1: TColorGrid;
  32.     bvl1: TBevel;
  33.     pnl3: TPanel;
  34.     pnl4: TPanel;
  35.     scrlbx1: TScrollBox;
  36.     img1: TImage;
  37.     stat1: TStatusBar;
  38.     dlgOPic1: TOpenPictureDialog;
  39.     dlg1: TSavePictureDialog;
  40.     lbl1: TLabel;
  41.     img2: TImage;
  42.     img3: TImage;
  43.     mmiStepBack: TMenuItem;
  44.     mmiStepForward: TMenuItem;
  45.     N9: TMenuItem;
  46.     mmiWipeOff: TMenuItem;
  47.     mmiSize: TMenuItem;
  48.     mmiHelp: TMenuItem;
  49.     mmiAboutDeveloper: TMenuItem;
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure mmiOpenClick(Sender: TObject);
  52.     procedure ud1Click(Sender: TObject; Button: TUDBtnType);
  53.     procedure clrgrd1Change(Sender: TObject);
  54.     procedure btn1MouseMove(Sender: TObject; Shift: TShiftState; X,
  55.       Y: Integer);
  56.     procedure btn2MouseMove(Sender: TObject; Shift: TShiftState; X,
  57.       Y: Integer);
  58.     procedure btn3MouseMove(Sender: TObject; Shift: TShiftState; X,
  59.       Y: Integer);
  60.     procedure btn4MouseMove(Sender: TObject; Shift: TShiftState; X,
  61.       Y: Integer);
  62.     procedure btn5MouseMove(Sender: TObject; Shift: TShiftState; X,
  63.       Y: Integer);
  64.     procedure btn6MouseMove(Sender: TObject; Shift: TShiftState; X,
  65.       Y: Integer);
  66.     procedure btn7MouseMove(Sender: TObject; Shift: TShiftState; X,
  67.       Y: Integer);
  68.     procedure btn8MouseMove(Sender: TObject; Shift: TShiftState; X,
  69.       Y: Integer);
  70.     procedure edt1MouseMove(Sender: TObject; Shift: TShiftState; X,
  71.       Y: Integer);
  72.     procedure clrgrd1MouseMove(Sender: TObject; Shift: TShiftState; X,
  73.       Y: Integer);
  74.     procedure pnl4MouseMove(Sender: TObject; Shift: TShiftState; X,
  75.       Y: Integer);
  76.     procedure pnl3MouseMove(Sender: TObject; Shift: TShiftState; X,
  77.       Y: Integer);
  78.     procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  79.       Y: Integer);
  80.     procedure edt1Change(Sender: TObject);
  81.     procedure img1MouseDown(Sender: TObject; Button: TMouseButton;
  82.       Shift: TShiftState; X, Y: Integer);
  83.     procedure btn5Click(Sender: TObject);
  84.     procedure mmiStepBackClick(Sender: TObject);
  85.     procedure mmiStepForwardClick(Sender: TObject);
  86.     procedure mmiWipeOffClick(Sender: TObject);
  87.     procedure mmiSizeClick(Sender: TObject);
  88.     procedure btn6Click(Sender: TObject);
  89.     procedure btn8Click(Sender: TObject);
  90.     procedure btn7Click(Sender: TObject);
  91.     procedure btn4Click(Sender: TObject);
  92.     procedure btn1Click(Sender: TObject);
  93.     procedure btn3Click(Sender: TObject);
  94.     procedure btn2Click(Sender: TObject);
  95.     procedure mmiSaveClick(Sender: TObject);
  96.     procedure mmiSaveAsClick(Sender: TObject);
  97.     procedure mmiCreateClick(Sender: TObject);
  98.     procedure mmiExitClick(Sender: TObject);
  99.     procedure img1MouseUp(Sender: TObject; Button: TMouseButton;
  100.       Shift: TShiftState; X, Y: Integer);
  101.     procedure mmiAboutDeveloperClick(Sender: TObject);
  102.   private
  103.     { Private declarations }
  104.   public
  105.     { Public declarations }
  106.   end;
  107.  
  108. var
  109.   Form1   : TForm1;
  110.   x1,y1,
  111.   x2,y2,
  112.   fat     : integer;
  113.   mb      : char;
  114.   flag,
  115.   front   : integer;
  116.   fname   : string;
  117.   backp,
  118.   nextp,
  119.   fopen,
  120.   fsave   : boolean;
  121.  
  122. implementation
  123.  
  124. uses Unit2, Unit3, Unit4;
  125.  
  126. {$R *.dfm}
  127.  
  128. procedure TForm1.FormCreate(Sender: TObject); // Îáëàñòü ðèñîâàíèÿ
  129. begin
  130.   fsave := true;
  131.   img1.Canvas.FillRect(img1.Canvas.ClipRect);  //Çàïîëíÿåò ïpÿìîóãîëüíèê, èñïîëüçóÿ êèñòü Brush, äî ïpàâîé è íèæíåé ãpàíèö, ïðÿìîóãîëüíèê, íà êîòîðîì ïðîèñõîäèò ãðàôè÷åñêèé âûâîä.
  132.   img2.Canvas.FillRect(img2.Canvas.ClipRect);
  133.   img3.Canvas.FillRect(img3.Canvas.ClipRect);
  134. end;
  135.  
  136. procedure TForm1.mmiOpenClick(Sender: TObject);
  137. begin
  138.    img1.AutoSize := true; //Ñâîéñòâî AutoSize  âêë
  139.    fopen := true;
  140.    dlgOPic1.Execute;
  141.    img1.Picture.LoadFromFile(dlgOPic1.FileName); //Çàãðóçêà èçîáðàæåíèÿ
  142.    fname := dlgOPic1.FileName;
  143.    img1.AutoSize := false; //AutoSize image'a âûêë
  144. end;
  145.  
  146. procedure TForm1.ud1Click(Sender: TObject; Button: TUDBtnType);
  147. begin
  148.   if not btn5.Down then
  149.   begin
  150.     front := StrToInt(edt1.Text);
  151.     if front <> 0 then
  152.     begin
  153.     if Button = btprev then
  154.      begin
  155.        dec(front);
  156.        if front = 0 then
  157.         front := 1;
  158.       edt1.Text := IntToStr(front);
  159.      end;
  160.      if Button = btnext then
  161.      begin
  162.        Inc(front);
  163.        edt1.Text := IntToStr(front);
  164.      end;
  165.     end;
  166.   end;
  167. end;
  168.  
  169. procedure TForm1.clrgrd1Change(Sender: TObject);
  170. begin
  171.   pnl4.Color := clrgrd1.ForegroundColor;
  172.   pnl3.color := clrgrd1.BackgroundColor;
  173. end;
  174.  
  175. procedure TForm1.btn1MouseMove(Sender: TObject; Shift: TShiftState; X,
  176.   Y: Integer);
  177. begin
  178.   stat1.Panels[0].Text := 'Ñòèðàíèå ÷àñòè ðèñóíêà ñ ïîìîùüþ '+
  179.                            'ëàñòèêà âûáðàíîãî öâåòà';
  180. end;
  181.  
  182. procedure TForm1.btn2MouseMove(Sender: TObject; Shift: TShiftState; X,
  183.   Y: Integer);
  184. begin
  185.   stat1.Panels[0].Text := 'Çàïîëíåíèå îáëàñòè îäíèì èç òåêóùèõ öâåòîâ';
  186. end;
  187.  
  188. procedure TForm1.btn3MouseMove(Sender: TObject; Shift: TShiftState; X,
  189.   Y: Integer);
  190. begin
  191.   stat1.Panels[0].text := 'Âûáîð öâåòîâ èç èìåþùèõñÿ íà ðèñóíêå';
  192. end;
  193.  
  194. procedure TForm1.btn4MouseMove(Sender: TObject; Shift: TShiftState; X,
  195.   Y: Integer);
  196. begin
  197.   stat1.panels[0].text := 'Ïðîâåäåíèå ïðÿìîé ëèíèè âûáðàíîé òîëùèíû';
  198. end;
  199.  
  200. procedure TForm1.btn5MouseMove(Sender: TObject; Shift: TShiftState; X,
  201.   Y: Integer);
  202. begin
  203.   stat1.Panels[0].Text := 'Ïðîâåäåíèå ïðîèçâîëüíîé ëèíèè òîëùèíîé â îäíó òî÷êó';
  204. end;
  205.  
  206. procedure TForm1.btn6MouseMove(Sender: TObject; Shift: TShiftState; X,
  207.   Y: Integer);
  208. begin
  209.   stat1.panels[0].text := 'Ðèñîâàíèå êèñòüþ âûáðîíîé òîëùèíû';
  210. end;
  211.  
  212. procedure TForm1.btn7MouseMove(Sender: TObject; Shift: TShiftState; X,
  213.   Y: Integer);
  214. begin
  215.   stat1.Panels[0].Text := 'Ðèñîâàíèå ýëëèïñà';
  216. end;
  217.  
  218. procedure TForm1.btn8MouseMove(Sender: TObject; Shift: TShiftState; X,
  219.   Y: Integer);
  220. begin
  221.   stat1.Panels[0].text := 'Ðèñîâàíèå ïðÿìîóãîëüíèêà';
  222. end;
  223.  
  224. procedure TForm1.edt1MouseMove(Sender: TObject; Shift: TShiftState; X,
  225.   Y: Integer);
  226. begin
  227.   stat1.Panels[0].text := 'Âûáîð òîëùèíû ';
  228. end;
  229. procedure TForm1.clrgrd1MouseMove(Sender: TObject; Shift: TShiftState; X,
  230.   Y: Integer);
  231. begin
  232.   stat1.Panels[0].Text := 'Âûáîð öâåòîâ';
  233. end;
  234.  
  235. procedure TForm1.pnl4MouseMove(Sender: TObject; Shift: TShiftState; X,
  236.   Y: Integer);
  237. begin
  238.   stat1.Panels[0].Text := 'Öâåò ëåâîé êíîïêè ìûøè';
  239. end;
  240.  
  241. procedure TForm1.pnl3MouseMove(Sender: TObject; Shift: TShiftState; X,
  242.   Y: Integer);
  243. begin
  244.   stat1.Panels[0].Text := 'Öâåò ïðàâîé êíîïêè ìûøè';
  245. end;
  246.  
  247. procedure TForm1.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  248.   Y: Integer);
  249. begin
  250.   stat1.Panels[0].Text := 'Îáëàñòü äëÿ ðèñîâàíèÿ';
  251.   stat1.Panels[1].text := 'x:'+inttostr(x)+ ' y:'+inttostr(y);
  252.   if ((ssRight in Shift) or (ssLeft in Shift)) then
  253.   begin
  254.     fsave := false;
  255.     backp := true;
  256.     nextp := false;
  257.     if btn1.Down then
  258.     begin
  259.       img1.Canvas.Pen.color:=pnl3.Color;
  260.       img1.Canvas.pen.Width:=strtoint((edt1.text));
  261.       Img1.Canvas.lineto(x,y);
  262.     end;
  263.  
  264.     if btn5.down then
  265.     begin
  266.       if mb = 'l' then
  267.        img1.Canvas.Pen.Color := pnl4.Color
  268.       else
  269.        img1.Canvas.Pen.Color := pnl3.Color;
  270.       img1.Canvas.LineTo(x,y);
  271.     end;
  272.  
  273.     if btn6.Down then
  274.     begin
  275.       img1.canvas.Pen.Width := strtoint(edt1.Text);
  276.       if mb = 'l' then
  277.        img1.Canvas.Pen.Color := pnl4.Color
  278.       else
  279.        img1.Canvas.Pen.Color := pnl3.Color;
  280.       img1.canvas.lineto(x,y);
  281.     end;
  282.  
  283.     if btn4.down then
  284.     begin
  285.       img1.picture.Assign(img2.picture);
  286.       if mb = 'l' then
  287.        Img1.Canvas.Pen.color := pnl4.Color
  288.       else
  289.        Img1.Canvas.Pen.color := pnl3.Color;
  290.       Img1.Canvas.Pen.width := strtoint(edt1.text);
  291.       Img1.Canvas.moveto(x,y);
  292.       Img1.Canvas.lineto(x1,y1);
  293.     end;
  294.  
  295.     if btn7.Down then
  296.     begin
  297.       img1.picture.Assign(img2.picture);
  298.       img1.Canvas.pen.Width := strtoint(edt1.text);
  299.       if mb = 'r' then
  300.        img1.Canvas.Pen.color := pnl3.Color
  301.       else
  302.  
  303.        img1.Canvas.Brush.Style := bsSolid;
  304.       Img1.Canvas.ellipse(x,y,x1,y1);
  305.     end;
  306.  
  307.     if btn8.Down then
  308.     begin
  309.       img1.picture.Assign(img2.picture);
  310.       img1.Canvas.pen.Width := strtoint(edt1.text);
  311.       if mb = 'r' then
  312.        img1.Canvas.Pen.color := pnl3.Color
  313.       else
  314.  
  315.        img1.Canvas.Brush.Style := bsSolid;
  316.       img1.Canvas.Rectangle(x,y,x1,y1);
  317.     end;
  318.  
  319.  end;
  320.   x2 := x;
  321.   y2 := y;
  322. end;
  323.  
  324. procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
  325.   Shift: TShiftState; X, Y: Integer);
  326. begin
  327.     if btn2.Down then
  328.     begin
  329.       if button = mbRight then
  330.        Img1.Canvas.brush.color := pnl3.Color
  331.       else
  332.        Img1.Canvas.brush.color := pnl4.Color;
  333.       Img1.Canvas.FloodFill(x, y,Img1.Canvas.Pixels[x,y], fssurface);
  334.     end;
  335.  
  336.     if btn3.Down then
  337.     begin
  338.       if button = mbRight then
  339.        pnl3.Color := Img1.Canvas.pixels[x,y]
  340.       else
  341.        pnl4.color := Img1.Canvas.pixels[x,y];
  342.     end;
  343. end;
  344.  
  345. procedure TForm1.img1MouseDown(Sender: TObject; Button: TMouseButton;
  346.   Shift: TShiftState; X, Y: Integer);
  347. begin
  348.   img2.picture.Assign(img1.Picture);
  349.   x1 := x;
  350.   y1 := y;
  351.   if button = mbRight then
  352.    mb := 'r'
  353.   else
  354.    mb := 'l';
  355.   img1.Canvas.MoveTo(x,y);
  356.   Img1MouseMove(Sender,Shift,X,Y);
  357. end;
  358.  
  359. procedure TForm1.edt1Change(Sender: TObject);
  360. begin
  361.   fat := strtoint(edt1.text);
  362.   if not btn5.Down then
  363.    img1.Canvas.Pen.Width := fat;
  364.  
  365.    If edt1.text='0' then Messagedlg('Òîëùèíà íå ìîæåò áûòü ðàâíà 0!',
  366. mtInformation,[mbok],0);
  367.    If edt1.text='0' then Edt1.Text := '1';
  368.  
  369. end;
  370.  
  371. procedure TForm1.btn5Click(Sender: TObject);
  372. begin
  373.   img1.Canvas.Pen.Width := 1;
  374.   lbl1.Visible := false;
  375.   edt1.Visible := false;
  376.  
  377.  
  378. end;
  379.  
  380. procedure TForm1.mmiStepBackClick(Sender: TObject);
  381. begin
  382.   if backp = true then
  383.   begin
  384.     img3.picture.Assign(img1.Picture);
  385.     img1.picture.Assign(img2.Picture);
  386.     nextp := true;
  387.   end;
  388.   backp := false;
  389. end;
  390.  
  391. procedure TForm1.mmiStepForwardClick(Sender: TObject);
  392. begin
  393.   if nextp = true then
  394.   begin
  395.     img2.Picture.Assign(img1.Picture);
  396.     img1.Picture.Assign(img3.Picture);
  397.     backp := true;
  398.   end;
  399.   nextp := false;
  400. end;
  401.  
  402. procedure TForm1.mmiWipeOffClick(Sender: TObject);
  403. begin
  404.   img1.Picture := nil;
  405.   img1.Canvas.FillRect(img1.Canvas.ClipRect);
  406.   img2.Picture := nil;
  407.   img2.Canvas.FillRect(img2.Canvas.ClipRect);
  408.   img3.Picture := nil;
  409.   img3.Canvas.FillRect(img3.Canvas.ClipRect);
  410.   backp := false;
  411.   nextp := false;
  412. end;
  413.  
  414. procedure TForm1.mmiSizeClick(Sender: TObject);
  415. begin
  416.   Form2.ShowModal;
  417. end;
  418.  
  419. procedure TForm1.btn6Click(Sender: TObject);
  420. begin
  421.   lbl1.Visible := true;
  422.   edt1.Visible := true;
  423.   ud1.Visible := true;
  424.  
  425. end;
  426.  
  427. procedure TForm1.btn8Click(Sender: TObject);
  428. begin
  429.   lbl1.Visible := true;
  430.   edt1.Visible := true;
  431.   ud1.Visible := true;
  432.  
  433.  
  434. end;
  435.  
  436. procedure TForm1.btn7Click(Sender: TObject);
  437. begin
  438.   lbl1.Visible := true;
  439.   edt1.Visible := true;
  440.   ud1.Visible := true;
  441.  
  442. end;
  443.  
  444. procedure TForm1.btn4Click(Sender: TObject);
  445. begin
  446.   lbl1.Visible := true;
  447.   edt1.Visible := true;
  448.   ud1.Visible := true;
  449.  
  450. end;
  451.  
  452. procedure TForm1.btn1Click(Sender: TObject);
  453. begin
  454.   lbl1.Visible := true;
  455.   edt1.Visible := true;
  456.   ud1.Visible := true;
  457.  
  458. end;
  459.  
  460. procedure TForm1.btn3Click(Sender: TObject);
  461. begin
  462.   lbl1.Visible := true;
  463.   edt1.Visible := true;
  464.   ud1.Visible := true;
  465.  
  466. end;
  467.  
  468. procedure TForm1.btn2Click(Sender: TObject);
  469. begin
  470.   lbl1.Visible := true;
  471.   edt1.Visible := true;
  472.   ud1.Visible := true;
  473.  
  474. end;
  475.  
  476. procedure TForm1.mmiSaveClick(Sender: TObject);
  477. var
  478.   bmp:  TBitmap;
  479. begin
  480.   if fopen then
  481.    begin
  482.       try
  483.          bmp := TBitmap.Create;
  484.          bmp.Assign(img1.Picture);
  485.          bmp.SaveTofile(ChangeFileExt(fname, '.bmp'));
  486.       finally
  487.          bmp.Free;
  488.       end;
  489.    end
  490.   else
  491.    begin
  492.      dlg1.Execute;
  493.      try
  494.         bmp := TBitmap.Create;
  495.         bmp.Assign(img1.Picture);
  496.         bmp.SaveTofile(ChangeFileExt(dlg1.FileName, '.bmp'));
  497.      finally
  498.         bmp.Free;
  499.      end;
  500.      fopen := true;
  501.    end;
  502.    fsave := true;
  503. end;
  504.  
  505. procedure TForm1.mmiSaveAsClick(Sender: TObject);
  506. var
  507.   bmp: TBitmap;
  508. begin
  509.   dlg1.Execute;
  510.   try
  511.     bmp := TBitmap.Create;
  512.     bmp.Assign(img1.Picture);
  513.     bmp.SaveTofile(ChangeFileExt(dlg1.FileName, '.bmp'));
  514.   finally
  515.     bmp.Free;
  516.   end;
  517.   fsave := true;
  518. end;
  519.  
  520. procedure TForm1.mmiCreateClick(Sender: TObject);
  521. begin
  522.   if fsave <> true then
  523.   begin
  524.     Form4.ShowModal;
  525.   end
  526.   else
  527.   begin
  528.     fopen := false;
  529.     img1.Picture := nil;
  530.     img1.Canvas.FillRect(img1.Canvas.ClipRect);
  531.     img2.Picture := nil;
  532.     img2.Canvas.FillRect(img2.Canvas.ClipRect);
  533.     img3.Picture := nil;
  534.     img3.Canvas.FillRect(img3.Canvas.ClipRect);
  535.     backp := false;
  536.     nextp := false;
  537.   end;
  538. end;
  539.  
  540. procedure TForm1.mmiExitClick(Sender: TObject);
  541. begin
  542.   if fsave <> true then
  543.   begin
  544.     Form4.ShowModal;
  545.   end;
  546.   if fsave = true then
  547.    form1.Close;
  548. end;
  549.  
  550. procedure TForm1.mmiAboutDeveloperClick(Sender: TObject);
  551. begin
  552. Messagedlg('Ïðîãðàììà ðàçðàáîòàíà Áóéêî Âèêòîðèåé, ãð.851002',
  553. mtInformation,[mbok],0);
  554. end;
  555.  
  556. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement