Excuse me- you are right. I can hardly present complete source code from my application, although TPump.Paint is (TPump.Invalidate is called 50 times for different instances of TPump, twice in second):
procedure TPump.Paint; //I know that "Self" here is redundant, but it stands in my source code
var
Bitmap: TBitmap;
begin
Bitmap := MyShape;
try
Self.SetShape(Bitmap); // this is where debugger breaks after 20 minutes approx. (after GlobalAlloc I wrote about)
finally
Bitmap.Free;
end;
Bitmap := MyBitmap;
try
Self.Canvas.Draw(0,0,Bitmap);
finally
Bitmap.Free;
end;
inherited Paint;
end;
Of course, I know that for complete example, I should send MyShape and MyBitmap implementation and details about TPump class (which inherits from TCustomControl), but I don't know how to submit everything needed, yet to be enough for this kind of correspondence.
Regarding Lazarus example, I wrote about and that I changed "a little bit", it is:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShapeControl(Self);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Handle;
ShapeControl(Button1);
end;
procedure TForm1.ShapeControl(AControl: TWinControl);
var
ABitmap: TBitmap;
Points: array of TPoint; i: integer; // I added variable "i"
begin
ABitmap := TBitmap.Create;
ABitmap.Monochrome := True;
ABitmap.Width := AControl.Width;
ABitmap.Height := AControl.Height;
SetLength(Points, 6);
Points[0] := Point(0, ABitmap.Height div 2);
Points[1] := Point(10, 0);
Points[2] := Point(ABitmap.Width - 10, 0);
Points[3] := Point(ABitmap.Width, ABitmap.Height div 2);
Points[4] := Point(ABitmap.Width - 10, ABitmap.Height);
Points[5] := Point(10, ABitmap.Height);
with ABitmap.Canvas do
begin
Brush.Color := clBlack; // transparent color
FillRect(0, 0, ABitmap.Width, ABitmap.Height);
Brush.Color := clWhite; // mask color
Polygon(Points);
end;
// next line- I added "for" loop - originally only AControl.SetShape exists in example
for i:= 1 to 100000 do AControl.SetShape(ABitmap); // debugger breaks after minute approx.
ABitmap.Free;
end;
Regards