Растяжка на TPNGImage

Question

Когда я вызываю canvas.stretchdraw с растровым изображением, растровое изображение будет зеркально отражено / перевернуто, когда влево> вправо. Это не происходит для PNG. Это ошибка? Что я могу сделать, чтобы это исправить?

Чтобы повторить, попробуйте этот код:

procedure TForm1.TestStretchdraw;
var
  vBMP: TBitmap;
  vPNG: TPNGImage;
  X0,Y0,X1,Y1 : integer;
  R : TRect;

  procedure FlipRect;
  var
    T : integer;
  begin
    T := R.Left;
    R.Left := R.Right;
    R.Right := T;
  end;

begin
  vBMP := TBitmap.Create;
  vPNG := TPNGImage.Create;
  try
    vBMP.LoadFromFile('c:\temp\pic\pic.bmp');
    vPNG.LoadFromFile('c:\temp\pic\pic.png');

    X0 := 0;
    Y0 := 0;
    X1 := X0 + vBMP.Width;
    Y1 := Y0 + vBMP.Height;
    R := Rect(X0,Y0,X1,Y1);
    FlipRect;
    Canvas.StretchDraw(R,vBMP); //This image will be drawn mirrored

    X0 := vBMP.Width+10;
    Y0 := 0;
    X1 := X0 + vPNG.Width;
    Y1 := Y0 + vPNG.Height;
    R := Rect(X0,Y0,X1,Y1);
    FlipRect;
    Canvas.StretchDraw(R,vPNG); //This will not
  finally
    vPNG.Free;
    vBMP.Free;
  end;
end;

(но замените мои показания некоторыми своими)

Answer 1

Здесь я написал функцию, которая переворачивает png без каких-либо библиотек, таких как Gr32.Прозрачность остается в перевернутом PNG.

procedure FlipPNG(aSource, aDest: TPngImage);
var
  X, Y: Integer;
  AlphaPtr: PByteArray;
  RGBLine: pRGBLine;
  PalleteLine: PByteArray;
  AlphaPtrDest: PByteArray;
  RGBLineDest: pRGBLine;
  PalleteLineDest: PByteArray;
begin
  aDest.Assign(aSource);

  if (aSource.Header.ColorType = COLOR_PALETTE) or
     (aSource.Header.ColorType = COLOR_GRAYSCALEALPHA) or
     (aSource.Header.ColorType = COLOR_GRAYSCALE) then
  begin
    for y := 0 to aSource.Height - 1 do
    begin
      AlphaPtr := aSource.AlphaScanline[y];
      PalleteLine := aSource.Scanline[y];
      AlphaPtrDest := aDest.AlphaScanline[y];
      PalleteLineDest := aDest.Scanline[y];
      for x := 0 to aSource.Width - 1 do
      begin
        PalleteLineDest^[aSource.Width - x -1] := PalleteLine^[x];
        if Assigned(AlphaPtr) then
          AlphaPtrDest^[aSource.Width - x -1] := AlphaPtr^[x];
      end;
    end;
  end else
  if (aSource.Header.ColorType = COLOR_RGBALPHA) or
     (aSource.Header.ColorType = COLOR_RGB) then
  begin
    for y := 0 to aSource.Height - 1 do
    begin
      AlphaPtr := aSource.AlphaScanline[y];
      RGBLine := aSource.Scanline[y];
      AlphaPtrDest := aDest.AlphaScanline[y];
      RGBLineDest := aDest.Scanline[y];
      for x := 0 to aSource.Width - 1 do
      begin
        RGBLineDest^[aSource.Width - x -1] := RGBLine^[x];
        if Assigned(AlphaPtr) then
          AlphaPtrDest^[aSource.Width - x -1] := AlphaPtr^[x];
      end;
    end;
  end;
end;

Answer 2

Да, это правильно.StretchDraw вызывает метод Draw соответствующего потомка TGraphic.Вы можете сравнить TBitmap.Draw с TPngImage.Draw самостоятельно.TBitmap.Draw, естественно, просто вызывает функцию Windows API StretchBlt.TPngImage.Draw, однако, первые звонки AdjustRect:

procedure AdjustRect(var Rect: TRect);
var
  t: Integer;
begin
  if Rect.Right < Rect.Left then
  begin
    t := Rect.Right;
    Rect.Right := Rect.Left;
    Rect.Left := t;
  end;
  if Rect.Bottom < Rect.Top then
  begin
    t := Rect.Bottom;
    Rect.Bottom := Rect.Top;
    Rect.Top := t;
  end
end;

Как вы можете видеть, это безжалостно отменяет обмен left и right.

Answer 3

Я бы не стал рассматривать случай, когда Left больше Right, правильное определение прямоугольника, поэтому мой ответ будет таким: не называйте это так. Вы можете убедиться в правильности определения прямоугольника перед вызовом StretchDraw:

if (R.Left > R.Right) then
  Swap (R.Left, R.Right);
if (R.Top> R.Bottom) then
  Swap (R.Top, R.Bottom);