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.