this slowpoke moves

Get Tranzparency Color

var
  Form1: TForm1;

//Help function for reading a byte from TColor
//Value specifies the color
//Shift specifies the number of bits to shift
//Example: to read the red byte from Value=$00120000, Shift must have the value 16
//  ($12 will then be returned
function GetByte(Value : TColor; Shift : byte): byte;

  //Auxiliary procedure for reading the red, green and blue values ??from TColor
  //uses GetByte
procedure ColorToRGB(Color : TColor; var R, G, B : byte);

  //Auxiliary function for creating a TColor from red, green and blue values
function RGBToColor(R, G, B : byte): TColor;

  //Actual transparency function, determines the transparency color of the transparent
  //Foreground if background color=BGColor and foreground color=FRColor
  //TranspValue specifies the integer percentage of the transparency value
function TransparencyColor(BGColor, FRColor : TColor; TranspValue : byte): TColor;


implementation

{$R *.dfm}
function GetByte(Value : TColor; Shift : byte): byte;
begin
  //Mask the byte at the appropriate location and then move it to the right
  Result := (Value and ($FF shl Shift)) shr Shift;
end;

procedure ColorToRGB(Color : TColor; var R, G, B : byte);
begin
  R := GetByte(Color, 16); //second byte from color (from right)
  G := GetByte(Color, 8);  //third byte from color (from right)
  B := GetByte(Color, 0);  //fourth byte from color (from right)
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
  //Calculate transparency factor
  TrFact := TranspValue / 100;

  //Split background and foreground colors into red, green and blue values
  ColorToRGB(BGColor, BGR, BGG, BGB);
  ColorToRGB(FRColor, FRR, FRG, FRB);

  //Calculate result color values
  ergR := byte(Trunc(BGR * TrFact + FRR * (1 - TrFact)));
  ergG := byte(Trunc(BGG * TrFact + FRG * (1 - TrFact)));
  ergB := byte(Trunc(BGB * TrFact + FRB * (1 - TrFact)));

  //Red, green and blue value to TColor and return
  Result := RGBToColor(ErgR, ergG, ergB);
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate