unit Unit1_o;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, ExtDlgs;
type
  TForm1_o = class(TForm)
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    Button2: TButton;
    ColorDialog1: TColorDialog;
    ColorDialog2: TColorDialog;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Edit1: TEdit;
    UpDown1: TUpDown;
    Edit2: TEdit;
    Image2: TImage;
    RadioGroup2_style_brash: TRadioGroup;
    RadioGroup2_Style_line: TRadioGroup;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel1: TPanel;
    Panel2: TPanel;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    Button6: TButton;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
   
    
  private
    { Private declarations }
    isEraser, UseEraser: Boolean;
  public
    { Public declarations }
  end;
var
  Form1_o: TForm1_o;
implementation
uses Unit1;
{$R *.dfm}
var x1,y1,x2,y2:integer;
procedure ris(xs, ys, X, Y: Integer; cv: TCanvas);
var
   a, b: Integer;
   pts : array of TPoint;
begin
     a := (x - xs) div 2;
     b := a div 2;
 
     SetLength(pts, 18);
with cv do
          begin
               pts[ 0] := Point(X - a - b, Y - b);
               pts[ 1] := Point(X - b, Y - b);
               pts[ 2] := Point(X - b, Y - a - b);
               pts[ 3] := Point(X - a, Y - a - b);
               pts[ 4] := Point(X, Y - 2 * a - b);
               pts[ 5] := Point(X + a, Y - a - b);
               pts[ 6] := Point(X + b, Y - a - b);
               pts[ 7] := Point(X + b, Y - b);
               pts[ 8] := Point(X + a + b, Y - b);
               pts[ 9] := Point(X + a + b, Y - a);
               pts[10] := Point(X + 2 * a + b, Y);
               pts[11] := Point(X + a + b, Y + a);
               pts[12] := Point(X + a + b, Y + b);
               pts[13] := Point(X - a - b, Y + b);
               pts[14] := Point(X - a - b, Y + a);
               pts[15] := Point(X - 2 * a - b, Y);
               pts[16] := Point(X - a - b, Y - a);
               pts[17] := pts[0];
    Polygon(pts);
          end;
    SetLength(pts, 0);
end;
procedure linia(x,y:integer;cv:TCanvas);
var dx,dy:integer;
begin
with cv do
          begin
               moveto(x1,y1);
               lineto(x,y);
          end;
end;
procedure p_liniya(X, Y: Integer; cv: TCanvas);
var
   x1, y1, x2, y2 : Integer;
function CreatePen(wid: Integer; Color: TColor) : THandle;
var
   User_Style: array [0 .. 3] of Integer;
var
   Log_Brush: TLogBrush;
begin
     User_Style[0] := wid div 2;
     User_Style[1] := wid * 2;
     User_Style[2] := wid * 4;
     User_Style[3] := wid * 2;
 
     Log_Brush.lbColor := Color;
     Log_Brush.lbStyle := BS_SOLID;
     Log_Brush.lbHatch := 0;
     Result := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE, wid, Log_Brush,
      4, @User_Style);
end;
begin
     x1 := X ;
     y1 := Y ;
     x2 := X ;
     y2 := Y ;
with cv do
          begin
               cv.Pen.Handle:= CreatePen(StrToInt(Form1_o.Edit2.Text), Form1_o.ColorDialog1.Color);
          try
               MoveTo(x1, y1);
               LineTo(x2, y2);
          finally
               DeleteObject(cv.Pen.Handle);
          end;
end;
end;
procedure TForm1_o.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     if isEraser
     then
         begin
              Image1.Canvas.Brush.Color:=clWhite;
              Image1.Canvas.Brush.Style:=bsSolid;
              UseEraser:=True;
         end
     else
         begin
              x1:=x;
              y1:=y;
with Image1, Image2, Canvas do
                              begin
                                   rectangle(0,0, width,height)
                              end;
         end;
