графический редактор

unit Unit4;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, jpeg, Buttons, Menus, sDialogs,
  sPanel, sUpDown, sEdit, sStatusBar, sBevel, ColorGrd, sScrollBox,
  ExtDlgs, sSpeedButton, sLabel;
type
  TForm4 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    sPanel1: TsPanel;
    sPanel2: TsPanel;
    sSpeedButton1: TsSpeedButton;
    sSpeedButton2: TsSpeedButton;
    sSpeedButton3: TsSpeedButton;
    sSpeedButton4: TsSpeedButton;
    sSpeedButton5: TsSpeedButton;
    sSpeedButton6: TsSpeedButton;
    sSpeedButton7: TsSpeedButton;
    sSpeedButton8: TsSpeedButton;
    sOpenPictureDialog1: TsOpenPictureDialog;
    sSavePictureDialog1: TsSavePictureDialog;
    sScrollBox1: TsScrollBox;
    sPanel6: TsPanel;
    ColorGrid1: TColorGrid;
    sBevel1: TsBevel;
    sPanel5: TsPanel;
    sPanel3: TsPanel;
    sPanel4: TsPanel;
    sStatusBar1: TsStatusBar;
    sEdit1: TsEdit;
    sUpDown1: TsUpDown;
    o: TMenuItem;
    N33: TMenuItem;
    N7: TMenuItem;
    N52: TMenuItem;
    N13: TMenuItem;
    N10: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N5: TMenuItem;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    sLabel1: TsLabel;
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure supdown1Click(Sender: TObject; Button: TUDBtnType);
    procedure ColorGrid1Change(Sender: TObject);
    procedure sSpeedButton1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sSpeedButton2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sSpeedButton3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sSpeedButton4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sSpeedButton5MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sSpeedButton6MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sSpeedButton7MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sSpeedButton8MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sedit1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ColorGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure spanel5MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure spanel3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sedit1Change(Sender: TObject);
    procedure image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sSpeedButton5Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure sSpeedButton6Click(Sender: TObject);
    procedure sSpeedButton8Click(Sender: TObject);
    procedure sSpeedButton7Click(Sender: TObject);
    procedure sSpeedButton4Click(Sender: TObject);
    procedure sSpeedButton1Click(Sender: TObject);
    procedure sSpeedButton3Click(Sender: TObject);
    procedure sSpeedButton2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N13Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form4   : TForm4;
  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 TForm4.FormCreate(Sender: TObject); // Область рисования
begin
  fsave := true;
  image1.Canvas.FillRect(image1.Canvas.ClipRect);  //Заполняет пpямоугольник, используя кисть Brush, до пpавой и нижней гpаниц, прямоугольник, на котором происходит графический вывод.
  image2.Canvas.FillRect(image2.Canvas.ClipRect);
  image3.Canvas.FillRect(image3.Canvas.ClipRect);
end;
 
procedure TForm4.N2Click(Sender: TObject);
begin
   image1.AutoSize := true; //Свойство AutoSize  вкл
   fopen := true;
   sOpenPictureDialog1.Execute;
   image1.Picture.LoadFromFile(sOpenPictureDialog1.FileName); //Загрузка изображения
   fname := sOpenPictureDialog1.FileName;
   image1.AutoSize := false; //AutoSize image'a выкл
end;
 
procedure TForm4.supdown1Click(Sender: TObject; Button: TUDBtnType);
begin
  if not sSpeedButton5.Down then
  begin
    front := StrToInt(sedit1.Text);
    if front <> 0 then
    begin
    if Button = btprev then
     begin
       dec(front);
       if front = 0 then
        front := 1;
      sedit1.Text := IntToStr(front);
     end;
     if Button = btnext then
     begin
       Inc(front);
       sedit1.Text := IntToStr(front);
     end;
    end;
  end;
end;
 
procedure TForm4.colorgrid1Change(Sender: TObject);
begin
  spanel5.Color := colorgrid1.ForegroundColor;
  spanel3.color := colorgrid1.BackgroundColor;
end;
 
procedure TForm4.sSpeedButton1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].Text := 'Стирание части рисунка с помощью '+
                           'ластика выбраного цвета';
end;
 
procedure TForm4.sSpeedButton2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].Text := 'Заполнение области одним из текущих цветов';
end;
 
procedure TForm4.sSpeedButton3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].text := 'Выбор цветов из имеющихся на рисунке';
end;
 
procedure TForm4.sSpeedButton4MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.panels[0].text := 'Проведение прямой линии выбраной толщины';
end;
 
