Andorra 2D [Ver. 0.4.5.1, 31.12.08]

[xZise]

Hmmm also ich habe jetzt die "alte" Methode entfernt und sie neu deklariert:

Delphi-Quellcode:

function TAdVCLFormat.AssignTo(ABitmap: TAdBitmap;
  AGraphic: TObject): boolean;
var
  pc1, pc2: PCardinal;
  x, y: integer;
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  try
    bmp.PixelFormat := pf32Bit;
    bmp.Width := ABitmap.Width;
    bmp.Height := ABitmap.Height;
// Ab hier habe ich das aus deinen Codesniplseln kopiert
    for y := 0 to bmp.Height - 1 do
    begin
      pc1 := bmp.Scanline[y];
      pc2 := ABitmap.Scanline(y);
      for x := 0 to bmp.Width - 1 do
      begin
        pc1^ := pc2^; //Inhalt ABitmap, Alpha $FF
        inc(pc1);
        inc(pc2);
      end;
    end;
// Bis hier
  finally
    bmp.free;
  end;
end;

Ergebnis war jedes mal eine weiße Fläche. Ich müsste auch bmp der Grafik zuweisen. Jetzt bekomme ich vernünftige Ergebnisse:

1. Blaues Bitmap durchgehend (ohne Transparenzen)
2. Weißes Bitmap (ohne Transprenzen wahrscheinlich (Hg war weiß))
3. Inhalt der Grafik, Bläulich, "Hintergrund" ist schwarz
4. Inhalt der Grafik, "Hintergrund" ist schwarz

Hier ist mein Workaround für weiße Hintergrundflächen:

Delphi-Quellcode:

function TAdVCLFormat.AssignTo(ABitmap: TAdBitmap;
  AGraphic: TObject): boolean;
var
  bmp: TBitmap;
  y, x: integer;             var i : Integer;

  LineIn, LineOut : PCardinal;
  LineInRec : LongRec;
begin
  result := true;

  bmp := TBitmap.Create;
  try
    bmp.PixelFormat := pf32Bit;
    bmp.Width := ABitmap.Width;
    bmp.Height := ABitmap.Height;

    for y := 0 to bmp.Height - 1 do
    begin
      LineIn := ABitmap.ScanLine(y);
      LineOut := bmp.ScanLine[y];
      for x := 0 to bmp.Width - 1 do
      begin
        LineInRec.Bytes[0] := 255 - LineIn^ shr 24;
        LineInRec.Bytes[1] := (LineIn^ shr 16) and $00FF;
        LineInRec.Bytes[2] := (LineIn^ shr 8) and $0000FF;
        LineInRec.Bytes[3] := LineIn^ and $000000FF;

        for i := 1 to 3 do
        begin
          if LineInRec.Bytes[0] < 255 - LineInRec.Bytes[i] then
            LineInRec.Bytes[i] := LineInRec.Bytes[0] + LineInRec.Bytes[i]
          else
            LineInRec.Bytes[i] := $FF;
        end;

        LineOut^ := $FF000000 or (LineInRec.Bytes[1] shl 16) or (LineInRec.Bytes[2] shl 8) or (LineInRec.Bytes[3]);

        Inc(LineIn);
        Inc(LineOut);
      end;
    end;

    TGraphic(AGraphic).Assign(bmp);
  finally
    bmp.Free;
  end;
end;

Wie man sieht längst nicht so performat wie dein Code, aber damit bekomme ich immerhin Transparenz.

Übrigens gibt es eine Möglichkeit bei deinem Canvas auch Kreis/Rechtecksringe zu zeichnen? Und wie sieht es mit abgerundeten Rechtecken aus?

Btw, wenn du möchtest könntest du noch folgende Funktionen implementieren (Dürfte es alle nicht geben):

Delphi-Quellcode:

function AdPoint(const APoint : TPoint) : TAdPoint; overload;
begin
  Result := AdPoint(APoint.X, APoint.Y);
end;

function AdRect(ACorner1, ACorner2 : TAdPoint; const APreventFlipOver : Boolean = true) : TAdRect; overload;
var
  CornerBuffer : TAdPoint;
begin
  if APreventFlipOver then
  begin
    if (ACorner1.X > ACorner2.X) or (ACorner1.Y > ACorner2.Y) then
    begin
      CornerBuffer := ACorner1;
      ACorner1 := ACorner2;
      ACorner2 := CornerBuffer;
    end;
  end;
  Result := AdRect(ACorner1.X, ACorner1.Y, ACorner2.X, ACorner2.Y);
end;

function AdRect(ACorner1, ACorner2 : TPoint; const APreventFlipOver : Boolean = true) : TAdRect; overload;
begin
  Result := AdRect(AdPoint(ACorner1), AdPoint(ACorner2), APreventFlipOver)
end;

MfG
xZise