Не перерисовывается прямоугольник на Image - Общие вопросы Delphi

artemavd · 22.09.2010, 19:13

Сабж. Не перерисовывается прямоугольник после повторной отрисовки прямоугольника на Image. Код:

Код:


var
  Form1: TForm1;
  Start: Boolean=FALSE;
  Bitmap: TBitmap;
  X1,Y1,X2,Y2: Integer;

...
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    X1:=X;
    Y1:=Y;
    X2:=X;
    Y2:=Y;
    Form1.Image1.Refresh;
    Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2);
    Start:=TRUE
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   If Start Then
    With Form1.Image1.Canvas Do
     Begin
      Pen.Color:=clRed;
      Pen.Mode:=pmNot;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      X2:=X; Y2:=Y;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2)
     End;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Start:=FALSE;
   Form1.Image1.Canvas.Pen.Mode:=pmNot;
//   Form1.Image1.Canvas.Rectangle(X1,Y1,X2,Y2); заливка прямоугольника
end;

dmitriegorovih · 22.09.2010, 19:33

Ну вот смотрите если я вас правильно понял то можно так

Код:

var
  Form1: TForm1;
    Start: Boolean=FALSE;
  Bitmap: TBitmap;
  X1,Y1,X2,Y2: Integer;
implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    X1:=X;
    Y1:=Y;
    X2:=X;
    Y2:=Y;
    Form1.Image1.Refresh;
    Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2);
    Start:=TRUE;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   If Start Then
    With Form1.Image1.Canvas Do
     Begin
      Pen.Color:=clRed;
      Pen.Mode:=pmNot;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      X2:=X; Y2:=Y;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2)
     End;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Start:=FALSE;
   Form1.Image1.Canvas.Pen.Mode:=pmNot;
//   Form1.Image1.Canvas.Rectangle(X1,Y1,X2,Y2); заливка прямоугольника
    form1.Image1.Picture:=nil;
    form1.Image1.Picture.Bitmap:=Tbitmap.Create;
    form1.Image1.Picture.Bitmap.PixelFormat:=pf24bit;
    form1.Image1.Picture.Bitmap.Width:=form1.Image1.Width;
    form1.Image1.Picture.Bitmap.Height:=form1.Image1.Height;
end;

А можно и вот так

Код:

var
  Form1: TForm1;
    Start: Boolean=FALSE;
  Bitmap: TBitmap;
  X1,Y1,X2,Y2: Integer;
implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    X1:=X;
    Y1:=Y;
    X2:=X;
    Y2:=Y;
    Form1.Image1.Refresh;
    Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2);
    Start:=TRUE;
    form1.Image1.Picture:=nil;
    form1.Image1.Picture.Bitmap:=Tbitmap.Create;
    form1.Image1.Picture.Bitmap.PixelFormat:=pf24bit;
    form1.Image1.Picture.Bitmap.Width:=form1.Image1.Width;
    form1.Image1.Picture.Bitmap.Height:=form1.Image1.Height;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   If Start Then
    With Form1.Image1.Canvas Do
     Begin
      Pen.Color:=clRed;
      Pen.Mode:=pmNot;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      X2:=X; Y2:=Y;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2)
     End;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Start:=FALSE;
   Form1.Image1.Canvas.Pen.Mode:=pmNot;
//   Form1.Image1.Canvas.Rectangle(X1,Y1,X2,Y2); заливка прямоугольника
end;

Sibedir · 22.09.2010, 19:53

Может так

Код:

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    With Form1.Image1.Canvas Do begin
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
    end;

    X1:=X;
    Y1:=Y;
    X2:=X;
    Y2:=Y;
    Form1.Image1.Refresh;
    Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2);
    Start:=TRUE
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   If Start Then
    With Form1.Image1.Canvas Do
     Begin
      Pen.Color:=clRed;
      Pen.Mode:=pmNot;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      X2:=X; Y2:=Y;
      MoveTo(X1,Y1); LineTo(X2,Y1); LineTo(X2,Y2); LineTo(X1,Y2); LineTo(X1,Y1);
      Caption:=IntToStr(X1)+','+IntToStr(Y1)+' - '+IntToStr(X2)+','+IntToStr(Y2)
     End;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Start:=FALSE;
   Form1.Image1.Canvas.Pen.Mode:=pmNot;
end;

baster128 · 22.09.2010, 21:16

Все нарисовано вроде. Может быть просто Image.Repaint

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Прямоугольник с тенями	SashaN	Помощь студентам	4	14.05.2010 14:22
C#, прямоугольник	Goldcoding	Фриланс	2	09.04.2010 20:34
Canvas не перерисовывается после того, как зайдёт за границу экрана	TwiX	Мультимедиа в Delphi	10	05.03.2010 10:21
Вопрос по Image (скачанная картинка не хочет выводиться в Image)	Radnor	Мультимедиа в Delphi	2	06.07.2009 02:20
Одно создаваемое в DLL и используемое паралельно с консолью не перерисовывается	lexluther	Win Api	1	21.02.2007 20:28

22.09.2010, 21:16	#4
baster128 Форумчанин Регистрация: 24.04.2010 Сообщений: 205	Все нарисовано вроде. Может быть просто Image.Repaint