procedure TForm4.sSpeedButton5MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].Text := 'Проведение произвольной линии толщиной в одну точку';
end;
 
procedure TForm4.sSpeedButton6MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.panels[0].text := 'Рисование кистью выброной толщины';
end;
 
procedure TForm4.sSpeedButton7MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].Text := 'Рисование эллипса';
end;
 
procedure TForm4.sSpeedButton8MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].text := 'Рисование прямоугольника';
end;
 
procedure TForm4.sedit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].text := 'Выбор толщины ';
end;
procedure TForm4.colorgrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].Text := 'Выбор цветов';
end;
 
procedure TForm4.spanel5MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].Text := 'Цвет левой кнопки мыши';
end;
 
procedure TForm4.spanel3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  sstatusbar1.Panels[0].Text := 'Цвет правой кнопки мыши';
end;
 
procedure TForm4.image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 sstatusbar1.Panels[0].Text := 'Область для рисования';
  sstatusbar1.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 sSpeedButton1.Down then
    begin
      image1.Canvas.Pen.color:=spanel3.Color;
      image1.Canvas.pen.Width:=strtoint((sedit1.text));
      Image1.Canvas.lineto(x,y);
    end;
 
    if sSpeedButton5.down then
    begin
      if mb = 'l' then
       image1.Canvas.Pen.Color := spanel5.Color
      else
       image1.Canvas.Pen.Color := spanel3.Color;
      image1.Canvas.LineTo(x,y);
    end;
 
    if sSpeedButton6.Down then
    begin
      image1.canvas.Pen.Width := strtoint(sedit1.Text);
      if mb = 'l' then
       image1.Canvas.Pen.Color := spanel5.Color
      else
       image1.Canvas.Pen.Color := spanel3.Color;
      image1.canvas.lineto(x,y);
    end;
 
    if sSpeedButton4.down then
    begin
      image1.picture.Assign(image2.picture);
      if mb = 'l' then
       Image1.Canvas.Pen.color := spanel5.Color
      else
       Image1.Canvas.Pen.color := spanel3.Color;
      Image1.Canvas.Pen.width := strtoint(sedit1.text);
      Image1.Canvas.moveto(x,y);
      Image1.Canvas.lineto(x1,y1);
    end;
 
    if sSpeedButton7.Down then
    begin
      image1.picture.Assign(image2.picture);
      image1.Canvas.pen.Width := strtoint(sedit1.text);
      if mb = 'r' then
       image1.Canvas.Pen.color := spanel3.Color
      else
 
       image1.Canvas.Brush.Style := bsSolid;
      Image1.Canvas.ellipse(x,y,x1,y1);
    end;
 
    if sSpeedButton8.Down then
    begin
      image1.picture.Assign(image2.picture);
      image1.Canvas.pen.Width := strtoint(sedit1.text);
      if mb = 'r' then
       image1.Canvas.Pen.color := spanel3.Color
      else
 
       image1.Canvas.Brush.Style := bsSolid;
      image1.Canvas.Rectangle(x,y,x1,y1);
    end;
 
 end;
  x2 := x;
  y2 := y;
end;
 
procedure TForm4.image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if sSpeedButton2.Down then
    begin
      if button = mbRight then
       Image1.Canvas.brush.color := spanel3.Color
      else
       Image1.Canvas.brush.color := spanel5.Color;
      Image1.Canvas.FloodFill(x, y,Image1.Canvas.Pixels[x,y], fssurface);
    end;
 
    if sSpeedButton3.Down then
    begin
      if button = mbRight then
       spanel3.Color := Image1.Canvas.pixels[x,y]
      else
       spanel5.color := Image1.Canvas.pixels[x,y];
    end;
end;
 
procedure TForm4.image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  image2.picture.Assign(image1.Picture);
  x1 := x;
  y1 := y;
  if button = mbRight then
   mb := 'r'
  else
   mb := 'l';
  image1.Canvas.MoveTo(x,y);
  Image1MouseMove(Sender,Shift,X,Y);
end;
 
procedure TForm4.sedit1Change(Sender: TObject);
begin
  fat := strtoint(sedit1.text);
  if not sSpeedbutton5.Down then
   image1.Canvas.Pen.Width := fat;
 
   If sedit1.text='0' then Messagedlg('Толщина не может быть равна 0!',
mtInformation,[mbok],0);
   If sedit1.text='0' then sEdit1.Text := '1';
 
end;
 
procedure TForm4.sSpeedButton5Click(Sender: TObject);
begin
  image1.Canvas.Pen.Width := 1;
  slabel1.Visible := false;
  sedit1.Visible := false;
 
 
