Delphi World - Получить прозрачный цвет
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получить прозрачный цвет

Оформил: 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;
 {------------------------------------------------------------------------------}
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования