К сожалению начиная с Токио, Эмбаркадера почти полностью поломала TBitmap. Его поведение стало неадекватным.
Вместо сохранения можете делать
var BitmapSurface : TBitmapSurface;
...
BitmapSurface:=TBitmapSurface.Create;
BitmapSurface.Assign(Image1.Bitmap);
BitmapSurface.Free;
Эта манипуляция в процедуре сохранения, как раз и помогает от затирания канваса. Почему это работает я не понял.
Не забывайте так же проверять удалось ли заблокировать канвас.
Вот я накидал пример:
procedure TForm1.Button1Click(Sender: TObject);
var Bitmap : Tbitmap;
BitmapData : TBitmapData;
I: integer;
J: integer;
Distance: integer;
Surf: TBitmapSurface;
begin
Bitmap := Tbitmap.Create;
Bitmap.CreateFromFile('D:\2012643.jpg');
if Bitmap.Canvas.BeginScene then
try
Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Blue;
Bitmap.Canvas.DrawEllipse(TRectF.Create(10, 10, 20, 20), 1);
finally
Bitmap.Canvas.EndScene;
end;
Surf:=TBitmapSurface.Create;
Surf.Assign(Bitmap);
Surf.Free;
if Bitmap.Map(TMapAccess.Write, BitmapData) then
try
Distance:=10;
for I := 0 to Round(BitmapData.Width / Distance) - 1 do
for J := 0 to Bitmap.Height - 1 do
begin
begin
AlphaColorToPixel(TAlphaColorRec.Red, @PAlphaColorArray(BitmapData.Data)
[J * (BitmapData.Pitch div PixelFormatBytes[Bitmap.PixelFormat])
+ Distance * I], Bitmap.PixelFormat);
end;
end;
finally
Bitmap.Unmap(BitmapData);
end;
Image1.Bitmap.Assign(Bitmap);
end;