Затирание bitmap canvas при map-unmap

[Vizit0r]

Тестовый пример - вычитываю во временый битмап картинку из файла. Потом временный битмап рисую на полотне битмапа от Image1. Потом еще рисую на полотне, например эллипс. На этом этапе все хорошо.

А дальше достаточно сделать Image1.Bitmap.Map - Unmap, и все, изображение пустое. Если писать через BitmapData напрямую в пикселы - оно показывается на экране.

При этом каким-то странным образом эффект стирания битмапа убирается путем вызова Image1.Bitmap.SaveToFile перед вызовом Map-Unmap,

Исходники пытался читать, причины не нашел.

Кто в курсе, подскажите - что я делаю не так?

P.S. Если читать из файла напрямую в Image1.Bitmap - то при Map-Unmap затираются только изменения полотна, а загруженный рисунок остается. Явно какие-то недокументированные особенности вызова Map-Unmap..

P.P.S. Зло где-то в районе вызова 

  if H.FAccess in [TMapAccess.ReadWrite, TMapAccess.Write] then
    SharedDevice.CopyResource(H.Texture, H.FMapBuffer);
 

при Unmap.

 

Осталось придумать, как это побороть и совместить рисование на полотне с прямым доступом к пикселам.

procedure TForm2.Button1Click(Sender: TObject);
var Bmp1 : Tbitmap;
    BitmapData : TBitmapData;
begin
  Bmp1 := Tbitmap.Create;
  Bmp1.CreateFromFile('c:\123.bmp');

  Image1.Bitmap.Width := Bmp1.Width;
  Image1.Bitmap.Height := Bmp1.Height;

  Image1.Bitmap.Canvas.BeginScene;
  Image1.Bitmap.Canvas.DrawBitmap(Bmp1,TRectF.Create(0,0,Bmp1.Width,Bmp1.Height),
                                TRectF.Create(0,0,Image1.Bitmap.Width,Image1.Bitmap.Height), 1);
  Image1.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Red;
  Image1.Bitmap.Canvas.DrawEllipse(TRectF.Create(10, 10,
                                  20,20), 1);
  Image1.Bitmap.Canvas.EndScene;

//  Image1.Bitmap.SaveToFile('c:\0001.bmp');    //если это закомментировать, то
  //при вызове Map-Unmap в Image будет пусто
  Image1.Bitmap.Map(TMapAccess.Write,BitmapData);
//  здесь была работа с пикселами напрямую - замена цветов в нескольких точках.
  Image1.Bitmap.Unmap(BitmapData);
  Bmp1.Free;
//  BMPTest(Image1.Bitmap);
end;

 

Изменено 14 августа, 2019 пользователем Vizit0r

[Евгений Корепов]

К сожалению начиная с Токио, Эмбаркадера почти полностью поломала 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;

 

[Евгений Корепов]

Я разобрался в чем дело:

Вместо TMapAccess.Write используйте TMapAccess.ReadWrite. 

TMapAccess.Write по какой то причине затирает если не все, то некоторые последние изменения канваса. В доке http://docwiki.embarcadero.com/Libraries/Rio/en/FMX.Graphics.TBitmap.Map не нашел упоминания о таком поведении.

[Vizit0r]

действительно, ReadWrite не затирает. А я его банально не проверил

 

Спасибо, помогло.