Получить прозрачный цвет

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
;
 {------------------------------------------------------------------------------}

Другое по теме:

• Работа с палитрой
• Перевод RGB в GRAY
• Преобразование цвета RGB 34 HLS