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

type
  TForm1 = class(TForm)
    SBBrush: TSpeedButton;
    SBColor: TSpeedButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    MOpen: TMenuItem;
    MSave: TMenuItem;
    MPravka: TMenuItem;
    Undo: TMenuItem;
    MExit: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Image4: TImage;
    SBPen: TSpeedButton;
    SBRect: TSpeedButton;
    SBRectang: TSpeedButton;
    SBFillRec: TSpeedButton;
    SBErase: TSpeedButton;
    SBLine: TSpeedButton;
    SavePictureDialog1: TSavePictureDialog;
    MCopy: TMenuItem;
    MPaste: TMenuItem;
    MAbout: TMenuItem;
    MCut: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MOpenClick(Sender: TObject);
    procedure UndoClick(Sender: TObject);
    procedure SBBrushClick(Sender: TObject);
    procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MCopyClick(Sender: TObject);
    procedure MPasteClick(Sender: TObject);
    procedure MSaveClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
BitMap, BMCopy:TBitMap;
R, R0:TRect;
X0,Y0,X1,Y1:longint;
RBegin, REnd, RDrag, MCut:boolean;
 
implementation
 
{$R *.dfm}
 
 
procedure TForm1.FormCreate(Sender: TObject);
var
HW,I:integer;
begin
BitMap:=TBitMap.Create;
Image1.Canvas.Brush.Color:=clBlack;
Image2.Canvas.Brush.Color:=clWhite;
with Image1.Canvas do FillRect(Rect(0,0,Width,Height));
with Image2.Canvas do FillRect(Rect(0,0,Width,Height));
HW:=Image4.Width div 10;
with Image4.Canvas do
begin
for I:=1 to 10 do
case I of
 1: Brush.Color:=clBlack;
 2: Brush.Color:=clAqua;
 3: Brush.Color:=clBlue;
 4: Brush.Color:=clFuchsia;
 5: Brush.Color:=clGreen;
 6: Brush.Color:=clLime;
 7: Brush.Color:=clMaroon;
 8: Brush.Color:=clRed;
 9: Brush.Color:=clYellow;
 10: Brush.Color:=clWhite;
end;
Rectangle((I-1)*HW,0,I*HW,Height);
end;
with Image3 do
begin
 Canvas.MoveTo(0,0);
 Canvas.LineTo(Width,Height);
 Canvas.MoveTo(0,Height);
 Canvas.LineTo(Width,0);
end;
BitMap.Assign(Image3.Picture);
end;
 
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
BitMap.Free;
end;
 
