
13.06.2013, 18:51
|
Прохожий
|
|
Регистрация: 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.
|