I found that there is a difference with the drawing of a custom bitmap brush, when I subclass TGraphicControl versus TCustomControl. The expected behaviour occurs when using the TCustomControl descendant. Each paint starts with the brush in the same position, no matter the location of the control (top-left). When using TGraphicControl however, it appears that the brush is always drawn relative to the top-left of the form. Same behaviour on D5 and DXE2.
I hope anybody can offer a reasonable explanation, as to WHY this is happening. (Please note that I am NOT looking for a work-around, I have one.)
If you wish to reproduce this, here's the code (a form with four speedbuttons to move the middle control):
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons;
type
TCard = class(TGraphicControl) // Change to TCustomControl to view the difference
private
FBackColor: TColor;
FBrushBitmap: TBitmap;
protected
procedure Paint; override;
procedure SetBackColor(AColor: TColor);
property BackColor: TColor read FBackColor write SetBackColor;
end;
TForm1 = class(TForm)
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
private
FCard: TCard;
FCard2: TCard;
FCard3: TCard;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TCard }
procedure TCard.Paint;
var
r: TRect;
begin
Canvas.Brush.Color := clWhite;
Canvas.Rectangle(GetClientRect);
r := GetClientRect;
r.Top := 4;
r.Left := 4;
r.Bottom := r.Bottom - 4;
r.Right := r.Right - 4;
Canvas.Brush.Bitmap := FBrushBitmap;
Canvas.Rectangle(r);
Canvas.Brush.Bitmap := nil;
end;
procedure TCard.SetBackColor(AColor: TColor);
begin
if AColor <> FBackColor then begin
if FBrushBitmap <> nil then
FBrushBitmap.Free;
FBackColor := AColor;
FBrushBitmap := TBitmap.Create;
FBrushBitmap.Width := 16;
FBrushBitmap.Height := 16;
FBrushBitmap.PixelFormat := pf8bit;
FBrushBitmap.Canvas.Brush.Color := FBackColor;
FBrushBitmap.Canvas.FloodFill(0, 0, FBackColor, fsBorder);
FBrushBitmap.Canvas.Pen.Color := clWhite;
FBrushBitmap.Canvas.MoveTo( 0, 0);
FBrushBitmap.Canvas.LineTo(16, 0);
FBrushBitmap.Canvas.MoveTo( 0, 8);
FBrushBitmap.Canvas.LineTo(16, 8);
FBrushBitmap.Canvas.MoveTo( 6, 0);
FBrushBitmap.Canvas.LineTo( 6, 8);
FBrushBitmap.Canvas.MoveTo(12, 8);
FBrushBitmap.Canvas.LineTo(12, 16);
end;
end;
{ TForm1 }
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
FCard := TCard.Create(nil);
FCard.BackColor := clMaroon;
FCard.Parent:= Self;
FCard.Left := 13;
FCard.Top := 8;
FCard.Width := 60;
FCard.Height := 90;
FCard2 := TCard.Create(nil);
FCard2.BackColor := clGreen;
FCard2.Parent:= Self;
FCard2.Left := 39;
FCard2.Top := 39;
FCard2.Width := 60;
FCard2.Height := 90;
FCard3 := TCard.Create(nil);
FCard3.BackColor := clNavy;
FCard3.Parent:= Self;
FCard3.Left := 100;
FCard3.Top := 8;
FCard3.Width := 60;
FCard3.Height := 90;
end;
destructor TForm1.Destroy;
begin
FCard.Free;
FCard2.Free;
FCard3.Free;
inherited;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
FCard2.Top := FCard2.Top - 1;
FCard.Invalidate;
FCard2.Invalidate;
FCard3.Invalidate;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
FCard2.Left := FCard2.Left - 1;
FCard.Invalidate;
FCard2.Invalidate;
FCard3.Invalidate;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
FCard2.Left := FCard2.Left + 1;
FCard.Invalidate;
FCard2.Invalidate;
FCard3.Invalidate;
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
FCard2.Top := FCard2.Top + 1;
FCard.Invalidate;
FCard2.Invalidate;
FCard3.Invalidate;
end;
end.