Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.06.2019, 20:33   #1
Evgeny20
Пользователь
 
Регистрация: 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.
Вложения
Тип файла: rar граф. редактор.rar (3.30 Мб, 15 просмотров)

Последний раз редактировалось Evgeny20; 10.06.2019 в 20:51.
Evgeny20 вне форума Ответить с цитированием
Старый 10.06.2019, 20:38   #2
Evgeny20
Пользователь
 
Регистрация: 28.12.2018
Сообщений: 11
По умолчанию

Прошу прощения, забыл пересохранить файл с кодом
Вложения
Тип файла: rar граф. редактор.rar (3.30 Мб, 17 просмотров)
Evgeny20 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
графический редактор fawr Visual C++ 4 26.01.2012 01:03
графический редактор BOKUBOH Помощь студентам 0 30.03.2011 21:31
Графический редактор для веб. Ёпрст! Фриланс 4 16.03.2010 15:58
Графический редактор Alex2009 Мультимедиа в Delphi 8 26.11.2009 00:43
Графический редактор kommunist Общие вопросы .NET 1 13.01.2008 21:57