Operacje na bitmapie - półprzezroczystość

Nie potrafie się rozpisywać bo małorolny jestem i głowy do poezji nie mam :) więc przedstawiam kod który opisałem krok po kroku.
Być może sie komuś przyda i zrobi z niego fajny komponent.
Dopiero po wielu latach udało mi się wreszcie poprawnie zarejestrować na tej witrynce :) (dawny Inter) - więc to moja pierwsza tu spuścizna, dlatego prosze o wyrozumiałość :)

UNIT modBitmap;
INTERFACE
Uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls;

 type Error = class(Exception);  

 //Funkcja pobiera rozmiar pixela
 FUNCTION GetPixelSize(bitmap:TBITMAP):INTEGER;
 //Procedura rozkłada kolor na składowe RGB
 PROCEDURE GetRGB(col:TCOLOR; var r,g,b:BYTE);
 //Funkcja pobiera wspólny kolor pixela z dwu podanych kolorów
 FUNCTION GetPixFilter(col,colBackground:TCOLOR; Filter:BYTE):TCOLOR;
 //Procedura filtruje Bitmapę (półprzezroczystość)
 PROCEDURE BitmapFilter(pozX,pozY:INTEGER; bitmapSrc,bitmapTlo:TBITMAP; Filter:BYTE);
 //Procedura kreuje pusty region dla Bitmapy
 PROCEDURE BitmapRegion(TransparentColor:TCOLOR; Bitmap:TBITMAP; Form:TFORM);
VAR
 BitmapDST   :TBitmap;
 PixelFormat :Byte;
{*********************************************************}
IMPLEMENTATION
 const BitsPerByte = 8;
{=========== Funkcja pobiera rozmiar pixela ============}
FUNCTION GetPixelSize(bitmap:TBITMAP):INTEGER;
var
 BitCount,Multiplier :INTEGER;
Begin
 case bitmap.PixelFormat of pfDevice:
	 begin
		 BitCount:= GetDeviceCaps(bitmap.Canvas.Handle, BITSPIXEL);
		 Multiplier:= BitCount div BitsPerByte;
		 if (BitCount mod BitsPerBYTE) > 0 then
		 begin
		    Inc(Multiplier);
		 end;
	 end;
   pf1bit:  Multiplier := 1;
   pf4bit:  Multiplier := 1;
   pf8bit:  Multiplier := 1;
   pf15bit: Multiplier := 2;
   pf16bit: Multiplier := 2;
   pf24bit: Multiplier := 3;
   pf32bit: Multiplier := 4;
   else raise Error.Create('Bitmapa nieznany format pixela !');
 end;
 Result:=Multiplier;
End; 
{========= Procedura rozkłada kolor na składowe RGB =======}
PROCEDURE GetRGB(col:TCOLOR; var r,g,b:BYTE);
Begin
 R:= GetRValue(col);
 G:= GetGValue(col);
 B:= GetBValue(col);
End;
{= Funkcja pobiera wspólny kolor pixela z dwu podanych kolorów ===}
FUNCTION GetPixFilter(col,colBackground:TCOLOR; Filter:BYTE):TCOLOR;
var
 r,g,b,r2,g2,b2 :BYTE;
Begin
 //rozkład koloru pixela pobranego z obrazka
 GetRGB(col, r,g,b);
 //rozkład koloru pixela z podanego tła obrazka
 GetRGB(colBackground, r2,g2,b2);
 //ustalenie średniej koloru w odpowiednim zestawieniu %
 R:= (r * Filter div 255) + (r2-r2 * Filter div 255);
 G:= (g * Filter div 255) + (g2-g2 * Filter div 255);
 B:= (b * Filter div 255) +( b2-b2 * Filter div 255);
 Result:=RGB(R, G, B);
End; 
{=== Procedura filtruje Bitmapę (półprzezroczystość) =========}
PROCEDURE BitmapFilter(pozX,pozY:INTEGER; bitmapSrc,bitmapTlo:TBITMAP; Filter:BYTE);
var
 kl,ln,gps :INTEGER;
 P1,P2,P3  :PByteArray;
Begin
 //zabezpieczenia przed uwagami błędów kompilacji...
 P1:=nil; P2:=nil; P3:=nil;
 if Filter < 1   then Filter:=0;
 if Filter > 254 then Filter:=255;
 //ustalenie wielkości bitowych dla bitmap...
 bitmapTlo.PixelFormat:=pf24Bit;
 if PixelFormat=16 then bitmapTlo.PixelFormat:=pf16Bit;
 if PixelFormat=24 then bitmapTlo.PixelFormat:=pf24Bit;
 if PixelFormat=32 then bitmapTlo.PixelFormat:=pf32Bit;
 bitmapSrc.PixelFormat:=bitmapTlo.PixelFormat;
 BitmapDst.PixelFormat:=bitmapTlo.PixelFormat;
 gps:=GetPixelSize(bitmapTlo);          //rozmiar pixela dla bitmapy
 //przepisanie zawartości bitmap
 BitmapDst.Assign(bitmapSrc);
 for ln:=0 to BitmapDst.Height-1 do
 begin
  try
    P1:=bitmapSrc.ScanLine[ln];               //skan linii z bitmapy żródłowej
    P2:=bitmapTlo.ScanLine[ln+pozY];      //skan linii z bitmapy tła
    P3:=BitmapDst.ScanLine[ln];              //skan linii dla bitmapy docelowej
    except
  end;
  kl:=0;
  repeat
    //jeżeli ustawiona opcja wyświetlania jako duszka to...
    if BitmapDst.Transparent then
       //...podmienia kolor zerowy na kolor z bitmapTlo
       if P1[kl]=0 then P3[kl]:=P2[kl+pozX * gps];
    //ustawia wartość pośrednią dla pixeli z bitmapDst i bitmapTlo
    P3[kl]:=GetPixFilter(P3[kl],P2[kl+pozX * gps],Filter);
    Inc(kl);
  until kl > bitmapDst.Width * gps;
 end;
 bitmapTlo.Canvas.Draw(pozX,pozY,BitmapDst);   //przerysowanie do bitmapy tła
