Nie działa pół-przezroczystość

0
procedure TForm1.Button3Click(Sender: TObject);
var I, J: Integer; B: TBitmap;
begin
  B := TBitmap.Create;
 for I := 0 to Image1.Picture.Bitmap.Height - 1 do
   for J := 0 to Image1.Picture.Bitmap.Width - 1 do
     B.Canvas.Pixels[J, I] :=
       RGB(
           GetRValue(Image1.Picture.Bitmap.Canvas.Pixels[J, I]) div 2,
           GetGValue(Image1.Picture.Bitmap.Canvas.Pixels[J, I]) div 2,
           GetBValue(Image1.Picture.Bitmap.Canvas.Pixels[J, I]) div 2
          );
  Image1.Picture.Bitmap := B;
  B.Free;
end;

Jak wywołam to obrazek znika. Chodzi mi o to żeby obrazek był bledszy. Czemu to nie działa?

0

Tworzysz bitmapę, ale nie ustawiasz jej rozmiarów.
Zrób tak:

 B := TBitmap.Create;
B.Width := Image1.Picture.Bitmap.Width;
B.Height := Image1.Picture.Bitmap.Height;

Btw, nie polecałbym korzystania z .Pixels
Wersja ze ScanLine (nie testowana; pisana z pamięci):

procedure TForm1.Button3Click(Sender: TObject);
var I, J, C: Integer; B: TBitmap;
Col, Dest: ^TRGBTriple;
begin
  B := TBitmap.Create;
 B.Width := Image1.Picture.Bitmap.Width;
 B.Height := Image1.Picture.Bitmap.Height;
 for I := 0 to Image1.Picture.Bitmap.Height - 1 do
 begin
  Col := Image1.Picture.Bitmap.ScanLine[I];
  Dest := B.ScanLine[I];
   for J := 0 to Image1.Picture.Bitmap.Width - 1 do
   begin
    C := RGB(Col.rgbtRed, Col.rgbtGreen, Col.rgbtBlue);
    Dest.rgbtRed := GetRValue(C Div 2); 
    Dest.rgbtGreen := GetGValue(C Div 2); 
    Dest.rgbtBlue := GetRBalue(C Div 2); 
    Inc(Col);
    Inc(Dest);
   end;
  end;
  Image1.Picture.Bitmap := B;
  B.Free;
end;

To powinno działać znacznie szybciej, lecz nie wiem, czy ten kod da na pewno porządny efekt.

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