Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Unit1;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ColorGrd, ComCtrls, StdCtrls, Buttons, ExtCtrls, Menus, ExtDlgs;
- type
- TForm1 = class(TForm)
- mm1: TMainMenu;
- mmiFile: TMenuItem;
- mmiCreate: TMenuItem;
- mmiOpen: TMenuItem;
- mmiSave: TMenuItem;
- mmiSaveAs: TMenuItem;
- mmiExit: TMenuItem;
- mmiStep: TMenuItem;
- pnl1: TPanel;
- btn1: TSpeedButton;
- btn2: TSpeedButton;
- btn3: TSpeedButton;
- btn4: TSpeedButton;
- btn5: TSpeedButton;
- btn6: TSpeedButton;
- btn7: TSpeedButton;
- btn8: TSpeedButton;
- edt1: TEdit;
- ud1: TUpDown;
- pnl2: TPanel;
- clrgrd1: TColorGrid;
- bvl1: TBevel;
- pnl3: TPanel;
- pnl4: TPanel;
- scrlbx1: TScrollBox;
- img1: TImage;
- stat1: TStatusBar;
- dlgOPic1: TOpenPictureDialog;
- dlg1: TSavePictureDialog;
- lbl1: TLabel;
- img2: TImage;
- img3: TImage;
- mmiStepBack: TMenuItem;
- mmiStepForward: TMenuItem;
- N9: TMenuItem;
- mmiWipeOff: TMenuItem;
- mmiSize: TMenuItem;
- mmiHelp: TMenuItem;
- mmiAboutDeveloper: TMenuItem;
- procedure FormCreate(Sender: TObject);
- procedure mmiOpenClick(Sender: TObject);
- procedure ud1Click(Sender: TObject; Button: TUDBtnType);
- procedure clrgrd1Change(Sender: TObject);
- procedure btn1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure btn2MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure btn3MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure btn4MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure btn5MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure btn6MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure btn7MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure btn8MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure edt1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure clrgrd1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure pnl4MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure pnl3MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure edt1Change(Sender: TObject);
- procedure img1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure btn5Click(Sender: TObject);
- procedure mmiStepBackClick(Sender: TObject);
- procedure mmiStepForwardClick(Sender: TObject);
- procedure mmiWipeOffClick(Sender: TObject);
- procedure mmiSizeClick(Sender: TObject);
- procedure btn6Click(Sender: TObject);
- procedure btn8Click(Sender: TObject);
- procedure btn7Click(Sender: TObject);
- procedure btn4Click(Sender: TObject);
- procedure btn1Click(Sender: TObject);
- procedure btn3Click(Sender: TObject);
- procedure btn2Click(Sender: TObject);
- procedure mmiSaveClick(Sender: TObject);
- procedure mmiSaveAsClick(Sender: TObject);
- procedure mmiCreateClick(Sender: TObject);
- procedure mmiExitClick(Sender: TObject);
- procedure img1MouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure mmiAboutDeveloperClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form1 : TForm1;
- x1,y1,
- x2,y2,
- fat : integer;
- mb : char;
- flag,
- front : integer;
- fname : string;
- backp,
- nextp,
- fopen,
- fsave : boolean;
- implementation
- uses Unit2, Unit3, Unit4;
- {$R *.dfm}
- procedure TForm1.FormCreate(Sender: TObject); // Îáëàñòü ðèñîâàíèÿ
- begin
- fsave := true;
- img1.Canvas.FillRect(img1.Canvas.ClipRect); //Çàïîëíÿåò ïpÿìîóãîëüíèê, èñïîëüçóÿ êèñòü Brush, äî ïpàâîé è íèæíåé ãpàíèö, ïðÿìîóãîëüíèê, íà êîòîðîì ïðîèñõîäèò ãðàôè÷åñêèé âûâîä.
- img2.Canvas.FillRect(img2.Canvas.ClipRect);
- img3.Canvas.FillRect(img3.Canvas.ClipRect);
- end;
- procedure TForm1.mmiOpenClick(Sender: TObject);
- begin
- img1.AutoSize := true; //Ñâîéñòâî AutoSize âêë
- fopen := true;
- dlgOPic1.Execute;
- img1.Picture.LoadFromFile(dlgOPic1.FileName); //Çàãðóçêà èçîáðàæåíèÿ
- fname := dlgOPic1.FileName;
- img1.AutoSize := false; //AutoSize image'a âûêë
- end;
- procedure TForm1.ud1Click(Sender: TObject; Button: TUDBtnType);
- begin
- if not btn5.Down then
- begin
- front := StrToInt(edt1.Text);
- if front <> 0 then
- begin
- if Button = btprev then
- begin
- dec(front);
- if front = 0 then
- front := 1;
- edt1.Text := IntToStr(front);
- end;
- if Button = btnext then
- begin
- Inc(front);
- edt1.Text := IntToStr(front);
- end;
- end;
- end;
- end;
- procedure TForm1.clrgrd1Change(Sender: TObject);
- begin
- pnl4.Color := clrgrd1.ForegroundColor;
- pnl3.color := clrgrd1.BackgroundColor;
- end;
- procedure TForm1.btn1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Ñòèðàíèå ÷àñòè ðèñóíêà ñ ïîìîùüþ '+
- 'ëàñòèêà âûáðàíîãî öâåòà';
- end;
- procedure TForm1.btn2MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Çàïîëíåíèå îáëàñòè îäíèì èç òåêóùèõ öâåòîâ';
- end;
- procedure TForm1.btn3MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].text := 'Âûáîð öâåòîâ èç èìåþùèõñÿ íà ðèñóíêå';
- end;
- procedure TForm1.btn4MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.panels[0].text := 'Ïðîâåäåíèå ïðÿìîé ëèíèè âûáðàíîé òîëùèíû';
- end;
- procedure TForm1.btn5MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Ïðîâåäåíèå ïðîèçâîëüíîé ëèíèè òîëùèíîé â îäíó òî÷êó';
- end;
- procedure TForm1.btn6MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.panels[0].text := 'Ðèñîâàíèå êèñòüþ âûáðîíîé òîëùèíû';
- end;
- procedure TForm1.btn7MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Ðèñîâàíèå ýëëèïñà';
- end;
- procedure TForm1.btn8MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].text := 'Ðèñîâàíèå ïðÿìîóãîëüíèêà';
- end;
- procedure TForm1.edt1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].text := 'Âûáîð òîëùèíû ';
- end;
- procedure TForm1.clrgrd1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Âûáîð öâåòîâ';
- end;
- procedure TForm1.pnl4MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Öâåò ëåâîé êíîïêè ìûøè';
- end;
- procedure TForm1.pnl3MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Öâåò ïðàâîé êíîïêè ìûøè';
- end;
- procedure TForm1.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- begin
- stat1.Panels[0].Text := 'Îáëàñòü äëÿ ðèñîâàíèÿ';
- stat1.Panels[1].text := 'x:'+inttostr(x)+ ' y:'+inttostr(y);
- if ((ssRight in Shift) or (ssLeft in Shift)) then
- begin
- fsave := false;
- backp := true;
- nextp := false;
- if btn1.Down then
- begin
- img1.Canvas.Pen.color:=pnl3.Color;
- img1.Canvas.pen.Width:=strtoint((edt1.text));
- Img1.Canvas.lineto(x,y);
- end;
- if btn5.down then
- begin
- if mb = 'l' then
- img1.Canvas.Pen.Color := pnl4.Color
- else
- img1.Canvas.Pen.Color := pnl3.Color;
- img1.Canvas.LineTo(x,y);
- end;
- if btn6.Down then
- begin
- img1.canvas.Pen.Width := strtoint(edt1.Text);
- if mb = 'l' then
- img1.Canvas.Pen.Color := pnl4.Color
- else
- img1.Canvas.Pen.Color := pnl3.Color;
- img1.canvas.lineto(x,y);
- end;
- if btn4.down then
- begin
- img1.picture.Assign(img2.picture);
- if mb = 'l' then
- Img1.Canvas.Pen.color := pnl4.Color
- else
- Img1.Canvas.Pen.color := pnl3.Color;
- Img1.Canvas.Pen.width := strtoint(edt1.text);
- Img1.Canvas.moveto(x,y);
- Img1.Canvas.lineto(x1,y1);
- end;
- if btn7.Down then
- begin
- img1.picture.Assign(img2.picture);
- img1.Canvas.pen.Width := strtoint(edt1.text);
- if mb = 'r' then
- img1.Canvas.Pen.color := pnl3.Color
- else
- img1.Canvas.Brush.Style := bsSolid;
- Img1.Canvas.ellipse(x,y,x1,y1);
- end;
- if btn8.Down then
- begin
- img1.picture.Assign(img2.picture);
- img1.Canvas.pen.Width := strtoint(edt1.text);
- if mb = 'r' then
- img1.Canvas.Pen.color := pnl3.Color
- else
- img1.Canvas.Brush.Style := bsSolid;
- img1.Canvas.Rectangle(x,y,x1,y1);
- end;
- end;
- x2 := x;
- y2 := y;
- end;
- procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- if btn2.Down then
- begin
- if button = mbRight then
- Img1.Canvas.brush.color := pnl3.Color
- else
- Img1.Canvas.brush.color := pnl4.Color;
- Img1.Canvas.FloodFill(x, y,Img1.Canvas.Pixels[x,y], fssurface);
- end;
- if btn3.Down then
- begin
- if button = mbRight then
- pnl3.Color := Img1.Canvas.pixels[x,y]
- else
- pnl4.color := Img1.Canvas.pixels[x,y];
- end;
- end;
- procedure TForm1.img1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- img2.picture.Assign(img1.Picture);
- x1 := x;
- y1 := y;
- if button = mbRight then
- mb := 'r'
- else
- mb := 'l';
- img1.Canvas.MoveTo(x,y);
- Img1MouseMove(Sender,Shift,X,Y);
- end;
- procedure TForm1.edt1Change(Sender: TObject);
- begin
- fat := strtoint(edt1.text);
- if not btn5.Down then
- img1.Canvas.Pen.Width := fat;
- If edt1.text='0' then Messagedlg('Òîëùèíà íå ìîæåò áûòü ðàâíà 0!',
- mtInformation,[mbok],0);
- If edt1.text='0' then Edt1.Text := '1';
- end;
- procedure TForm1.btn5Click(Sender: TObject);
- begin
- img1.Canvas.Pen.Width := 1;
- lbl1.Visible := false;
- edt1.Visible := false;
- end;
- procedure TForm1.mmiStepBackClick(Sender: TObject);
- begin
- if backp = true then
- begin
- img3.picture.Assign(img1.Picture);
- img1.picture.Assign(img2.Picture);
- nextp := true;
- end;
- backp := false;
- end;
- procedure TForm1.mmiStepForwardClick(Sender: TObject);
- begin
- if nextp = true then
- begin
- img2.Picture.Assign(img1.Picture);
- img1.Picture.Assign(img3.Picture);
- backp := true;
- end;
- nextp := false;
- end;
- procedure TForm1.mmiWipeOffClick(Sender: TObject);
- begin
- img1.Picture := nil;
- img1.Canvas.FillRect(img1.Canvas.ClipRect);
- img2.Picture := nil;
- img2.Canvas.FillRect(img2.Canvas.ClipRect);
- img3.Picture := nil;
- img3.Canvas.FillRect(img3.Canvas.ClipRect);
- backp := false;
- nextp := false;
- end;
- procedure TForm1.mmiSizeClick(Sender: TObject);
- begin
- Form2.ShowModal;
- end;
- procedure TForm1.btn6Click(Sender: TObject);
- begin
- lbl1.Visible := true;
- edt1.Visible := true;
- ud1.Visible := true;
- end;
- procedure TForm1.btn8Click(Sender: TObject);
- begin
- lbl1.Visible := true;
- edt1.Visible := true;
- ud1.Visible := true;
- end;
- procedure TForm1.btn7Click(Sender: TObject);
- begin
- lbl1.Visible := true;
- edt1.Visible := true;
- ud1.Visible := true;
- end;
- procedure TForm1.btn4Click(Sender: TObject);
- begin
- lbl1.Visible := true;
- edt1.Visible := true;
- ud1.Visible := true;
- end;
- procedure TForm1.btn1Click(Sender: TObject);
- begin
- lbl1.Visible := true;
- edt1.Visible := true;
- ud1.Visible := true;
- end;
- procedure TForm1.btn3Click(Sender: TObject);
- begin
- lbl1.Visible := true;
- edt1.Visible := true;
- ud1.Visible := true;
- end;
- procedure TForm1.btn2Click(Sender: TObject);
- begin
- lbl1.Visible := true;
- edt1.Visible := true;
- ud1.Visible := true;
- end;
- procedure TForm1.mmiSaveClick(Sender: TObject);
- var
- bmp: TBitmap;
- begin
- if fopen then
- begin
- try
- bmp := TBitmap.Create;
- bmp.Assign(img1.Picture);
- bmp.SaveTofile(ChangeFileExt(fname, '.bmp'));
- finally
- bmp.Free;
- end;
- end
- else
- begin
- dlg1.Execute;
- try
- bmp := TBitmap.Create;
- bmp.Assign(img1.Picture);
- bmp.SaveTofile(ChangeFileExt(dlg1.FileName, '.bmp'));
- finally
- bmp.Free;
- end;
- fopen := true;
- end;
- fsave := true;
- end;
- procedure TForm1.mmiSaveAsClick(Sender: TObject);
- var
- bmp: TBitmap;
- begin
- dlg1.Execute;
- try
- bmp := TBitmap.Create;
- bmp.Assign(img1.Picture);
- bmp.SaveTofile(ChangeFileExt(dlg1.FileName, '.bmp'));
- finally
- bmp.Free;
- end;
- fsave := true;
- end;
- procedure TForm1.mmiCreateClick(Sender: TObject);
- begin
- if fsave <> true then
- begin
- Form4.ShowModal;
- end
- else
- begin
- fopen := false;
- img1.Picture := nil;
- img1.Canvas.FillRect(img1.Canvas.ClipRect);
- img2.Picture := nil;
- img2.Canvas.FillRect(img2.Canvas.ClipRect);
- img3.Picture := nil;
- img3.Canvas.FillRect(img3.Canvas.ClipRect);
- backp := false;
- nextp := false;
- end;
- end;
- procedure TForm1.mmiExitClick(Sender: TObject);
- begin
- if fsave <> true then
- begin
- Form4.ShowModal;
- end;
- if fsave = true then
- form1.Close;
- end;
- procedure TForm1.mmiAboutDeveloperClick(Sender: TObject);
- begin
- Messagedlg('Ïðîãðàììà ðàçðàáîòàíà Áóéêî Âèêòîðèåé, ãð.851002',
- mtInformation,[mbok],0);
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement