Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

interface
 {------------------------------------------------------------------------------}

 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
 {------------------------------------------------------------------------------}
 //Hilfsfunktion zum Auslesen eines Bytes aus TColor 
//Value gibt die Farbe an 
//Shift gibt die Anzahl der zu schiebenden Bits an 
//Bsp: um aus Value=$00120000 das Rot-Byte auszulesen, muss Shift den Wert 16 haben 
//     ($12 wird dann zuruckgegeben 
function GetByte(Value : TColor; Shift : byte): byte;
   {------------------------------------------------------------------------------}
   //Hilfsprozedur zum Auslesen des Rot-,Grun- und Blauwertes aus TColor 
  //nutzt GetByte 
procedure ColorToRGB(Color : TColor; var R, G, B : byte);
   {------------------------------------------------------------------------------}
   //Hilfsfunckion zum Erstellen eines TColor aus Rot-,Grun- und Blauwerten 
function RGBToColor(R, G, B : byte): TColor;
   {------------------------------------------------------------------------------}
   //Eigentliche Transparenzfunktion, ermittelt die Transparenzfarbe des transparenten 
  //Vordergrunds, wenn Hintergrundfarbe=BGColor und Vordergrundfarbe=FRColor ist 
  //TranspValue gibt den Ganzzahligen Prozentsatz des Transparenzwertes an 
function TransparencyColor(BGColor, FRColor : TColor; TranspValue : byte): TColor;
   {------------------------------------------------------------------------------}

 implementation

 function GetByte(Value : TColor; Shift : byte): byte;
 begin
   Result := (Value and ($FF shl Shift)) shr Shift;
   //Byte an entsprechender Stelle maskieren und dann nach Rechts verschieben 
end;
 {------------------------------------------------------------------------------}

 procedure ColorToRGB(Color : TColor; var R, G, B : byte);
 begin
   R := GetByte(Color, 16); //zweites Byte aus Color (v.R.) 
  G := GetByte(Color, 8);  //drittes Byte aus Color (v.R.) 
  B := GetByte(Color, 0);  //viertes Byte aus Color (v.R.) 
end;
 {------------------------------------------------------------------------------}

 function RGBToColor(R, G, B : byte): TColor;
 begin
   Result := ((R and $FF) shl 16) +
     ((G and $FF) shl 8) + (B and $FF);
 end;
 {------------------------------------------------------------------------------}

 function TransparencyColor(BGColor, FRColor : TColor; TranspValue : byte): TColor;
 var
    BGR, BGG, BGB, FRR, FRG, FRB, ergR, ergG, ergB : byte;
   TrFact : real;
 begin
   //Transparenzfaktor errechnen 
  TrFact := TranspValue / 100;

   //Hinter- und Vordergrundfarbe in Rot-,Grun- und Blauwerte splitten 
  ColorToRGB(BGColor, BGR, BGG, BGB);
   ColorToRGB(FRColor, FRR, FRG, FRB);

   //Ergebnisfarbwerte errechnen 
  ergR := byte(Trunc(BGR * TrFact + FRR * (1 - TrFact)));
   ergG := byte(Trunc(BGG * TrFact + FRG * (1 - TrFact)));
   ergB := byte(Trunc(BGB * TrFact + FRB * (1 - TrFact)));

   //Rot-,Grun- und Blauwert zu TColor und zuruckgeben 
  Result := RGBToColor(ErgR, ergG, ergB);
 end;
 {------------------------------------------------------------------------------}