Bild Tranparent machen ?

[nitschchedu]

Mein Programm soll das Bild erstellen ^^ also zeig mal das Programm oder den Code :-D

[SirThornberry]

Quelltext gibts von meinem Programm nicht. Aber es ist ganz einfach. Instanziere ein TBitmap, setze es auf die entsprechende größe und setzte das Pixelformat auf 32bit. Mit Scanline kannst du dir dann einen Pointer auf den Bildspeicher holen und den Alphakanal sowie die Farbkanäle manipulieren.

[nitschchedu]

Ähhh ja ok kannste mir mal da ein Code Bsp machen ? Bitte !!! :)

[SirThornberry]

folgender Quelltext erstellt dir ein schwarzes Bild (200x200) welches links oben ganz transparent ist nach rechts unten undurchsichtig wird. Anschließend wird es gespeichert unter:
c:\alphabmp.bmp

Delphi-Quellcode:

var
  lBmp      : TBitmap;
  lCountX,
  lCountY   : Integer;
  lPixel    : PRGBQuad;
begin
  lBmp  := TBitmap.Create();
  lBmp.PixelFormat  := pf32bit;
  lBmp.Width  := 200;
  lBmp.Height := 200;
  for lCountY := 0 to lBmp.Height - 1 do
  begin
    lPixel  := lBmp.ScanLine[lCountY];
    for lCountX := 0 to lBmp.Width - 1 do
    begin
      lPixel.rgbBlue  := 0;
      lPixel.rgbGreen := 0;
      lPixel.rgbRed   := 0;
      lPixel.rgbReserved := Trunc((lCountX * lCountY) * 255 / (lBmp.Width * lBmp.Height));
      inc(lPixel);
    end;
  end;
  lBmp.SaveToFile('c:\alphabmp.bmp');
  lBmp.Free;

und hier das ganze nochmal ohne speicherung sondern mit direkter Ausgabe auf das Formular:

Delphi-Quellcode:

var
  lBmp          : TBitmap;
  lCountX,
  lCountY       : Integer;
  lPixel        : PRGBQuad;
  lBlendStruct  : TBlendFunction;
begin
  lBmp  := TBitmap.Create();
  lBmp.PixelFormat  := pf32bit;
  lBmp.Width  := 200;
  lBmp.Height := 200;
  for lCountY := 0 to lBmp.Height - 1 do
  begin
    lPixel  := lBmp.ScanLine[lCountY];
    for lCountX := 0 to lBmp.Width - 1 do
    begin
      lPixel.rgbBlue  := 0;
      lPixel.rgbGreen := 0;
      lPixel.rgbRed   := 0;
      lPixel.rgbReserved := Trunc((lCountX * lCountY) * 255 / (lBmp.Width * lBmp.Height));
      inc(lPixel);
    end;
  end;
  lBlendStruct.BlendOp              := AC_SRC_OVER;
  lBlendStruct.BlendFlags           := 0;
  lBlendStruct.SourceConstantAlpha  := 255;
  lBlendStruct.AlphaFormat          := AC_SRC_ALPHA;
  Windows.AlphaBlend(Canvas.Handle, 0, 0, lBmp.Width, lBmp.Height, lBmp.Canvas.Handle, 0, 0, lBmp.Width, lBmp.Height, lBlendStruct);
  lBmp.Free;
end;

[nitschchedu]

Ok Danke mit ne Bissel rumprobieren gehts ^^

[nitschchedu]

Ich habe das ganze jetzt in eine Funktion gepackt

Delphi-Quellcode:

procedure ImageTranzparent(Graphic: TGraphic; iTransparent: Integer;
  NewCanvas: TCanvas);
var
   lBmp: TBitmap;
  transpro: Byte;
  lCountX, lCountY: Integer;
  lPixel: PRGBQuad;
  lBlendStruct: TBlendFunction;
begin
  if not ((iTransparent >= 0) and (iTransparent <= 100)) then
  begin
     if NewCanvas <> nil then
    begin
       NewCanvas.Draw(0, 0, Graphic);
    end;

     Exit;
  end;

   lBmp                    := TBitmap.Create();
  lBmp.PixelFormat   := pf32bit;
  lBmp.Width           := Graphic.Width;
  lBmp.Height          := Graphic.Height;

  lBmp.Canvas.Draw(0, 0, Graphic);

  transpro := Round(255 * iTransparent / 100);

  for lCountY := 0 to lBmp.Height - 1 do
  begin
    lPixel := lBmp.ScanLine[lCountY];

    for lCountX := 0 to lBmp.Width - 1 do
    begin
      lPixel.rgbReserved := transpro;
      inc(lPixel);
    end;
  end;

  lBlendStruct.BlendOp              := AC_SRC_OVER;
  lBlendStruct.BlendFlags           := 0;
  lBlendStruct.SourceConstantAlpha  := 255;
  lBlendStruct.AlphaFormat          := AC_SRC_ALPHA;

  Windows.AlphaBlend(NewCanvas.Handle, 0, 0, lBmp.Width, lBmp.Height,
     lBmp.Canvas.Handle, 0, 0, lBmp.Width, lBmp.Height, lBlendStruct);
    
  lBmp.Free;
end;

Nun sehe ich aber die Umrantung die eigentlich Transparent schon war wieder :-(