[kaktusad]

Вопрос, думаю, очень легкий, но прошу мне помочь, не могу ни как разобраться.
Есть компонент PaintBox, на котором размещена картинка. Нужно сделать, чтобы при передвижении указателя мышки по пэнинтбоксу вместе с ним и двигался прямоугольник, например, зеленый 40х40.
У меня проблема возникает в том, что при передвижении указателя нужно рисовать новый прямоугольник и стирать старый, но чтобы весь рисунок не перерисовывать, так как приложение подвисает. Рисовать прямоугольник пытался с помощью канвы...

[angvelem]

Рисуй на буферном битмапе, а в событии OnPaint PaintBox-а копируй битмап в канву PaintBox-а.

[kaktusad]

Сообщение от angvelem

Рисуй на буферном битмапе, а в событии OnPaint PaintBox-а копируй битмап в канву PaintBox-а.

Так все равно же при каждом движении мышки придется перерисовывать битмап?

[angvelem]

Выод битмапа на канву PaintBox-а вызовет меньше перерисовок, чем непосредственное рисование на канве самого PaintBox-а

[icWasya]

Сообщение от kaktusad

Так все равно же при каждом движении мышки придется перерисовывать битмап?

А думаешь графические редакторы делают как-то по другому?

[Freeman]

Сообщение от kaktusad

нужно рисовать новый прямоугольник и стирать старый, но чтобы весь рисунок не перерисовывать, так как приложение подвисает.

Рисуй в режиме XOR:

Код:

type
  TMainForm = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    FPrevX, FPrevY: Integer;
  end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FPrevX := -1;
  FPrevY := -1;
end;

procedure TMainForm.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  with TPaintBox(Sender).Canvas do
  begin
    with Brush do
    begin
      Color := clTeal;
      Style := bsSolid;
    end;
    with Pen do
    begin
      Color := clYellow;
      Mode := pmXor;
    end;
    if (FPrevX > 0) and (FPrevY > 0) then
      Rectangle(FPrevX - 10, FPrevY - 8, FPrevX + 10, FPrevY + 8);
    Rectangle(X - 10, Y - 8, X + 10, Y + 8);
  end;
  FPrevX := X;
  FPrevY := Y;
end;

[kaktusad]

Freeman, вот что получилось


Изображение рисую на Пэинт боксе с помощью StretchDraw и если его перерисовывать при каждом движении мышки, то будут почти одни полосы.

[Страдалецъ]

А где именно вы изображение рисуете? В каком событии?

[kaktusad]

Сообщение от Страдалецъ

А где именно вы изображение рисуете? В каком событии?

PaintBox.OnPaint

[lmikle]

Сообщение от kaktusad

Freeman, вот что получилось
...
Изображение рисую на Пэинт боксе с помощью StretchDraw и если его перерисовывать при каждом движении мышки, то будут почти одни полосы.

Ну, для особо извращенцев могу посоветовать вариант с запоминанием фона. Т.е. сначала отрисовываешь запомненный ранее фон (твоего размера, 40х40, если не ошибаюсь), потом меняешь координаты, запоминаешь по новым координатам фон, потом отрисовываешь свой квадрат. Ну и сначала при следующем перемещении мышы.

А вообще, вывод из буфферного битмапа на канву PaintBox занимает микроскопическое время, при включенном DoubleBuffered ничего не моргает. Только там есть маленький фокус - фон стирать не надо, надо сделать так, что бы картинка выводилась из буфера за одну операцию без стирания фона. Проверял на 8-мегапиксельных картинках. В твоем случае нужно будет 2 буфера. В первом лежит орининальная картинка, во втором ты подготавливаешь картинку для вывода и потом ее отрисовываешь на канве PaintBox.

[angvelem]

Думается ТС нужен код для понимания сути процесса. Я уже пытался ему сказать про буферный битмап, но он не принял во внимание. Рисовать в OnPaint-е, полное извращение, будет постоянное дёрганье.

[kaktusad]

