Показать сообщение отдельно
  #13  
Старый 13.06.2013, 18:51
Fatze Fatze вне форума
Прохожий
 
Регистрация: 13.06.2013
Сообщения: 2
Версия Delphi: Delphi 2009
Репутация: 10
По умолчанию Одно из решений

Код:
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.
Ответить с цитированием