procedure TForm1.MOpenClick(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
 begin
  Image3.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  BitMap.Assign(Image3.Picture);
end;
end;
 
procedure TForm1.UndoClick(Sender: TObject);
begin
Image3.Picture.Assign(BitMap);
end;
 
procedure TForm1.SBBrushClick(Sender: TObject);
begin
if (Sender as TSpeedButton).Down then
BitMap.Assign(Image3.Picture);
 RBegin := false;
  RDrag := false;
  REnd := false;
end;
 
procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (Sender = Image4) or SBColor.Down then
begin
if (Button = mbLeft) then
with Image1.Canvas do
begin
Brush.Color:=(Sender as TImage).Canvas.Pixels[X,Y];
FillRect(rect(0,0,Width,Height));
end
else
with Image2.Canvas do
begin
Brush.Color:=(Sender as TImage).Canvas.Pixels[X,Y];
FillRect(Rect(0,0,Width,Height));
end;
end
else
With Image3.Canvas do
begin
X0:=x;
Y0:=Y;
if SBpen.Down then
begin
MoveTo(X,Y);
Pen.Color:=Image1.Canvas.Brush.Color;
end
else if SBLine.Down then
begin
X1:=X;
Y1:=Y;
Pen.Mode:=pmNotXor;
Pen.Color:=Image1.Canvas.Brush.Color;
end
else if SBBrush.Down then
begin
if
Button = mbLeft then
Brush.Color:=Image1.Canvas.Brush.Color
else
Brush.Color:=Image2.Canvas.Brush.Color;
FloodFill(X,Y,Pixels[X,Y],fsSurface);
end
else if SBErase.Down then
begin
R:=Rect(X-6,Y-6,X+6,Y+6);
DrawFocusRect(R);
Brush.Color:=Image2.Canvas.Brush.Color;
FillRect(Rect(X-5,Y-5,X+5,Y+5));
end
else if SBRect.Down or SBrectang.Down or SBFillRec.Down then
begin
if REnd then
begin
DrawFocusRect(R);
if (x>R.Left) and (X<R.Right) and (Y>R.Top) and (Y<R.Bottom) then
begin
RDrag:=true;
REnd:=false;
R0.TopLeft:=R.TopLeft;
R0.BottomRight:=R.BottomRight;
BitMap.Assign(Image3.Picture);
Brush.Color:=Image2.Canvas.Brush.Color;
MCopy.Enabled:=false;
MCut.Enabled:=false;
end;
end
else
begin
RBegin:=true;
REnd:=false;
R.TopLeft:=Point(X,Y);
R.BottomRight:=Point(X,Y);
DrawFocusRect(R);
end;
end;
end;
 
end;
 
procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if not (ssLeft in Shift) then
 exit;
 if SBLine.Down then
  with Image3.Canvas do
  begin
   MoveTo(X0,Y0);
   LineTo(X1,Y1);
   MoveTo(X0,Y0);
   LineTo(X,Y);
   X1:=X;
   Y1:=Y;
  end
 else if SBPen.Down then
    Image3.Canvas.LineTo(X, Y)
 else if SBErase.Down then
  with Image3.Canvas do
  begin
 DrawFocusRect(R);
 R := Rect(X - 6, Y - 6, X + 6, Y + 6);
 DrawFocusRect(R);
 FillRect(Rect(X - 5, Y - 5, X + 5, Y + 5));
   end
  else if (SBRect.Down and (RBegin or RDrag)) or
    SBRectang.Down or SBFillRec.Down then
    with Image3.Canvas do
    begin
      if RBegin then
      begin
        DrawFocusRect(R);
        if X0 < X then
        begin
          R.Left := X0;
          R.Right := X
        end
        else
        begin
          R.Left := X;
          R.Right := X0
        end;
        if Y0 < Y then
        begin
          R.Top := Y0;
          R.Bottom := Y
        end
        else
        begin
          R.Top := Y;
          R.Bottom := Y0
        end;
        DrawFocusRect(R);
      end
      else if SBRect.Down then
      begin
CopyRect(R, BitMap.Canvas, R);
if not (ssCtrl in Shift) then FillRect(R0);
 R.Left := R.Left + X - X0;
 R.Right := R.Right + X - X0;
 R.Top := R.Top + Y - Y0;
 R.Bottom := R.Bottom + Y - Y0;
X0 := X;
Y0 := Y;
CopyRect(R, BitMap.Canvas, R0);
DrawFocusRect(R);
end;
end;
end;
 
 
procedure TForm1.Image3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Image3.Canvas do
  begin
    if SBLine.Down then
    begin
      MoveTo(X0, Y0);
      LineTo(X1, Y1);
      Pen.Mode := pmCopy;
      MoveTo(X0, Y0);
      LineTo(X, Y);
    end
    else if SBRect.Down then
    begin
      if RDrag then
        DrawFocusRect(R);
      if RBegin and not REnd then
      begin
        REnd := true;
        MCopy.Enabled := true;
        MCut.Enabled := true;
      end
    end
    else if SBRectang.Down then
    begin
      Brush.Color := Image1.Canvas.Brush.Color;
      FrameRect(R);
    end
    else if SBFillRec.Down then
    begin
      Brush.Color := Image2.Canvas.Brush.Color;
      Pen.Color := Image1.Canvas.Brush.Color;
      Rectangle(R.Left, R.Top, R.Right, R.Bottom);
    end
    else if
      SBErase.Down then
      Image3.Canvas.DrawFocusRect(R);
    RBegin := false;
    RDrag := false;
  end;
end;
 
procedure TForm1.MCopyClick(Sender: TObject);
 var
MyFormat: Word;
AData: THandle;
APalette: HPALETTE;
begin
  Image3.Canvas.DrawFocusRect(R);
  BMCopy := BitMap.Create;
  BMCopy.Width := R.Right - R.Left;
  BMCopy.Height := R.Bottom - R.Top;
  try
    BMCopy.Canvas.Copyrect(Rect(0, 0, BMCopy.Width, BMCopy.Height), Image3.Canvas, R);
    Image3.Canvas.DrawFocusRect(R);
    BMCopy.SaveToClipBoardFormat(MyFormat,AData,APalette);
    //ClipBoard.SetAsHandle(MyFormat,AData);
    //ClipBoard.Assign(BMCopy);
    if (Sender as TMenuItem).Name = 'MCut' then
    begin
      Image3.Canvas.Brush.Color := clWhite;
      Image3.Canvas.FillRect(R);
    end;
  finally
    BMCopy.Free;
  end;
end;
 
procedure TForm1.MPasteClick(Sender: TObject);
begin
  BMCopy := BitMap.Create;
  try
    try
    //  BMCopy.LoadFromClipBoardFormat(cf_BitMap,
        //ClipBoard.GetAsHandle(cf_Bitmap), 0);
    //  Image3.Canvas.CopyRect(Rect(0, 0, BMCopy.Width, BMCopy.Height),
     //   BMCopy.Canvas, Rect(0, 0, BMCopy.Width, BMCopy.Height));
    finally
      BMCopy.Free;
    end;
  except
    on EInvalidGraphic do
      ShowMessage('Ошибочный формат графики');
  end;
end;
 
procedure TForm1.MSaveClick(Sender: TObject);
begin
  if SavePictureDialog1.Execute then
  begin
    BitMap.Assign(Image3.Picture);
    BitMap.SaveToFile(SavePictureDialog1.FileName);
  end;
end;
 
end.