Пользователь
Регистрация: 28.12.2018
Сообщений: 11
|
Графический редактор
Здравствуйте, чего не хватает, когда рисую в проекте не обновляется автоматически рисование линий и прочего, а когда сверну проект и опять разверну.
Приложил проект внизу, если несложно, помогите, пожалуйста, заранее благодарен.
Если лень качать, то вот код:
Код:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Menus, Vcl.ExtDlgs,
Vcl.StdCtrls, Vcl.Buttons;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
pic: TPaintBox;
SavePictureDialog1: TSavePictureDialog;
OpenPictureDialog1: TOpenPictureDialog;
ColorDialog1: TColorDialog;
ColorBox1: TColorBox;
Panel1: TPanel;
PencilButton: TSpeedButton;
LineButton: TSpeedButton;
RectButton: TSpeedButton;
FloodFillButton: TSpeedButton;
DeleteButton: TSpeedButton;
ColorDelete: TSpeedButton;
sizeplace: TEdit;
Label1: TLabel;
EllipseButton: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure ColorBox1MouseUp(Sender: TObject);
procedure ColorBox1OnPaint(Sender: TObject);
procedure picPaint(Sender: TObject);
procedure picMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure picMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
var bmp,bmp1,bmp2,bmp3: tbitmap;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
c: boolean;
d: integer;
cl: integer;
x0,y0,x2,y2,x3,y3: integer;
var press: boolean;
implementation
{$R *.dfm}
procedure TForm1.ColorBox1MouseUp(Sender: TObject);
begin
if ColorDialog1.Execute then
begin
bmp.Canvas.Pen.Color := ColorDialog1.Color;
end
else
begin
bmp.Canvas.Brush.Color := ColorDialog1.Color;
cl:=bmp.canvas.Brush.Color;
end;
end;
procedure TForm1.ColorBox1OnPaint(Sender: TObject);
begin
Brush.Color := cl;
Pic.Canvas.Rectangle(15, 15, 35, 35);
Brush.Color := bmp.Canvas.Pen.Color;
Pic.Canvas.Rectangle(5, 5, 25, 25);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
c:=false; d:=1;
bmp:= Tbitmap.Create;
bmp1:=Tbitmap.Create;
bmp2:=Tbitmap.Create;
bmp3:=Tbitmap.Create;
bmp.Width:=800;
bmp.Height:=600;
bmp1.Width:=bmp.Width;
bmp1.Height:=bmp.Height;
bmp2.Width:=6;
bmp2.Height:=6;
bmp2.canvas.Pen.Color:=clblack;
bmp2.Canvas.Brush.Color:=clwhite;
bmp2.Canvas.Brush.Style:=bssolid;
bmp2.Canvas.Rectangle(0,0,6,6);
with pic do
begin
Width := bmp.Width; Height := bmp.Height;
Left := 0; Top := 0;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmp.Free;
bmp1.Free;
bmp2.Free;
bmp3.Free
end;
procedure TForm1.N2Click(Sender: TObject);
begin
bmp.free;
bmp:= Tbitmap.Create;
bmp.Width:=800;
bmp.Height:=600;
with pic do
begin
Width := bmp.Width;
Height := bmp.Height;
Left := 0; Top := 0;
bmp.Canvas.pixels[1,1]:=clwhite;
Pic.Canvas.Draw ( 0, 0, bmp )
end;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
if SavePictureDialog1.Execute then
begin
bmp.SaveToFile(SavePictureDialog1.Filename);
Form1.Caption := SavePictureDialog1.Filename;
end;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
bmp.free;
bmp:=TBitMap.Create;
bmp.LoadFromFile(OpenPictureDialog1.Filename);
pic.height:=bmp.height;
pic.width:=bmp.width;
Form1.Caption := OpenPictureDialog1.Filename;
end;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
close;
end;
procedure TForm1.N8Click(Sender: TObject);
var fmt: TForm;
begin
fmt:=CreateMessageDialog('Графический редактор. Разработал: Юкович Е.А.',mtInformation,[mbOk]);
fmt.ShowModal;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
bmp.free;
bmp:= Tbitmap.Create;
bmp.Width:=800;
bmp.Height:=600;
with pic do
begin
Width := bmp.Width;
Height := bmp.Height;
Left := 0; Top := 0;
bmp.Canvas.pixels[1,1]:=clwhite;
end;
end;
procedure TForm1.picMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
press:=true;
x0:=x;
y0:=y;
x2:=x;
y2:=y;
bmp.Canvas.Moveto(x,y);
c:=true;
if (LineButton.Down)or (RectButton.Down) or (EllipseButton.Down)then
begin
bmp.Canvas.Pen.Mode:=pmnotxor;
end;
end;
procedure TForm1.picMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
x3:=x;y3:=y;
if not Press then
begin
if (ColorDelete.Down=true) or (DeleteButton.Down=True) then
begin
Pic.Canvas.Draw(0,0,bmp);
Pic.Canvas.Draw(x-3,y-3,bmp2)
end;
Exit
end;
if RectButton.Down then
begin
bmp.Canvas.Brush.Style:=bssolid;
bmp.Canvas.Rectangle(x0,y0,x,y);
x2:=x;y2:=y;
bmp.Canvas.Brush.Style:=bsSolid;
end;
if EllipseButton.Down then
begin
bmp.Canvas.Brush.Style:=bsClear;
bmp.Canvas.Ellipse(x0,y0,x2,y2);
bmp.Canvas.Ellipse(x0,y0,x,y);
x2:=x;y2:=y;
bmp.Canvas.Brush.Style:=bsSolid;
end;
if PencilButton.Down then bmp.Canvas.LineTo(x,y);
if DeleteButton.Down then
begin
with bmp.Canvas do
begin
Pen.Color:=clWhite;
LineTo(x,y)
end;
end;
if ColorDelete.Down then
begin
bmp1.Transparent:=true;
bmp1.Canvas.CopyRect(Rect(0,0,bmp1.width,bmp1.Height),bmp.Canvas,Rect(0,0,bmp.Width,bmp.height));
bmp1.transparentcolor:=colordialog1.Color;
with bmp.Canvas do
begin
pen.Mode:=pmCopy;
pen.Color:=clWhite;
pen.Color:=clWhite;
pen.Width:=2;
lineto(x,y);
end;
bmp.Canvas.Draw(0,0,bmp1);
end;
if LineButton.Down then
begin
with bmp.Canvas do
begin
moveto(x0,y0);lineto(x2,y2);
moveto(x0,y0);lineto(x,y);
x2:=x;y2:=y;
end;
end;
end;
procedure TForm1.picPaint(Sender: TObject);
begin
Pic.Canvas.Draw (0 , 0 , bmp);
end;
end.
Последний раз редактировалось Evgeny20; 10.06.2019 в 20:51.
|