Anaglify - coś nie chce działać

0

Mam taką procedurę do tworzenia anaglifów:

procedure TForm1.BitBtn3Click(Sender: TObject);
type
  TRGBArray = array[0..32767] of TRGBTriple;
var
  Bmp: TBitmap;
  I, J: Integer;
  Row1, Row2, Row3: ^TRGBArray;
begin
  Bmp := TBitmap.Create;
  Bmp.Width := Image1.Picture.Graphic.Width;
  Bmp.Height := Image1.Picture.Graphic.Height;
  Image2.Picture.Graphic.Width := Bmp.Width;
  Image2.Picture.Graphic.Height := Bmp.Height;
  for I := 0 to Bmp.Height - 1 do
  begin
    Row1 := Image1.Picture.Bitmap.ScanLine[I];
    Row2 := Image2.Picture.Bitmap.ScanLine[I];
    Row3 := Bmp.ScanLine[I];
    Application.ProcessMessages;
    for J := 0 to Bmp.Width - 1 do
    begin
      Row3[J].rgbtRed := Row1[J].rgbtRed;
      Row3[J].rgbtGreen := Row1[J].rgbtGreen;
      Row3[J].rgbtBlue := Row2[J].rgbtBlue;
      Application.ProcessMessages;
    end;
  end;
  Image3.Picture.Bitmap := Bmp;
  Image3.Picture.Bitmap.SaveToFile('C:\Bitmap.bmp');
  Bmp.Free;
end;

Na pierwszy rzut oka wszystko dobrze, ale nie dość, że ta procedura wykonuje się tak długo, jakbym nie użyl scanlinu, a zwykłej pętli, to jeszcze zamiast anaglifu powstaje pusta bitmapa. Co jest nie tak?

0

Może ustaw pixelformat bitmap...

Bmp.PixelFormat := pf24bit;
0

Nic ie daje ;-|

1 użytkowników online, w tym zalogowanych: 0, gości: 1