mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 04:28:00 +02:00
38 lines
569 B
ObjectPascal
38 lines
569 B
ObjectPascal
{ %opt=-O2 }
|
|
|
|
{$mode objfpc}
|
|
|
|
type
|
|
TFPColor = record
|
|
red,green,blue,alpha : word;
|
|
end;
|
|
TColorData = qword;
|
|
|
|
tcl=class
|
|
function ColorColorAlpha16 (CD:TColorData) : TFPColor;
|
|
end;
|
|
|
|
function tcl.ColorColorAlpha16 (CD:TColorData) : TFPColor;
|
|
var c : qword;
|
|
begin
|
|
with result do
|
|
begin
|
|
red := CD and $FFFF;
|
|
c := qword($FFFF0000);
|
|
green := (CD and c) shr 16;
|
|
c := c shl 16;
|
|
blue := (CD and c) shr 32;
|
|
c := c shl 16;
|
|
alpha := (CD and c) shr 48;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
cd : tcolordata;
|
|
c : tcl;
|
|
begin
|
|
cd:=$1234;
|
|
c:=tcl.create;
|
|
c.colorcoloralpha16(cd);
|
|
end.
|