end;
 
procedure TForm4.N10Click(Sender: TObject);
begin
  if backp = true then
  begin
    image3.picture.Assign(image1.Picture);
    image1.picture.Assign(image2.Picture);
    nextp := true;
  end;
  backp := false;
end;
 
procedure TForm4.N8Click(Sender: TObject);
begin
  if nextp = true then
  begin
    image2.Picture.Assign(image1.Picture);
    image1.Picture.Assign(image3.Picture);
    backp := true;
  end;
  nextp := false;
end;
 
procedure TForm4.N1Click(Sender: TObject);
begin
  if fsave <> true then
  begin
    //Form4.ShowModal;
  end
  else
  begin
    fopen := false;
    image1.Picture := nil;
    image1.Canvas.FillRect(image1.Canvas.ClipRect);
    image2.Picture := nil;
    image2.Canvas.FillRect(image2.Canvas.ClipRect);
    image3.Picture := nil;
    image3.Canvas.FillRect(image3.Canvas.ClipRect);
    backp := false;
    nextp := false;
  end;
end;
 
 
 
procedure TForm4.sSpeedButton6Click(Sender: TObject);
begin
  slabel1.Visible := true;
  sedit1.Visible := true;
  supdown1.Visible := true;
 
end;
 
procedure TForm4.sSpeedButton8Click(Sender: TObject);
begin
  slabel1.Visible := true;
  sedit1.Visible := true;
  supdown1.Visible := true;
 
 
end;
 
procedure TForm4.sSpeedButton7Click(Sender: TObject);
begin
   slabel1.Visible := true;
  sedit1.Visible := true;
  supdown1.Visible := true;
 
end;
 
procedure TForm4.sSpeedButton4Click(Sender: TObject);
begin
   slabel1.Visible := true;
  sedit1.Visible := true;
  supdown1.Visible := true;
 
end;
 
procedure TForm4.sSpeedButton1Click(Sender: TObject);
begin
   slabel1.Visible := true;
  sedit1.Visible := true;
  supdown1.Visible := true;
 
end;
 
procedure TForm4.sSpeedButton3Click(Sender: TObject);
begin
   slabel1.Visible := true;
  sedit1.Visible := true;
  supdown1.Visible := true;
 
end;
 
procedure TForm4.sSpeedButton2Click(Sender: TObject);
begin
   slabel1.Visible := true;
  sedit1.Visible := true;
  supdown1.Visible := true;
 
end;
 
procedure TForm4.N3Click(Sender: TObject);
var
  bmp:  TBitmap;
begin
  if fopen then
   begin
      try
         bmp := TBitmap.Create;
         bmp.Assign(image1.Picture);
         bmp.SaveTofile(ChangeFileExt(fname, '.bmp'));
      finally
         bmp.Free;
      end;
   end
  else
   begin
     sSavePictureDialog1.Execute;
     try
        bmp := TBitmap.Create;
        bmp.Assign(image1.Picture);
        bmp.SaveTofile(ChangeFileExt(sSavePictureDialog1.FileName, '.bmp'));
     finally
        bmp.Free;
     end;
     fopen := true;
   end;
   fsave := true;
end;
 
procedure TForm4.N7Click(Sender: TObject);
var
  bmp: TBitmap;
begin
  sOpenPictureDialog1.Execute;
  try
    bmp := TBitmap.Create;
    bmp.Assign(image1.Picture);
    bmp.SaveTofile(ChangeFileExt(sSavePictureDialog1.FileName, '.bmp'));
  finally
    bmp.Free;
  end;
  fsave := true;
end;
 
procedure TForm4.N4Click(Sender: TObject);
begin
  if fsave <> true then
  begin
    //Form4.ShowModal;
  end
  else
  begin
    fopen := false;
    image1.Picture := nil;
    image1.Canvas.FillRect(image1.Canvas.ClipRect);
    image2.Picture := nil;
    image2.Canvas.FillRect(image2.Canvas.ClipRect);
    image3.Picture := nil;
    image3.Canvas.FillRect(image3.Canvas.ClipRect);
    backp := false;
    nextp := false;
  end;
end;
 
procedure TForm4.N5Click(Sender: TObject);
begin
 if fsave <> true then
  begin
    //Form4.ShowModal;
  end;
  if fsave = true then
   form4.Close;
end;
 
procedure TForm4.N13Click(Sender: TObject);
begin
Messagedlg('Paint версия 3.3. Автор: Saitov M.U.  ',
mtInformation,[mbok],0);
end;
    
 
 
end.