Tips (1541)

Tip Rating (5):

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 zurückgegeben
function GetByte(Value : TColor; Shift : byte): byte;
  {------------------------------------------------------------------------------}
  //Hilfsprozedur zum Auslesen des Rot-,Grün- und Blauwertes aus TColor
  //nutzt GetByte
procedure ColorToRGB(Color : TColor; var R, G, B : byte);
  {------------------------------------------------------------------------------}
  //Hilfsfunckion zum Erstellen eines TColor aus Rot-,Grün- 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-,Grün- 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-,Grün- und Blauwert zu TColor und zurückgeben
  Result := RGBToColor(ErgR, ergG, ergB);
end;
{------------------------------------------------------------------------------}