Einzelnen Beitrag anzeigen

TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.070 Beiträge
 
Delphi 10.4 Sydney
 
#2

AW: AlphaBlend Png Hintergrund ist weiß

  Alt 3. Apr 2017, 13:44
Delphi-Quellcode:
procedure TSkinEngine.DrawAlphaBlend(DC: HDC; X, Y, ClientWidth, ClientHeight: Integer; fBlend: Byte);
var
  hTempDC: HDC;
  bf: BLENDFUNCTION;
  hBmp: HBITMAP;
  bmi: BITMAPINFO;
  pvBits: Pointer;
begin
  hTempDC := CreateCompatibleDC(DC);
  if hTempDC <> 0 then
  begin
    try
      ZeroMemory(@bmi, sizeof(BITMAPINFO));
      bmi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
      bmi.bmiHeader.biWidth := ClientWidth;
      bmi.bmiHeader.biHeight := ClientHeight;
      bmi.bmiHeader.biPlanes := 1;
      bmi.bmiHeader.biBitCount := 32;
      bmi.bmiHeader.biCompression := BI_RGB;
      bmi.bmiHeader.biSizeImage := ClientWidth * ClientHeight * 4;

      hBmp := CreateDIBSection(hTempDC, bmi, DIB_RGB_COLORS, pvBits, 0, 0);
      if hBmp <> 0 then
      begin
        try
          SelectObject(hTempDC, hBmp);

          bf.BlendOp := AC_SRC_OVER;
          bf.BlendFlags := 0;
          bf.SourceConstantAlpha := fBlend;
          // 0 bedeutet ja AC_SRC_OVER, mal die anderen Werte probieren?
          // https://msdn.microsoft.com/de-de/library/windows/desktop/dd183393(v=vs.85).aspx
          bf.AlphaFormat := AC_SRC_ALPHA;

          // Gibt es möglicherweise einen Fehler?
          if not AlphaBlend(DC, X, Y, ClientWidth, ClientHeight, hTempDC, 0, 0, ClientWidth, ClientHeight, bf) then
          begin
            // Im Fehlerfall den Windows-Fehler als Exception zur Anzeige bringen.
            RaiseLastOSError;
          end;
        finally
          DeleteObject(hBmp);
        end;
      end;
    finally
      DeleteDC(hTempDC);
    end;
  end;
end;
  Mit Zitat antworten Zitat