Сообщение от angvelem

Думается ТС нужен код для понимания сути процесса. Я уже пытался ему сказать про буферный битмап, но он не принял во внимание. Рисовать в OnPaint-е, полное извращение, будет постоянное дёрганье.

Можно по-подробней о сути буферного битмапа? И на чем тогда рисовать?

[Fatze]

Код:

unit Unit2;

interface

  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ExtCtrls, pngimage;

  type
    TForm2 = class(TForm)
      PaintBox1: TPaintBox; // Не забыть положить на форму и создать 2 обработчика
      procedure PaintBox1Paint(Sender: TObject);
      procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
      private
        { Private declarations }
      public
        { Public declarations }
    end;

  var
    Form2: TForm2;

implementation

{$R *.dfm}
const          //Graphics.pas
  Colors: array[0..19] of TIdentMapEntry = (
    (Value: clBlack; Name: 'clBlack'),
    (Value: clMaroon; Name: 'clMaroon'),
    (Value: clGreen; Name: 'clGreen'),
    (Value: clOlive; Name: 'clOlive'),
    (Value: clNavy; Name: 'clNavy'),
    (Value: clPurple; Name: 'clPurple'),
    (Value: clTeal; Name: 'clTeal'),
    (Value: clGray; Name: 'clGray'),
    (Value: clSilver; Name: 'clSilver'),
    (Value: clRed; Name: 'clRed'),
    (Value: clLime; Name: 'clLime'),
    (Value: clYellow; Name: 'clYellow'),
    (Value: clBlue; Name: 'clBlue'),
    (Value: clFuchsia; Name: 'clFuchsia'),
    (Value: clAqua; Name: 'clAqua'),
    (Value: clWhite; Name: 'clWhite'),

    (Value: clMoneyGreen; Name: 'clMoneyGreen'),
    (Value: clSkyBlue; Name: 'clSkyBlue'),
    (Value: clCream; Name: 'clCream'),
    (Value: clMedGray; Name: 'clMedGray'));




  procedure TForm2.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    const
      dx = 10;
      dy = 10;
    var
      MouseRect: Trect;
      MousePositionInParentCoordinates:TPoint;
    begin
      MousePositionInParentCoordinates:= PaintBox1.ClientToParent(Point(X, Y));     //Получаем смещение PaintBox относительно родительского оконного компонента
       // Формируем размеры прямоугольника под мышью
      MouseRect:=Rect(MousePositionInParentCoordinates,MousePositionInParentCoordinates);         // Прямоугольник в 0пикселов но в правильных координатах
      Windows.InflateRect(MouseRect,dx*2,dy*2);      // Растягиваем прямаугольник
      Windows.InvalidateRect(PaintBox1.Parent.Handle,MouseRect,True);      // Просим пометить как "Не валидную" область прямоугольника у родительского оконного компонента (Т.к. PaintBox не оконный компонент )
    end;

  procedure TForm2.PaintBox1Paint(Sender: TObject);
    var
      Priamougolnic: Trect;
    begin
      Priamougolnic := PaintBox1.BoundsRect; // <-размер холста

      PaintBox1.Canvas.Brush.Color := Colors[Random(Length(Colors)-1)].Value; //установка цвета заливки
      // в данном примере устанавливается случайный цвет из массива Colors и
      PaintBox1.Canvas.Rectangle(Priamougolnic);        // здесь можно рисовать фоновую картинку        а ПОТОМ картинку прямоугольника
      //закрашивается вся область холста. Сделано чтобы продемонстрировать что даже если рисовать всю картинку
      //перерисуется только помеченная нами как "НЕ ВАЛИДНАЯ"(испорченная) область холста
      // вывод если рисовать сначала всю картинку а потом текущее положение прямоугольника под мышью
      // мерцания будут заметны только при очень большом прямоугольнике под мышью
      // если заменить рисование копированием (при сложных картинках) мерцания будет меньше
      //Canvas.CopyRect
    end;

end.