End; 
{======= Procedura kreuje pusty region dla Bitmapy =========}
PROCEDURE BitmapRegion(TransparentColor:TCOLOR; Bitmap:TBITMAP; Form:TFORM);
 //funkcja kreująca region (wewnętrzna część procedury)
 Function KreujRegion(Bitmap:TBITMAP; KolorTla:TCOLOR):HRGN;
 var
  x,y,startX,endX,wd :Integer;
  rgn2               :HRGN;
 Begin
  Result:= CreateRectRgn(0,0,0,0);
  for y:=0 to Bitmap.Height-1 do
  begin
    x:=0; wd:=Bitmap.Width;
    while x < wd do
    begin
      while (Bitmap.Canvas.Pixels[x,y]= KolorTla) and (x <= wd) do inc(x);
      startX:=x; inc(x);
      while (Bitmap.Canvas.Pixels[x,y]<> KolorTla) and (x <= wd) do inc(x);
      endX:=x;
      if startX < wd then
      begin
        rgn2:=CreateRectRgn(startX+1,y,endX,y+1);
        if rgn2 <> 0 then CombineRgn (Result, Result,rgn2, RGN_OR);
        DeleteObject(rgn2);
      end;
    end;
  end;
 End;
//główna część procedury...
Begin
 SetWindowRgn(Form.Handle, KreujRegion(Bitmap,TransparentColor), True);
End; 
{------- Instrukcje do wykonania podczas załadowania modułu --------}
INITIALIZATION
 bitmapDst:= TBitmap.Create;    //wykreowanie bitmapy obrazka po "sfiltrowaniu"
{---- Instrukcje do wykonania podczas zakończenia pracy modułu ----}
FINALIZATION
 bitmapDst.Free                      //zwolnienie bitmapy obrazka po "sfiltrowaniu"
END. 

PRAKTYCZNE ZASOSOWANIE W PROGRAMIE

UNIT BitmapaOperacjeForm;
INTERFACE
Uses
  modBitmap, //moduł zawiera procedury do obsługi Bitmap
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls;
Type
  TForm1 = class(TForm)
    Image1: TImage;
    ramkaGroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    PROCEDURE FormCreate(Sender: TObject);
    PROCEDURE ScrollBar1Change(Sender: TObject);
    PROCEDURE ScrollBar2Change(Sender: TObject);
  Private
    PROCEDURE Pokazuj; //Pokazywanie obrazków
  Public
    {Public declarations}
  End;

VAR
 Form1 :TForm1;
 obrazek1,obrazek2,obrazekTlo :TBitmap;
{********************************************************}
IMPLEMENTATION {$R *.DFM}
PROCEDURE TForm1.FormCreate(Sender: TObject);
Begin
  //wykreowanie zmiennych bitmap...
 Obrazek1:= TBitmap.Create;
 Obrazek2:= TBitmap.Create;
 ObrazekTlo:= TBitmap.Create;
 //wczytanie obrazków do zmiennych bitmap
 Obrazek1.LoadFromFile('Obrazek1.bmp');
 Obrazek2.LoadFromFile('Obrazek2.bmp');
 ObrazekTlo.LoadFromFile('ObrazekTło.bmp');
 //wywołanie procedury pokazywania obrazków
 Pokazuj;
End; 
{=========== Pokazywanie obrazków =================}
PROCEDURE TForm1.Pokazuj;
var
 obrazekTmp    :TBitmap;
 Filtr1,Filtr2 :Byte;
Begin
 obrazekTmp:=TBitmap.Create;       //wykreowanie zmiennej obrazka tymczasowego
 obrazekTmp.Assign(ObrazekTlo);   //przepisanie zawartości z obrazka tła
 //ustawianie wielkości filtra (0-255)
 Filtr1:=ScrollBar1.Position;
 Filtr2:=ScrollBar2.Position;
 //ustawienie opcji wyświetlania jako duszka...
 Obrazek1.Transparent:=true;
 Obrazek2.Transparent:=true;
 //filtrowanie obrazków
 BitmapFilter(10,10,obrazek1,ObrazekTmp,Filtr1);
 BitmapFilter(50,30,obrazek2,ObrazekTmp,Filtr2);
 //narysowanie tła zawierającego obrazki "półprzezroczyste"
 Image1.Canvas.Draw(0,0,ObrazekTmp);
 {używając poniższego rysujesz półprzezroczyte bitmapy na pulpicie
 ObrazekTlo.canvas.handle:=GetWindowDC(GetDesktopWindow); }
End; 
{============= Pobieranie danych filtrów ==============}
{----------- Ustawianie filtra1 za pomocą ScrollBar1 ---------------------}
PROCEDURE TForm1.ScrollBar1Change(Sender: TObject);
Begin
 Edit1.Text:=IntToStr(ScrollBar1.Position);
 Pokazuj;
End;
{----------- Ustawianie filtra2 za pomocą ScrollBar2 ---------------------}
PROCEDURE TForm1.ScrollBar2Change(Sender: TObject);
Begin
 Edit2.Text:=IntToStr(ScrollBar2.Position);
 Pokazuj;
End;

END.

Zakres filtrowania 0-255 więc po wrzuceniu na formę TScrollBar ustaw
opcje Max = 255

//Ps. w module dodatkowo zawarta jest procka. dotycząca regionu -
też można by ją zastosować - chociaż w tym przykładzie jest zbędna