Консультация № 195827
10.06.2019, 23:23
0.00 руб.
11.06.2019, 10:16
0 3 1
Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос, пишу курсач, и выходят проблемы с рисованием(рисуется когда зажму и отпускаю, но при сворачивании и разворачивании формы только отрисовывается на Paintbox)
Вот мой код:
[code lang=pascal h=300]
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.[/code]

Обсуждение

давно
Старший Модератор
31795
6196
11.06.2019, 10:21
общий
Адресаты:
ZIp-ните весь проэкт и прикрепите его к сообщению(в низу страницы чуть выше кнопки отправить ).
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

давно
Старший Модератор
31795
6196
11.06.2019, 13:19
общий
Адресаты:
Смотрите в сторону методов refresh,repaint и update.
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

давно
Старший Модератор
31795
6196
15.06.2019, 23:24
общий
это ответ
Здравствуйте, luxv99!

Вы задали свой вопрос в стиле, как не нужно задавать вопросы Правила.
У Вас много компонентов, которые должны быть в "(Object TreeView)=дереве объектов" и каждый из них имеет свой список свойств (Object Property) и событий (Object Event).
Я просил Вас
Цитата: Зенченко Константин Николаевич
ZIp-ните весь проэкт и прикрепите его к сообщению

Простите, но соэдавать вместо Вас Object TreeView, никто не будет, тем более определять Object Property и Object Event.
Вы определили что-то не так, что именно, узнать нельзя, т.к. Вы просто ждали ответа.

При этом проигнорировали:
Цитата: минимум
Две чрезвычайно популярные IDE для визуального программирования с помощью Object Pascal.
Delphi - коммерческая.
Lazaus - OpenSource, бесплатная.
В разных версиях различаются кодировки русского языка:
Delphi 2007 и ниже - Windows1251
Delphi2009 и выше - UTF-16
Lazarus 0.9.26 и выше - UTF-8
Внимание! При подаче вопроса в данную рассылку, не забывайте указывать требуемую среду разработки, вид приложения (консоль, окно), при необходимости - операционную систему. Если данные параметры не указаны, эксперты оставляют за собой право выбирать их на своё усмотрение(по умолчанию - стандарт языка Pascal).

Вы не упомянули, что у Вас Delphi XE+.

Удачи Вам!
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

Форма ответа