Draw Rectangle on transparent form is very slow - delphi

Question

AlphaBlend and DoubleBuffered set to True. I have Duo Core 2Ghz and drawing takes 100% CPU, even i had once BSOD. My goal is selecting custom area on screen and get coordinates. Enabling/disablin Windows Aero doesnt speed up. Thanks for help.
unit ZaznaczenieObszaru;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
type
TForm3 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FormKeyPress(Sender: TObject; var Key: Char);
private
public
{ Public declarations }
end;
var
Form3: TForm3;
rysuj: boolean;
poczatekX, poczatekY, xGlobalne, yGlobalne: Integer;
kolorIzy: TColor;
implementation
{$R *.dfm}
procedure TForm3.FormCreate(Sender: TObject);
begin
Width := Screen.Width;
Height := Screen.Height;
rysuj := False;
kolorIzy := 14413224;
end;
procedure TForm3.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then Close;
end;
procedure TForm3.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Image1.Picture.Bitmap := nil;
Image1.Canvas.Brush.Color := kolorIzy;
poczatekX := X;
poczatekY := Y;
rysuj := true;
end;
procedure TForm3.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if rysuj = true then
begin
xGlobalne := X;
yGlobalne := Y;
Image1.Picture.Bitmap := nil;
Image1.Canvas.Brush.Color := kolorIzy;
Image1.Canvas.Rectangle(poczatekX, poczatekY, xGlobalne, yGlobalne)
end;
end;
procedure TForm3.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
rysuj := False;
end;
end.

Answer 1

You could use a TPaintBox instead of TImage (It's Canvas is not meant for such usage as #Ken already commented) and draw your rectangle on the TPaintBox.OnPaint event. don't draw on Mouse events, but rather use TPaintBox.Invalidate. Here is an example:
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
poczatekX := X;
poczatekY := Y;
rysuj := True;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if rysuj then
begin
xGlobalne := X;
yGlobalne := Y;
PaintBox1.Invalidate;
end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
rysuj := False;
PaintBox1.Invalidate;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
if rysuj then
begin
PaintBox1.Canvas.Brush.Color := kolorIzy;
PaintBox1.Canvas.Rectangle(poczatekX, poczatekY, xGlobalne, yGlobalne);
end;
end;
I guess the same could be applied using only the TForm itself without any graphic controls, by drawing to the Form's canvas directly (same events as with the TPaintBox).

Answer 2

Try my NLDXPSelection component which is a non-visual component that provides drawing blue alpha blended selections on any control, form or screen. It has properties OnResize and OnFinish that tell the selection coördinates.
Source can be found here (open source).