1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
|
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Math;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses LCLType; // uniquement pour Muldiv
FUNCTION RGBtoBGRA(CONST R, G, B: BYTE): Cardinal;
BEGIN
Result := R or (G SHL 8) or (B SHL 16) or $FF000000;
end;
FUNCTION HSVtoBGRA (CONST H,S,V: INTEGER): Cardinal;
CONST
divisor: INTEGER = 255*60;
VAR
f : INTEGER;
hTemp: INTEGER;
p,q,t: INTEGER;
VS : INTEGER;
BEGIN
IF S = 0
THEN RESULT := RGBtoBGRA(V, V, V) // achromatic: shades of gray
ELSE BEGIN // chromatic color
IF H = 360
THEN hTemp := 0
ELSE hTemp := H;
f := hTemp MOD 60; // f is IN [0, 59]
hTemp := hTemp DIV 60; // h is now IN [0,6)
VS := V*S;
p := V - VS DIV 255; // p = v * (1 - s)
q := V - (VS*f) DIV divisor; // q = v * (1 - s*f)
t := V - (VS*(60 - f)) DIV divisor; // t = v * (1 - s * (1 - f))
CASE hTemp OF
0: RESULT := RGBtoBGRA(V, t, p);
1: RESULT := RGBtoBGRA(q, V, p);
2: RESULT := RGBtoBGRA(p, V, t);
3: RESULT := RGBtoBGRA(p, q, V);
4: RESULT := RGBtoBGRA(t, p, V);
5: RESULT := RGBtoBGRA(V, p, q);
ELSE RESULT := RGBtoBGRA(0,0,0) // should never happen;
// avoid compiler warning
END
END
END;
FUNCTION CreateHueSaturationCircle(CONST size: INTEGER;
CONST HueLevel: INTEGER;
CONST SaturationLevel: INTEGER;
CONST ValueLevel: INTEGER;
CONST BackgroundColor: TColor;
CONST SaturationCircleColor: TColor;
CONST HueLineColor: TColor): TBitmap;
VAR
angle : Double;
delta : INTEGER;
dSquared : INTEGER;
H,S,V : INTEGER;
i : INTEGER;
j : INTEGER;
Radius : INTEGER;
RadiusSquared: INTEGER;
X : INTEGER;
Y : INTEGER;
p: PCardinal; // pointeur utilisé dans scanline
BEGIN
RESULT := TBitmap.Create;//(size, size, BackGroundColor); // création avec taille + couleur de fond
Result.PixelFormat := pf32Bit;
Result.SetSize(size, size);
Radius := size DIV 2;
RadiusSquared := Radius*Radius;
V := ValueLevel;
Result.BeginUpdate;
FOR j := 0 TO RESULT.Height-1 DO
BEGIN
Y := Size - 1 - j - Radius; {Center is Radius offset}
P := RESULT.Scanline[Size - 1 - j];
FOR i := 0 TO RESULT.Width-1 DO
BEGIN
X := i - Radius;
dSquared := X*X + Y*Y;
IF dSquared <= RadiusSquared then
BEGIN
S := ROUND( (255 * SQRT(dSquared)) / Radius );
H := ROUND( 180 * (1 + ArcTan2(X, Y) / PI)); // 0..360 degrees
// Shift 90 degrees so H=0 (red) occurs along "X" axis
H := H + 90;
IF H > 360 THEN H := H - 360;
p^ := HSVtoBGRA(H,S,V); // adapté pour bgrabitmap
END ELSE BEGIN
p^ := BackgroundColor; // couleur de fond
END;
Inc(P); // incrémentation du pointeur
END;
END;
Result.EndUpdate;
//Result.InvalidateBitmap; // obligatoire après un scanline
// Draw Saturation Circle
IF SaturationLevel IN [1..254]
THEN
with Result.Canvas do
begin
AntialiasingMode:= amOn;
Pen.Width:= 1;
Pen.Color := SaturationCircleColor;
Brush.Style := bsClear;
delta := MulDiv(Radius, SaturationLevel, 255);
Ellipse(Radius - delta,
Radius - delta,
Radius + delta,
Radius + delta);
end;
// Draw Hue Line
IF (SaturationLevel <> 0) AND
((HueLevel >= 0) AND (HueLevel <= 360))
THEN
with Result.Canvas do
begin
// Use negative value for counterclockwise angles with the "Y"
// direction going the "wrong" (mathematical) way
Angle := -HueLevel * PI / 180;
AntialiasingMode:= amOn;
Pen.Width:= 1;
Pen.Color := HueLineColor;
MoveTo(Radius,Radius);
LineTo(Radius + Round(Radius*COS(angle)),
Radius + Round(Radius*SIN(angle)));
end;
END; {CreateHueSaturationCircle}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp: TBitmap;
begin
try
Bmp := CreateHueSaturationCircle(200, 255,240,250,ColorToRGB(clBtnFace) or $FF000000,clgray,clblack);
//Bmp.Draw(Image1.Canvas, 0,0,true);
Image1.Picture.Graphic := Bmp;
finally
Bmp.Free;
end;
end;
end. |
Partager