Einzelnen Beitrag anzeigen

Benutzerbild von xZise
xZise

Registriert seit: 3. Mär 2006
Ort: Waldbronn
4.303 Beiträge
 
Delphi 2009 Professional
 
#889

Re: Andorra 2D [Ver. 0.4.5.1, 31.12.08]

  Alt 2. Jan 2009, 21:09
Achso

Naja ich habe es vermutlich auf das Kopieren der Daten (AssignTo der Klasse TAdVCLFormat^^) eingegrenzt. Aber so richtig weiß ich nicht, was ich da testen könnte.

Was sein könnte, dass er irgendwie die Hintergrundfarbe nicht richtig setzt, weil da wo Transparenz ist, sieht man schwarz (durchscheinen).

Trace von SaveToGrapic
  1. AImgBuf.SaveToGraphic -> procedure TAdTexture.SaveToGraphic(AGraphic: TObject);
  2. AImgBuf.Texture.SaveToBitmap -> ?????
  3. bmp (TAdBitmap).AssignTo -> procedure TAdBitmap.AssignTo(AGraphic: TObject);
  4. tmp (TAdGraphicFormat).AssignTo -> function TAdVCLFormat.AssignTo(ABitmap: TAdBitmap; AGraphic: TObject): boolean;

Delphi-Quellcode:
function TAdVCLFormat.AssignTo(ABitmap: TAdBitmap;
  AGraphic: TObject): boolean;
var
  bmp: TBitmap;
  y: integer;
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
      Move(ABitmap.ScanLine(y)^, bmp.ScanLine[y]^, ABitmap.Width * 4);

    TGraphic(AGraphic).Assign(bmp);
  finally
    bmp.Free;
  end;
end;
Wenn ich da das bmp speichere habe ich schon den Big. Das heißt ich vermute es liegt irgendwie an den Move. Wobei ich natürlich da vorher das ABitmap getestet habe und wenn ich vor der for-Schleife das Bitmap teste läuft alles wunderbar:

Delphi-Quellcode:
function TAdVCLFormat.AssignTo(ABitmap: TAdBitmap;
  AGraphic: TObject): boolean;
var
  bmp: TBitmap;
  y: integer;

  i : Integer;
  pc: PCardinal;
begin
  result := true;
  
  bmp := TBitmap.Create;
  try
    bmp.PixelFormat := pf32Bit;
    bmp.Width := ABitmap.Width;
    bmp.Height := ABitmap.Height;

    pc := ABitmap.Scanline;
    for i := 0 to (ABitmap.Size div 4) - 1 do
    begin
      if (pc^ and $FFFFFF00) <> 0 then Beep;
      inc(pc);
    end;

    for y := 0 to bmp.Height - 1 do
      Move(ABitmap.ScanLine(y)^, bmp.ScanLine[y]^, ABitmap.Width * 4);
    bmp.SaveToFile(ExtractFilePath(ParamStr(0)) + 'Neuer Ordner\' + IntToStr(Random(MaxInt - 1)) + '-a.bmp');
    TGraphic(AGraphic).Assign(bmp);
  finally
    bmp.Free;
  end;
end;
MfG
xZise
Fabian
Eigentlich hat MS Windows ab Vista den Hang zur Selbstzerstörung abgewöhnt – mkinzler
  Mit Zitat antworten Zitat