end;
procedure TForm1_o.RadioGroup1Click(Sender: TObject);
begin
     if   RadioGroup1.ItemIndex=4
     then Edit1.Enabled:=true
     else Edit1.Enabled:=false;
end;
procedure TForm1_o.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  
const bs : array[0 .. 3] of TBrushStyle = (bsSolid, bsBDiagonal, bsVertical, bsHorizontal);
  
function CreatePen(wid: Integer; Color: TColor): THandle;
var  User_Style: array [0 .. 3] of Integer;
     Log_Brush: TLogBrush;
begin
     User_Style[0] := wid div 2;
     User_Style[1] := wid * 2;
     User_Style[2] := wid * 4;
     User_Style[3] := wid * 2;
 
     Log_Brush.lbColor := Color;
     Log_Brush.lbStyle := BS_SOLID;
     Log_Brush.lbHatch := 0;
     Result := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE, wid, Log_Brush, 4,
      @User_Style);
end;
begin
     if UseEraser then
     begin
          UseEraser := false;
          Exit;
     end;
with (Sender as TImage).Canvas do
     begin
          Pen.width := StrToInt(Edit2.Text);
         
          if RadioGroup2_Style_line.ItemIndex = 0
          then Pen.Style := psSolid
          else Pen.Handle := CreatePen(StrToInt(Edit2.Text), ColorDialog1.Color);
 
    // Стиль заливки
    Brush.Style := bs[RadioGroup2_style_brash.ItemIndex];
    case RadioGroup1.ItemIndex of
      0: linia(X, Y, Image1.Canvas);
      1: rectangle(x1, y1, X, Y);
      2: Ellipse(x1, y1, X, Y);
      3: ris(x1, y1, x, y, Image1.Canvas);
      4: Begin
           Font.Size := StrToInt(Edit2.Text);
           TextOut(X, Y, '' + Edit1.Text);
         end;
    end;
 
    
    if RadioGroup2_Style_line.ItemIndex = 1 then
      DeleteObject(Pen.Handle);
  end;
end;
procedure TForm1_o.Button1Click(Sender: TObject);
begin
     if ColorDialog1.Execute then
     begin
         
          Image1.Canvas.Font.Color:=ColorDialog1.Color;
          Panel1.Color:=ColorDialog1.Color;
          Image1.Canvas.Pen.Color:=ColorDialog1.Color;
          Panel1.Color:=ColorDialog1.Color;
     end;
end;
procedure TForm1_o.Button2Click(Sender: TObject);
begin
     if ColorDialog2.Execute then
     begin
          image1.Canvas.Brush.Color:=ColorDialog2.Color;
          panel2.Color:=ColorDialog2.Color;
     end;
end;
procedure TForm1_o.Button5Click(Sender: TObject);
var    Bitmap: TBitmap;
begin
       Bitmap:=nil;
try
       Bitmap:=Tbitmap.Create;
       Bitmap.Width:=833;
       Bitmap.Height:=609;
       Image1.Picture.Graphic:=Bitmap;
finally
       Bitmap.Free;
       end;
end;
procedure TForm1_o.FormCreate(Sender: TObject);
begin
     Screen.Cursors[5] := LoadCursorFromFile('Eraser.cur');
end;
procedure TForm1_o.SpeedButton1Click(Sender: TObject);
begin
     if   isEraser
     then Image1.Cursor := 1
     else Image1.Cursor := 5;
          isEraser := not isEraser
end;
procedure TForm1_o.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var wid: Integer;
begin
     if UseEraser
     then  
     begin
          wid:=StrToInt(Edit2.Text) div 2;
        
          Image1.Canvas.FillRect(Rect(X-wid, Y-wid, X+wid, Y+wid));
     end;
end;
procedure TForm1_o.Button3Click(Sender: TObject);
begin
    if OpenPictureDialog1.Execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
procedure TForm1_o.Button4Click(Sender: TObject);
begin
    if SavePictureDialog1.Execute then
  begin
    Image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.bmp');
  end
end;
end.