source: trunk/Packages/Graphics32/GR32_ColorPicker.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 57.9 KB
Line 
1unit GR32_ColorPicker;
2
3(* ***** BEGIN LICENSE BLOCK *****
4 * Version: MPL 1.1 or LGPL 2.1 with linking exception
5 *
6 * The contents of this file are subject to the Mozilla Public License Version
7 * 1.1 (the "License"); you may not use this file except in compliance with
8 * the License. You may obtain a copy of the License at
9 * http://www.mozilla.org/MPL/
10 *
11 * Software distributed under the License is distributed on an "AS IS" basis,
12 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13 * for the specific language governing rights and limitations under the
14 * License.
15 *
16 * Alternatively, the contents of this file may be used under the terms of the
17 * Free Pascal modified version of the GNU Lesser General Public License
18 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
19 * of this license are applicable instead of those above.
20 * Please see the file LICENSE.txt for additional information concerning this
21 * license.
22 *
23 * The Original Code is Graphics32
24 *
25 * The Initial Developer of the Original Code is
26 * Alex A. Denisov
27 *
28 * Portions created by the Initial Developer are Copyright (C) 2000-2009
29 * the Initial Developer. All Rights Reserved.
30 *
31 * Contributor(s):
32 * Christan-W. Budde <Christian@savioursofsoul.de>
33 *
34 * ***** END LICENSE BLOCK ***** *)
35
36interface
37
38{$I GR32.inc}
39
40uses
41{$IFDEF FPC}
42 LCLIntf, LCLType, LMessages, Types,
43 {$IFDEF MSWINDOWS}
44 Windows,
45 {$ENDIF}
46{$ELSE}
47 Windows, Messages, Types,
48{$ENDIF}
49 Classes, Controls, Forms, GR32, GR32_Polygons, GR32_Containers,
50 GR32_ColorGradients;
51
52type
53 TScreenColorPickerForm = class(TCustomForm)
54 private
55 FSelectedColor: TColor32;
56 FOnColorSelected: TNotifyEvent;
57 protected
58 procedure CreateParams(var Params: TCreateParams); override;
59 procedure KeyDown(var Key: Word; Shift: TShiftState); override;
60 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
61 Y: Integer); override;
62 procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
63 public
64 constructor Create(AOwner: TComponent); override;
65
66 property SelectedColor: TColor32 read FSelectedColor write FSelectedColor;
67 property OnColorSelected: TNotifyEvent read FOnColorSelected write FOnColorSelected;
68 published
69 property OnKeyUp;
70 property OnKeyPress;
71 property OnKeyDown;
72 property OnMouseMove;
73 property OnMouseUp;
74 property OnMouseDown;
75 end;
76
77 THueCirclePolygonFiller = class(TCustomPolygonFiller)
78 private
79 FCenter: TFloatPoint;
80 FWebSafe: Boolean;
81 protected
82 function GetFillLine: TFillLineEvent; override;
83 procedure FillLine(Dst: PColor32; DstX, DstY, Length: Integer;
84 AlphaValues: PColor32; CombineMode: TCombineMode); virtual;
85 procedure FillLineWebSafe(Dst: PColor32; DstX, DstY, Length: Integer;
86 AlphaValues: PColor32; CombineMode: TCombineMode); virtual;
87 public
88 constructor Create(Center: TFloatPoint; WebSafe: Boolean = False);
89
90 property Center: TFloatPoint read FCenter write FCenter;
91 property WebSafe: Boolean read FWebSafe write FWebSafe;
92 end;
93
94 THueSaturationCirclePolygonFiller = class(THueCirclePolygonFiller)
95 private
96 FRadius: Single;
97 FInvRadius: Single;
98 FValue: Single;
99 procedure SetRadius(const Value: Single);
100 protected
101 procedure FillLine(Dst: PColor32; DstX, DstY, Length: Integer;
102 AlphaValues: PColor32; CombineMode: TCombineMode); override;
103 procedure FillLineWebSafe(Dst: PColor32; DstX, DstY, Length: Integer;
104 AlphaValues: PColor32; CombineMode: TCombineMode); override;
105 public
106 constructor Create(Center: TFloatPoint; Radius, Value: Single;
107 WebSafe: Boolean = False);
108
109 property Radius: Single read FRadius write SetRadius;
110 property Value: Single read FValue write FValue;
111 end;
112
113 TBarycentricGradientPolygonFillerEx = class(TBarycentricGradientPolygonFiller)
114 private
115 FWebSafe: Boolean;
116 protected
117 function GetFillLine: TFillLineEvent; override;
118 procedure FillLineWebSafe(Dst: PColor32; DstX, DstY, Length: Integer;
119 AlphaValues: PColor32; CombineMode: TCombineMode);
120 public
121 property WebSafe: Boolean read FWebSafe write FWebSafe;
122 end;
123
124 TVisualAid = set of (vaHueLine, vaSaturationCircle, vaSelection);
125 TVisualAidRenderType = (vatSolid, vatInvert, vatBW);
126
127 TAdjustCalc = procedure (X, Y: Single) of object;
128 TPreserveComponent = set of (pcHue, pcSaturation, pcLuminance, pcValue);
129
130 TVisualAidOptions = class(TPersistent)
131 private
132 FOwner: TPersistent;
133 FRenderType: TVisualAidRenderType;
134 FColor: TColor32;
135 FLineWidth: Single;
136 procedure SetRenderType(const Value: TVisualAidRenderType);
137 procedure SetColor(const Value: TColor32);
138 procedure SetLineWidth(const Value: Single);
139 protected
140 function GetOwner: TPersistent; override;
141 procedure Changed; virtual;
142 public
143 constructor Create(AOwner: TPersistent); virtual;
144
145 property Owner: TPersistent read FOwner;
146 published
147 property RenderType: TVisualAidRenderType read FRenderType write SetRenderType default vatInvert;
148 property Color: TColor32 read FColor write SetColor;
149 property LineWidth: Single read FLineWidth write SetLineWidth;
150 end;
151
152 TCustomColorPicker = class(TCustomControl)
153 private
154 FBuffer: TBitmap32;
155 FAdjustCalc: TAdjustCalc;
156 FSelectedColor: TColor32;
157 FBufferValid: Boolean;
158 FPreserveComponent: TPreserveComponent;
159 FVisualAidOptions: TVisualAidOptions;
160 FWebSafe: Boolean;
161 FBorder: Boolean;
162 FOnChanged: TNotifyEvent;
163 procedure SetBorder(const Value: Boolean);
164 procedure SetWebSafe(const Value: Boolean);
165 procedure SetSelectedColor(const Value: TColor32);
166{$IFDEF FPC}
167 procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
168 procedure WMGetDlgCode(var Msg: TLMessage); message LM_GETDLGCODE;
169{$ELSE}
170 procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
171 procedure WMGetDlgCode(var Msg: TWmGetDlgCode); message WM_GETDLGCODE;
172{$ENDIF}
173 protected
174 procedure Paint; override;
175 procedure PaintColorPicker; virtual; abstract;
176 procedure SelectedColorChanged; virtual;
177 public
178 constructor Create(AOwner: TComponent); override;
179 destructor Destroy; override;
180
181 procedure Invalidate; override;
182 procedure Resize; override;
183
184 property Border: Boolean read FBorder write SetBorder default False;
185 property VisualAidOptions: TVisualAidOptions read FVisualAidOptions;
186 property SelectedColor: TColor32 read FSelectedColor write SetSelectedColor;
187 property WebSafe: Boolean read FWebSafe write SetWebSafe;
188
189 property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
190 end;
191
192 TColorComponent = (ccRed, ccGreen, ccBlue, ccAlpha);
193
194 TCustomColorPickerComponent = class(TCustomColorPicker)
195 private
196 FMouseDown: Boolean;
197 FColorComponent: TColorComponent;
198 procedure SetColorComponent(const Value: TColorComponent);
199 protected
200 procedure PaintColorPicker; override;
201 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
202 Y: Integer); override;
203 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
204 Y: Integer); override;
205 procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
206 public
207 constructor Create(AOwner: TComponent); override;
208
209 property ColorComponent: TColorComponent read FColorComponent write SetColorComponent;
210 end;
211
212 TCustomColorPickerRGBA = class(TCustomColorPicker)
213 private
214 FBarHeight: Integer;
215 FSpaceHeight: Integer;
216 procedure SetBarHeight(const Value: Integer);
217 procedure SetSpaceHeight(const Value: Integer);
218 procedure PickAlpha(X, Y: Single);
219 procedure PickBlue(X, Y: Single);
220 procedure PickGreen(X, Y: Single);
221 procedure PickRed(X, Y: Single);
222 protected
223 procedure PaintColorPicker; override;
224 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
225 Y: Integer); override;
226 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
227 Y: Integer); override;
228 procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
229 public
230 constructor Create(AOwner: TComponent); override;
231
232 property BarHeight: Integer read FBarHeight write SetBarHeight default 24;
233 property SpaceHeight: Integer read FSpaceHeight write SetSpaceHeight default 8;
234 end;
235
236 TMarkerType = (mtCross, mtCircle);
237
238 TCustomColorPickerHS = class(TCustomColorPicker)
239 private
240 FHue: Single;
241 FSaturation: Single;
242 FMarkerType: TMarkerType;
243 procedure PickHue(X, Y: Single);
244 procedure SetHue(const Value: Single);
245 procedure SetSaturation(const Value: Single);
246 procedure SetMarkerType(const Value: TMarkerType);
247 protected
248 procedure PaintColorPicker; override;
249 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
250 Y: Integer); override;
251 procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
252 procedure SelectedColorChanged; override;
253 public
254 constructor Create(AOwner: TComponent); override;
255
256 property MarkerType: TMarkerType read FMarkerType write SetMarkerType;
257 property Hue: Single read FHue write SetHue;
258 property Saturation: Single read FSaturation write SetSaturation;
259 end;
260
261 TCustomColorPickerHSV = class(TCustomColorPicker)
262 private
263 FCenter: TFloatPoint;
264 FHue: Single;
265 FRadius: TFloat;
266 FCircleSteps: Integer;
267 FSaturation: Single;
268 FValue: Single;
269 FVisualAid: TVisualAid;
270 procedure PickHue(X, Y: Single);
271 procedure PickValue(X, Y: Single);
272 procedure SetHue(const Value: Single);
273 procedure SetSaturation(const Value: Single);
274 procedure SetValue(const Value: Single);
275 procedure SetVisualAid(const Value: TVisualAid);
276 protected
277 procedure PaintColorPicker; override;
278 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
279 Y: Integer); override;
280 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
281 Y: Integer); override;
282 procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
283 procedure SelectedColorChanged; override;
284 public
285 constructor Create(AOwner: TComponent); override;
286
287 procedure Resize; override;
288
289 property Hue: Single read FHue write SetHue;
290 property Saturation: Single read FSaturation write SetSaturation;
291 property Value: Single read FValue write SetValue;
292 property VisualAid: TVisualAid read FVisualAid write SetVisualAid;
293 end;
294
295 TVisualAidGTK = set of (vagHueLine, vagSelection);
296
297 TCustomColorPickerGTK = class(TCustomColorPicker)
298 private
299 FCenter: TFloatPoint;
300 FHue: Single;
301 FRadius: TFloat;
302 FInnerRadius: TFloat;
303 FCircleSteps: Integer;
304 FSaturation: Single;
305 FValue: Single;
306 FVisualAid: TVisualAidGTK;
307 procedure PickHue(X, Y: Single);
308 procedure PickSaturationValue(X, Y: Single);
309 procedure SetHue(const Value: Single);
310 procedure SetSaturation(const Value: Single);
311 procedure SetValue(const Value: Single);
312 procedure SetVisualAid(const Value: TVisualAidGTK);
313 procedure SetRadius(const Value: TFloat);
314 protected
315 procedure PaintColorPicker; override;
316 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
317 Y: Integer); override;
318 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
319 Y: Integer); override;
320 procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
321 procedure SelectedColorChanged; override;
322
323 property Radius: TFloat read FRadius write SetRadius;
324 property Center: TFloatPoint read FCenter write FCenter;
325 public
326 constructor Create(AOwner: TComponent); override;
327
328 procedure Resize; override;
329
330 property Hue: Single read FHue write SetHue;
331 property Saturation: Single read FSaturation write SetSaturation;
332 property Value: Single read FValue write SetValue;
333 property VisualAid: TVisualAidGTK read FVisualAid write SetVisualAid;
334 end;
335
336 TColorPickerComponent = class(TCustomColorPickerComponent)
337 published
338 property Align;
339 property Anchors;
340 property Border;
341 property ColorComponent;
342 property DragCursor;
343 property DragKind;
344 property Enabled;
345{$IFDEF HasParentBackground}
346 property ParentBackground;
347{$ENDIF}
348 property ParentColor;
349 property ParentShowHint;
350 property PopupMenu;
351 property SelectedColor;
352 property TabOrder;
353 property TabStop;
354 property VisualAidOptions;
355 property WebSafe default False;
356
357{$IFNDEF PLATFORM_INDEPENDENT}
358 property OnCanResize;
359{$ENDIF}
360 property OnChanged;
361 property OnClick;
362 property OnDblClick;
363 property OnDragDrop;
364 property OnDragOver;
365 property OnEndDrag;
366 property OnMouseDown;
367 property OnMouseMove;
368 property OnMouseUp;
369 property OnMouseWheel;
370 property OnMouseWheelDown;
371 property OnMouseWheelUp;
372{$IFDEF COMPILER2005_UP}
373 property OnMouseEnter;
374 property OnMouseLeave;
375{$ENDIF}
376 property OnResize;
377 property OnStartDrag;
378 end;
379
380 TColorPickerRGBA = class(TCustomColorPickerRGBA)
381 published
382 property Align;
383 property Anchors;
384 property BarHeight;
385 property Border;
386 property DragCursor;
387 property DragKind;
388 property Enabled;
389{$IFDEF HasParentBackground}
390 property ParentBackground;
391{$ENDIF}
392 property ParentColor;
393 property ParentShowHint;
394 property PopupMenu;
395 property SelectedColor;
396 property SpaceHeight;
397 property TabOrder;
398 property TabStop;
399 property VisualAidOptions;
400 property WebSafe default False;
401
402{$IFNDEF PLATFORM_INDEPENDENT}
403 property OnCanResize;
404{$ENDIF}
405 property OnChanged;
406 property OnClick;
407 property OnDblClick;
408 property OnDragDrop;
409 property OnDragOver;
410 property OnEndDrag;
411 property OnMouseDown;
412 property OnMouseMove;
413 property OnMouseUp;
414 property OnMouseWheel;
415 property OnMouseWheelDown;
416 property OnMouseWheelUp;
417{$IFDEF COMPILER2005_UP}
418 property OnMouseEnter;
419 property OnMouseLeave;
420{$ENDIF}
421 property OnResize;
422 property OnStartDrag;
423 end;
424
425 TColorPickerHS = class(TCustomColorPickerHS)
426 published
427 property Align;
428 property Anchors;
429 property DragCursor;
430 property DragKind;
431 property Enabled;
432 property Hue;
433 property MarkerType;
434{$IFDEF HasParentBackground}
435 property ParentBackground;
436{$ENDIF}
437 property ParentColor;
438 property ParentShowHint;
439 property PopupMenu;
440 property Saturation;
441 property SelectedColor;
442 property TabOrder;
443 property TabStop;
444 property WebSafe default False;
445
446{$IFNDEF PLATFORM_INDEPENDENT}
447 property OnCanResize;
448{$ENDIF}
449 property OnChanged;
450 property OnClick;
451 property OnDblClick;
452 property OnDragDrop;
453 property OnDragOver;
454 property OnEndDrag;
455 property OnMouseDown;
456 property OnMouseMove;
457 property OnMouseUp;
458 property OnMouseWheel;
459 property OnMouseWheelDown;
460 property OnMouseWheelUp;
461{$IFDEF COMPILER2005_UP}
462 property OnMouseEnter;
463 property OnMouseLeave;
464{$ENDIF}
465 property OnResize;
466 property OnStartDrag;
467 end;
468
469 TColorPickerHSV = class(TCustomColorPickerHSV)
470 published
471 property Align;
472 property Anchors;
473 property Border;
474 property DragCursor;
475 property DragKind;
476 property Enabled;
477 property Hue;
478{$IFDEF HasParentBackground}
479 property ParentBackground;
480{$ENDIF}
481 property ParentColor;
482 property ParentShowHint;
483 property PopupMenu;
484 property Saturation;
485 property SelectedColor;
486 property TabOrder;
487 property TabStop;
488 property Value;
489 property VisualAid default [vaHueLine, vaSaturationCircle, vaSelection];
490 property VisualAidOptions;
491 property WebSafe default False;
492
493{$IFNDEF PLATFORM_INDEPENDENT}
494 property OnCanResize;
495{$ENDIF}
496 property OnChanged;
497 property OnClick;
498 property OnDblClick;
499 property OnDragDrop;
500 property OnDragOver;
501 property OnEndDrag;
502 property OnMouseDown;
503 property OnMouseMove;
504 property OnMouseUp;
505 property OnMouseWheel;
506 property OnMouseWheelDown;
507 property OnMouseWheelUp;
508{$IFDEF COMPILER2005_UP}
509 property OnMouseEnter;
510 property OnMouseLeave;
511{$ENDIF}
512 property OnResize;
513 property OnStartDrag;
514 end;
515
516 TColorPickerGTK = class(TCustomColorPickerGTK)
517 published
518 property Align;
519 property Anchors;
520 property Border;
521 property DragCursor;
522 property DragKind;
523 property Enabled;
524 property Hue;
525{$IFDEF HasParentBackground}
526 property ParentBackground;
527{$ENDIF}
528 property ParentColor;
529 property ParentShowHint;
530 property PopupMenu;
531 property Saturation;
532 property SelectedColor;
533 property TabOrder;
534 property TabStop;
535 property Value;
536 property VisualAid default [vagHueLine, vagSelection];
537 property VisualAidOptions;
538 property WebSafe default False;
539
540{$IFNDEF PLATFORM_INDEPENDENT}
541 property OnCanResize;
542{$ENDIF}
543 property OnChanged;
544 property OnClick;
545 property OnDblClick;
546 property OnDragDrop;
547 property OnDragOver;
548 property OnEndDrag;
549 property OnMouseDown;
550 property OnMouseMove;
551 property OnMouseUp;
552 property OnMouseWheel;
553 property OnMouseWheelDown;
554 property OnMouseWheelUp;
555{$IFDEF COMPILER2005_UP}
556 property OnMouseEnter;
557 property OnMouseLeave;
558{$ENDIF}
559 property OnResize;
560 property OnStartDrag;
561 end;
562
563implementation
564
565uses
566 Math, Graphics, GR32_Backends, GR32_Math, GR32_Blend, GR32_VectorUtils;
567
568procedure RoundToWebSafe(var Color: TColor32);
569begin
570 with TColor32Entry(Color) do
571 begin
572 R := ((R + $19) div $33) * $33;
573 G := ((G + $19) div $33) * $33;
574 B := ((B + $19) div $33) * $33;
575 end;
576end;
577
578{$IFDEF MSWINDOWS}
579function GetDesktopColor(const x, y: Integer): TColor32;
580var
581 c: TCanvas;
582begin
583 c := TCanvas.Create;
584 try
585 c.Handle := GetWindowDC(GetDesktopWindow);
586 Result := Color32(GetPixel(c.Handle, x, y));
587 finally
588 c.Free;
589 end;
590end;
591{$ENDIF}
592
593
594{ TVisualAidOptions }
595
596constructor TVisualAidOptions.Create(AOwner: TPersistent);
597begin
598 inherited Create;
599
600 FOwner := AOwner;
601 FColor := $AF000000;
602 FRenderType := vatInvert;
603 FLineWidth := 2;
604end;
605
606procedure TVisualAidOptions.Changed;
607begin
608 if Owner is TCustomColorPicker then
609 TCustomColorPicker(Owner).Invalidate;
610end;
611
612function TVisualAidOptions.GetOwner: TPersistent;
613begin
614 if FOwner is TPersistent then
615 Result := TPersistent(FOwner)
616 else
617 Result := nil;
618end;
619
620procedure TVisualAidOptions.SetColor(const Value: TColor32);
621begin
622 if FColor <> Value then
623 begin
624 FColor := Value;
625 if FRenderType = vatSolid then
626 Changed;
627 end;
628end;
629
630procedure TVisualAidOptions.SetLineWidth(const Value: Single);
631begin
632 if FLineWidth <> Value then
633 begin
634 FLineWidth := Value;
635 Changed;
636 end;
637end;
638
639procedure TVisualAidOptions.SetRenderType(const Value: TVisualAidRenderType);
640begin
641 if FRenderType <> Value then
642 begin
643 FRenderType := Value;
644 Changed;
645 end;
646end;
647
648
649{ TScreenColorPickerForm }
650
651constructor TScreenColorPickerForm.Create(AOwner: TComponent);
652begin
653 inherited CreateNew(AOwner);
654 Align := alClient;
655 BorderIcons := [];
656 BorderStyle := bsNone;
657 Caption := 'Pick a color...';
658 FormStyle := fsStayOnTop;
659 Position := poDefault;
660 FSelectedColor := 0;
661end;
662
663procedure TScreenColorPickerForm.CreateParams(var Params: TCreateParams);
664begin
665 inherited CreateParams(Params);
666 Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
667end;
668
669procedure TScreenColorPickerForm.KeyDown(var Key: Word; Shift: TShiftState);
670begin
671 if (Key = VK_ESCAPE) then
672 ModalResult := mrCancel
673 else
674 inherited;
675end;
676
677procedure TScreenColorPickerForm.MouseDown(Button: TMouseButton;
678 Shift: TShiftState; X, Y: Integer);
679begin
680 if Button = mbLeft then
681 begin
682 {$IFDEF MSWINDOWS}
683 FSelectedColor := GetDesktopColor(X, Y);
684 if Assigned(FOnColorSelected) then
685 FOnColorSelected(Self);
686 {$ENDIF}
687 ModalResult := mrOk
688 end
689 else
690 inherited;
691end;
692
693procedure TScreenColorPickerForm.MouseMove(Shift: TShiftState; X, Y: Integer);
694begin
695 {$IFDEF MSWINDOWS}
696 FSelectedColor := GetDesktopColor(X, Y);
697 {$ENDIF}
698 inherited;
699end;
700
701
702{ THueCirclePolygonFiller }
703
704constructor THueCirclePolygonFiller.Create(Center: TFloatPoint;
705 WebSafe: Boolean = False);
706begin
707 FCenter := Center;
708 FWebSafe := WebSafe;
709
710 inherited Create;
711end;
712
713procedure THueCirclePolygonFiller.FillLine(Dst: PColor32; DstX, DstY,
714 Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
715var
716 X: Integer;
717 H: Single;
718const
719 CTwoPiInv = 1 / (2 * Pi);
720begin
721 for X := DstX to DstX + Length - 1 do
722 begin
723 // calculate squared distance
724 H := 0.5 + ArcTan2(DstY - FCenter.Y, X - FCenter.X) * CTwoPiInv;
725 CombineMem(HSVtoRGB(H, 1, 1), Dst^, AlphaValues^);
726 EMMS;
727 Inc(Dst);
728 Inc(AlphaValues);
729 end;
730end;
731
732procedure THueCirclePolygonFiller.FillLineWebSafe(Dst: PColor32; DstX, DstY,
733 Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
734var
735 X: Integer;
736 H: Single;
737 Color: TColor32;
738const
739 CTwoPiInv = 1 / (2 * Pi);
740begin
741 for X := DstX to DstX + Length - 1 do
742 begin
743 // calculate squared distance
744 H := 0.5 + ArcTan2(DstY - FCenter.Y, X - FCenter.X) * CTwoPiInv;
745 Color := HSVtoRGB(H, 1, 1);
746 RoundToWebSafe(Color);
747 CombineMem(Color, Dst^, AlphaValues^);
748 EMMS;
749 Inc(Dst);
750 Inc(AlphaValues);
751 end;
752end;
753
754function THueCirclePolygonFiller.GetFillLine: TFillLineEvent;
755begin
756 if FWebSafe then
757 Result := FillLineWebSafe
758 else
759 Result := FillLine;
760end;
761
762
763{ THueSaturationCirclePolygonFiller }
764
765constructor THueSaturationCirclePolygonFiller.Create(Center: TFloatPoint;
766 Radius, Value: Single; WebSafe: Boolean = False);
767begin
768 FRadius := Max(1, Radius);
769 FInvRadius := 1 / FRadius;
770 FValue := Value;
771
772 inherited Create(Center, WebSafe);
773end;
774
775procedure THueSaturationCirclePolygonFiller.FillLine(Dst: PColor32; DstX, DstY,
776 Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
777var
778 X: Integer;
779 SqrYDist, H, S: Single;
780const
781 CTwoPiInv = 1 / (2 * Pi);
782begin
783 SqrYDist := Sqr(DstY - FCenter.Y);
784 for X := DstX to DstX + Length - 1 do
785 begin
786 // calculate squared distance
787 H := 0.5 + ArcTan2(DstY - FCenter.Y, X - FCenter.X) * CTwoPiInv;
788 S := Sqrt(Sqr(X - Center.X) + SqrYDist) * FInvRadius;
789 if S > 1 then
790 S := 1;
791
792 CombineMem(HSVtoRGB(H, S, Value), Dst^, AlphaValues^);
793 EMMS;
794 Inc(Dst);
795 Inc(AlphaValues);
796 end;
797end;
798
799procedure THueSaturationCirclePolygonFiller.FillLineWebSafe(Dst: PColor32; DstX, DstY,
800 Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
801var
802 X: Integer;
803 SqrYDist, H, S: Single;
804 Color: TColor32;
805const
806 CTwoPiInv = 1 / (2 * Pi);
807begin
808 SqrYDist := Sqr(DstY - FCenter.Y);
809 for X := DstX to DstX + Length - 1 do
810 begin
811 // calculate squared distance
812 H := 0.5 + ArcTan2(DstY - FCenter.Y, X - FCenter.X) * CTwoPiInv;
813 S := Sqrt(Sqr(X - Center.X) + SqrYDist) * FInvRadius;
814 if S > 1 then
815 S := 1;
816
817 Color := HSVtoRGB(H, S, Value);
818 RoundToWebSafe(Color);
819
820 CombineMem(Color, Dst^, AlphaValues^);
821 EMMS;
822 Inc(Dst);
823 Inc(AlphaValues);
824 end;
825end;
826
827procedure THueSaturationCirclePolygonFiller.SetRadius(const Value: Single);
828begin
829 if FRadius <> Value then
830 begin
831 FRadius := Value;
832 FInvRadius := 1 / FRadius;
833 end;
834end;
835
836
837{ TBarycentricGradientPolygonFillerEx }
838
839procedure TBarycentricGradientPolygonFillerEx.FillLineWebSafe(Dst: PColor32; DstX,
840 DstY, Length: Integer; AlphaValues: PColor32; CombineMode: TCombineMode);
841var
842 X: Integer;
843 Color32: TColor32;
844 Temp, DotY1, DotY2: TFloat;
845 Barycentric: array [0..1] of TFloat;
846 BlendMemEx: TBlendMemEx;
847begin
848 BlendMemEx := BLEND_MEM_EX[CombineMode]^;
849 Temp := DstY - FColorPoints[2].Point.Y;
850 DotY1 := FDists[0].X * Temp;
851 DotY2 := FDists[1].X * Temp;
852 for X := DstX to DstX + Length - 1 do
853 begin
854 Temp := (X - FColorPoints[2].Point.X);
855 Barycentric[0] := FDists[0].Y * Temp + DotY1;
856 Barycentric[1] := FDists[1].Y * Temp + DotY2;
857
858 Color32 := Linear3PointInterpolation(FColorPoints[0].Color32,
859 FColorPoints[1].Color32, FColorPoints[2].Color32,
860 Barycentric[0], Barycentric[1], 1 - Barycentric[1] - Barycentric[0]);
861 RoundToWebSafe(Color32);
862
863 BlendMemEx(Color32, Dst^, AlphaValues^);
864 EMMS;
865 Inc(Dst);
866 Inc(AlphaValues);
867 end;
868end;
869
870function TBarycentricGradientPolygonFillerEx.GetFillLine: TFillLineEvent;
871begin
872 if FWebSafe then
873 Result := FillLineWebSafe
874 else
875 Result := inherited GetFillLine;
876end;
877
878
879{ TCustomColorPicker }
880
881constructor TCustomColorPicker.Create(AOwner: TComponent);
882begin
883 inherited Create(AOwner);
884
885 ControlStyle := ControlStyle + [csOpaque];
886 FBuffer := TBitmap32.Create;
887 FPreserveComponent := [];
888 FSelectedColor := clSalmon32;
889 FVisualAidOptions := TVisualAidOptions.Create(Self);
890end;
891
892destructor TCustomColorPicker.Destroy;
893begin
894 FVisualAidOptions.Free;
895 FBuffer.Free;
896 inherited;
897end;
898
899procedure TCustomColorPicker.Invalidate;
900begin
901 FBufferValid := False;
902 inherited;
903end;
904
905procedure TCustomColorPicker.Paint;
906begin
907 if not Assigned(Parent) then
908 Exit;
909
910 if not FBufferValid then
911 begin
912 (FBuffer.Backend as IPaintSupport).ImageNeeded;
913 PaintColorPicker;
914 (FBuffer.Backend as IPaintSupport).CheckPixmap;
915 FBufferValid := True;
916 end;
917
918 FBuffer.Lock;
919 with Canvas do
920 try
921 (FBuffer.Backend as IDeviceContextSupport).DrawTo(Canvas.Handle, 0, 0);
922 finally
923 FBuffer.Unlock;
924 end;
925end;
926
927procedure TCustomColorPicker.Resize;
928begin
929 inherited;
930 FBuffer.SetSize(Width, Height);
931 FBufferValid := False;
932end;
933
934procedure TCustomColorPicker.SelectedColorChanged;
935begin
936 if Assigned(FOnChanged) then
937 FOnChanged(Self);
938
939 Invalidate;
940end;
941
942procedure TCustomColorPicker.SetBorder(const Value: Boolean);
943begin
944 if FBorder <> Value then
945 begin
946 FBorder := Value;
947 Invalidate;
948 end;
949end;
950
951procedure TCustomColorPicker.SetSelectedColor(const Value: TColor32);
952begin
953 if FSelectedColor <> Value then
954 begin
955 FSelectedColor := Value;
956 SelectedColorChanged;
957 end;
958end;
959
960procedure TCustomColorPicker.SetWebSafe(const Value: Boolean);
961begin
962 if FWebSafe <> Value then
963 begin
964 FWebSafe := Value;
965 Invalidate;
966 end;
967end;
968
969procedure TCustomColorPicker.WMEraseBkgnd(var Message: {$IFDEF FPC}TLmEraseBkgnd{$ELSE}TWmEraseBkgnd{$ENDIF});
970begin
971 Message.Result := 1;
972end;
973
974procedure TCustomColorPicker.WMGetDlgCode(var Msg: {$IFDEF FPC}TLMessage{$ELSE}TWmGetDlgCode{$ENDIF});
975begin
976 with Msg do
977 Result := Result or DLGC_WANTARROWS;
978end;
979
980
981{ TCustomColorPickerComponent }
982
983constructor TCustomColorPickerComponent.Create(AOwner: TComponent);
984begin
985 inherited;
986
987 FVisualAidOptions.Color := clBlack32;
988 FVisualAidOptions.LineWidth := 1.5;
989end;
990
991procedure TCustomColorPickerComponent.MouseDown(Button: TMouseButton;
992 Shift: TShiftState; X, Y: Integer);
993begin
994 FMouseDown := (Button = mbLeft);
995
996 inherited;
997end;
998
999procedure TCustomColorPickerComponent.MouseMove(Shift: TShiftState; X,
1000 Y: Integer);
1001var
1002 Value: Single;
1003 Color: TColor32Entry;
1004begin
1005 if FMouseDown then
1006 begin
1007 Value := EnsureRange((X - 3) / (Width - 3), 0, 1);
1008 Color := TColor32Entry(SelectedColor);
1009 case FColorComponent of
1010 ccRed:
1011 Color.R := Round(Value * 255);
1012 ccGreen:
1013 Color.G := Round(Value * 255);
1014 ccBlue:
1015 Color.B := Round(Value * 255);
1016 ccAlpha:
1017 Color.A := Round(Value * 255);
1018 end;
1019 SelectedColor := Color.ARGB;
1020 end;
1021
1022 inherited;
1023end;
1024
1025procedure TCustomColorPickerComponent.MouseUp(Button: TMouseButton;
1026 Shift: TShiftState; X, Y: Integer);
1027begin
1028 if (Button = mbLeft) then
1029 FMouseDown := False;
1030
1031 inherited;
1032end;
1033
1034procedure TCustomColorPickerComponent.PaintColorPicker;
1035var
1036 Polygon: TArrayOfFloatPoint;
1037 InvertFiller: TInvertPolygonFiller;
1038
1039 procedure RenderPolygon;
1040 begin
1041 case FVisualAidOptions.RenderType of
1042 vatInvert:
1043 PolygonFS(FBuffer, Polygon, InvertFiller);
1044 vatBW:
1045 if Intensity(FSelectedColor) < 127 then
1046 PolygonFS(FBuffer, Polygon, clWhite32)
1047 else
1048 PolygonFS(FBuffer, Polygon, clBlack32);
1049 else
1050 PolygonFS(FBuffer, Polygon, FVisualAidOptions.Color);
1051 end;
1052 end;
1053
1054var
1055 X, Y: Integer;
1056 ScanLine: PColor32Array;
1057 Value: Single;
1058 LeftColor, RightColor: TColor32Entry;
1059 OddY: Boolean;
1060 BorderOffset: Integer;
1061 GradientFiller: TLinearGradientPolygonFiller;
1062const
1063 CByteScale = 1 / 255;
1064 CCheckerBoardColor: array [Boolean] of TColor32 = ($FFA0A0A0, $FF5F5F5F);
1065begin
1066 FBuffer.Clear(Color32(Color));
1067
1068 BorderOffset := Integer(FBorder);
1069
1070 InvertFiller := TInvertPolygonFiller.Create;
1071 try
1072
1073 LeftColor := TColor32Entry(FSelectedColor);
1074 RightColor := TColor32Entry(FSelectedColor);
1075
1076 case FColorComponent of
1077 ccRed:
1078 begin
1079 Value := LeftColor.R * CByteScale;
1080 LeftColor.R := 0;
1081 RightColor.R := 255;
1082 LeftColor.A := 255;
1083 RightColor.A := 255;
1084 end;
1085 ccGreen:
1086 begin
1087 Value := LeftColor.G * CByteScale;
1088 LeftColor.G := 0;
1089 RightColor.G := 255;
1090 LeftColor.A := 255;
1091 RightColor.A := 255;
1092 end;
1093 ccBlue:
1094 begin
1095 Value := LeftColor.B * CByteScale;
1096 LeftColor.B := 0;
1097 RightColor.B := 255;
1098 LeftColor.A := 255;
1099 RightColor.A := 255;
1100 end;
1101 ccAlpha:
1102 begin
1103 Value := LeftColor.A * CByteScale;
1104 LeftColor.A := 0;
1105 RightColor.A := 255;
1106
1107 for Y := 0 to Height - 1 do
1108 begin
1109 OddY := Odd(Y div 8);
1110 ScanLine := FBuffer.ScanLine[Y];
1111 for X := 3 to Width - 4 do
1112 ScanLine^[X] := CCheckerBoardColor[Odd(X shr 3) = OddY];
1113 end;
1114 end
1115 else
1116 Exit;
1117 end;
1118
1119 GradientFiller := TLinearGradientPolygonFiller.Create;
1120 try
1121 GradientFiller.SimpleGradientX(3, LeftColor.ARGB,
1122 Width - 3, RightColor.ARGB);
1123 PolygonFS(FBuffer, Rectangle(FloatRect(3, 0, Width - 3, Height)), GradientFiller);
1124 finally
1125 GradientFiller.Free;
1126 end;
1127
1128 if FBorder then
1129 begin
1130 FBuffer.FrameRectTS(3, 0, Width - 3, Height, $DF000000);
1131 FBuffer.RaiseRectTS(4, 0, Width - 4, Height - 1, 20);
1132 end;
1133
1134 SetLength(Polygon, 3);
1135 Polygon[0] := FloatPoint(3 + Value * (Width - 6), Height - BorderOffset - 5);
1136 Polygon[1] := FloatPoint(Polygon[0].X - 3, Polygon[0].Y + 5);
1137 Polygon[2] := FloatPoint(Polygon[0].X + 3, Polygon[0].Y + 5);
1138 RenderPolygon;
1139
1140 Polygon[0].Y := BorderOffset + 5;
1141 Polygon[1].Y := BorderOffset;
1142 Polygon[2].Y := BorderOffset;
1143 RenderPolygon;
1144 finally
1145 InvertFiller.Free;
1146 end;
1147
1148 inherited;
1149end;
1150
1151procedure TCustomColorPickerComponent.SetColorComponent(
1152 const Value: TColorComponent);
1153begin
1154 if FColorComponent <> Value then
1155 begin
1156 FColorComponent := Value;
1157 Invalidate;
1158 end;
1159end;
1160
1161
1162{ TCustomColorPickerRGBA }
1163
1164constructor TCustomColorPickerRGBA.Create(AOwner: TComponent);
1165begin
1166 inherited;
1167
1168 FBarHeight := 24;
1169 FSpaceHeight := 8;
1170 FVisualAidOptions.Color := clBlack32;
1171 FVisualAidOptions.LineWidth := 1.5;
1172end;
1173
1174procedure TCustomColorPickerRGBA.PickRed(X, Y: Single);
1175var
1176 Value: Single;
1177 Color: TColor32Entry;
1178begin
1179 Value := EnsureRange((X - 3) / (Width - 3), 0, 1);
1180 Color := TColor32Entry(SelectedColor);
1181 Color.R := Round(Value * 255);
1182 SelectedColor := Color.ARGB;
1183end;
1184
1185procedure TCustomColorPickerRGBA.PickGreen(X, Y: Single);
1186var
1187 Value: Single;
1188 Color: TColor32Entry;
1189begin
1190 Value := EnsureRange((X - 3) / (Width - 3), 0, 1);
1191 Color := TColor32Entry(SelectedColor);
1192 Color.G := Round(Value * 255);
1193 SelectedColor := Color.ARGB;
1194end;
1195
1196procedure TCustomColorPickerRGBA.PickBlue(X, Y: Single);
1197var
1198 Value: Single;
1199 Color: TColor32Entry;
1200begin
1201 Value := EnsureRange((X - 3) / (Width - 3), 0, 1);
1202 Color := TColor32Entry(SelectedColor);
1203 Color.B := Round(Value * 255);
1204 SelectedColor := Color.ARGB;
1205end;
1206
1207procedure TCustomColorPickerRGBA.PickAlpha(X, Y: Single);
1208var
1209 Value: Single;
1210 Color: TColor32Entry;
1211begin
1212 Value := EnsureRange((X - 3) / (Width - 3), 0, 1);
1213 Color := TColor32Entry(SelectedColor);
1214 Color.A := Round(Value * 255);
1215 SelectedColor := Color.ARGB;
1216end;
1217
1218procedure TCustomColorPickerRGBA.MouseDown(Button: TMouseButton;
1219 Shift: TShiftState; X, Y: Integer);
1220var
1221 Index: Integer;
1222begin
1223 if (Button = mbLeft) and (X >= 3) or (X <= Width - 3) then
1224 begin
1225 Index := Y div (FBarHeight + FSpaceHeight);
1226 case Index of
1227 0:
1228 FAdjustCalc := PickRed;
1229 1:
1230 FAdjustCalc := PickGreen;
1231 2:
1232 FAdjustCalc := PickBlue;
1233 3:
1234 FAdjustCalc := PickAlpha;
1235 end;
1236 end;
1237
1238 if Assigned(FAdjustCalc) then
1239 FAdjustCalc(X, Y);
1240
1241 inherited;
1242end;
1243
1244procedure TCustomColorPickerRGBA.MouseMove(Shift: TShiftState; X, Y: Integer);
1245begin
1246 if (ssLeft in Shift) and Assigned(FAdjustCalc) then
1247 FAdjustCalc(X, Y);
1248 inherited;
1249end;
1250
1251procedure TCustomColorPickerRGBA.MouseUp(Button: TMouseButton;
1252 Shift: TShiftState; X, Y: Integer);
1253begin
1254 FAdjustCalc := nil;
1255
1256 inherited;
1257end;
1258
1259procedure TCustomColorPickerRGBA.PaintColorPicker;
1260var
1261 Polygon: TArrayOfFloatPoint;
1262 InvertFiller: TInvertPolygonFiller;
1263
1264 procedure RenderPolygon;
1265 begin
1266 case FVisualAidOptions.RenderType of
1267 vatInvert:
1268 PolygonFS(FBuffer, Polygon, InvertFiller);
1269 vatBW:
1270 if Intensity(FSelectedColor) < 127 then
1271 PolygonFS(FBuffer, Polygon, clWhite32)
1272 else
1273 PolygonFS(FBuffer, Polygon, clBlack32);
1274 else
1275 PolygonFS(FBuffer, Polygon, FVisualAidOptions.Color);
1276 end;
1277 end;
1278
1279var
1280 X, Y, Index: Integer;
1281 ScanLine: PColor32Array;
1282 Value: Single;
1283 LeftColor, RightColor: TColor32Entry;
1284 ValueRect: TRect;
1285 OddY: Boolean;
1286 BorderOffset: Integer;
1287 GradientFiller: TLinearGradientPolygonFiller;
1288const
1289 CByteScale = 1 / 255;
1290 CCheckerBoardColor: array [Boolean] of TColor32 = ($FFA0A0A0, $FF5F5F5F);
1291begin
1292 FBuffer.Clear(Color32(Color));
1293
1294 BorderOffset := Integer(FBorder);
1295
1296 SetLength(Polygon, 3);
1297 InvertFiller := TInvertPolygonFiller.Create;
1298 try
1299 for Index := 0 to 3 do
1300 begin
1301 ValueRect := Rect(3, Index * (FBarHeight + FSpaceHeight),
1302 Width - 3, Index * (FBarHeight + FSpaceHeight) + FBarHeight);
1303
1304 LeftColor := TColor32Entry(FSelectedColor);
1305 RightColor := TColor32Entry(FSelectedColor);
1306
1307 case Index of
1308 0:
1309 begin
1310 Value := LeftColor.R * CByteScale;
1311 LeftColor.R := 0;
1312 RightColor.R := 255;
1313 LeftColor.A := 255;
1314 RightColor.A := 255;
1315 end;
1316 1:
1317 begin
1318 Value := LeftColor.G * CByteScale;
1319 LeftColor.G := 0;
1320 RightColor.G := 255;
1321 LeftColor.A := 255;
1322 RightColor.A := 255;
1323 end;
1324 2:
1325 begin
1326 Value := LeftColor.B * CByteScale;
1327 LeftColor.B := 0;
1328 RightColor.B := 255;
1329 LeftColor.A := 255;
1330 RightColor.A := 255;
1331 end;
1332 3:
1333 begin
1334 Value := LeftColor.A * CByteScale;
1335 LeftColor.A := 0;
1336 RightColor.A := 255;
1337
1338 for Y := ValueRect.Top to Min(ValueRect.Bottom, Height) - 1 do
1339 begin
1340 OddY := Odd(Y div 8);
1341 ScanLine := FBuffer.ScanLine[Y];
1342 for X := ValueRect.Left to ValueRect.Right - 1 do
1343 ScanLine^[X] := CCheckerBoardColor[Odd(X shr 3) = OddY];
1344 end;
1345 end;
1346 else
1347 Exit;
1348 end;
1349
1350 GradientFiller := TLinearGradientPolygonFiller.Create;
1351 try
1352 GradientFiller.SimpleGradientX(ValueRect.Left, LeftColor.ARGB,
1353 ValueRect.Right, RightColor.ARGB);
1354 PolygonFS(FBuffer, Rectangle(FloatRect(ValueRect)), GradientFiller);
1355 finally
1356 GradientFiller.Free;
1357 end;
1358
1359 if FBorder then
1360 begin
1361 FBuffer.FrameRectTS(ValueRect, $DF000000);
1362 FBuffer.RaiseRectTS(ValueRect.Left + 1, ValueRect.Top + 1,
1363 ValueRect.Right - 1, ValueRect.Bottom - 1, 20);
1364 end;
1365
1366 Polygon[0] := FloatPoint(3 + Value * (Width - 6), ValueRect.Bottom - BorderOffset - 5);
1367 Polygon[1] := FloatPoint(Polygon[0].X - 3, Polygon[0].Y + 5);
1368 Polygon[2] := FloatPoint(Polygon[0].X + 3, Polygon[0].Y + 5);
1369 RenderPolygon;
1370
1371 Polygon[0].Y := ValueRect.Top + BorderOffset + 5;
1372 Polygon[1].Y := ValueRect.Top + BorderOffset;
1373 Polygon[2].Y := ValueRect.Top + BorderOffset;
1374 RenderPolygon;
1375 end;
1376 finally
1377 InvertFiller.Free;
1378 end;
1379
1380 inherited;
1381end;
1382
1383procedure TCustomColorPickerRGBA.SetBarHeight(const Value: Integer);
1384begin
1385 if FBarHeight <> Value then
1386 begin
1387 FBarHeight := Value;
1388 Invalidate;
1389 end;
1390end;
1391
1392procedure TCustomColorPickerRGBA.SetSpaceHeight(const Value: Integer);
1393begin
1394 if FSpaceHeight <> Value then
1395 begin
1396 FSpaceHeight := Value;
1397 Invalidate;
1398 end;
1399end;
1400
1401
1402{ TCustomColorPickerHS }
1403
1404constructor TCustomColorPickerHS.Create(AOwner: TComponent);
1405var
1406 Luminance: Single;
1407begin
1408 inherited;
1409 FVisualAidOptions.Color := clBlack32;
1410 FVisualAidOptions.LineWidth := 1.5;
1411 RGBtoHSL(FSelectedColor, FHue, FSaturation, Luminance);
1412end;
1413
1414procedure TCustomColorPickerHS.MouseDown(Button: TMouseButton;
1415 Shift: TShiftState; X, Y: Integer);
1416begin
1417 if Button = mbLeft then
1418 PickHue(X, Y);
1419
1420 inherited;
1421end;
1422
1423procedure TCustomColorPickerHS.MouseMove(Shift: TShiftState; X, Y: Integer);
1424begin
1425 if (ssLeft in Shift) then
1426 PickHue(X, Y);
1427
1428 inherited;
1429end;
1430
1431procedure TCustomColorPickerHS.PaintColorPicker;
1432var
1433 X, Y: Integer;
1434 Saturation, InvWidth, InvHeight: Single;
1435 Line: PColor32Array;
1436 Pos: TFloatPoint;
1437 VectorData: TArrayOfArrayOfFloatPoint;
1438 InvertFiller: TInvertPolygonFiller;
1439begin
1440 InvWidth := 1 / FBuffer.Width;
1441 InvHeight := 1 / FBuffer.Height;
1442
1443 if FWebSafe then
1444 for Y := 0 to FBuffer.Height - 1 do
1445 begin
1446 Line := FBuffer.ScanLine[Y];
1447 Saturation := 1 - Y * InvHeight;
1448 for X := 0 to FBuffer.Width - 1 do
1449 begin
1450 Line^[X] := HSLtoRGB(X * InvWidth, Saturation, 0.5);
1451 RoundToWebSafe(Line^[X]);
1452 end;
1453 end
1454 else
1455 for Y := 0 to FBuffer.Height - 1 do
1456 begin
1457 Line := FBuffer.ScanLine[Y];
1458 Saturation := 1 - Y * InvHeight;
1459 for X := 0 to FBuffer.Width - 1 do
1460 Line^[X] := HSLtoRGB(X * InvWidth, Saturation, 0.5);
1461 end;
1462
1463 Pos.X := Round(FHue * FBuffer.Width);
1464 Pos.Y := Round((1 - FSaturation) * FBuffer.Height);
1465 case FMarkerType of
1466 mtCross:
1467 begin
1468 SetLength(VectorData, 4);
1469 VectorData[0] := HorzLine(Pos.X - 5, Pos.Y, Pos.X - 2);
1470 VectorData[1] := HorzLine(Pos.X + 2, Pos.Y, Pos.X + 5);
1471 VectorData[2] := VertLine(Pos.X, Pos.Y - 5, Pos.Y - 2);
1472 VectorData[3] := VertLine(Pos.X, Pos.Y + 2, Pos.Y + 5);
1473 case FVisualAidOptions.RenderType of
1474 vatSolid:
1475 PolyPolylineFS(FBuffer, VectorData, FVisualAidOptions.Color, False, FVisualAidOptions.LineWidth);
1476 vatInvert:
1477 begin
1478 InvertFiller := TInvertPolygonFiller.Create;
1479 try
1480 PolyPolylineFS(FBuffer, VectorData, InvertFiller, False, FVisualAidOptions.LineWidth)
1481 finally
1482 InvertFiller.Free;
1483 end;
1484 end;
1485 vatBW:
1486 PolyPolylineFS(FBuffer, VectorData, FVisualAidOptions.Color, False, FVisualAidOptions.LineWidth);
1487 end;
1488 end;
1489 mtCircle:
1490 begin
1491 SetLength(VectorData, 1);
1492 VectorData[0] := Circle(Pos, 4, 12);
1493 PolygonFS(FBuffer, VectorData[0], FSelectedColor);
1494
1495 case FVisualAidOptions.RenderType of
1496 vatSolid:
1497 PolylineFS(FBuffer, VectorData[0], FVisualAidOptions.Color, True, FVisualAidOptions.LineWidth);
1498 vatInvert:
1499 begin
1500 InvertFiller := TInvertPolygonFiller.Create;
1501 try
1502 PolylineFS(FBuffer, VectorData[0], InvertFiller, True, 1.5)
1503 finally
1504 InvertFiller.Free;
1505 end;
1506 end;
1507 vatBW:
1508 PolylineFS(FBuffer, VectorData[0], FVisualAidOptions.Color, True, 1.5);
1509 end;
1510 end;
1511 end;
1512end;
1513
1514procedure TCustomColorPickerHS.PickHue(X, Y: Single);
1515begin
1516 FHue := EnsureRange(X / FBuffer.Width, 0, 1);
1517 FSaturation := EnsureRange(1 - Y / FBuffer.Height, 0, 1);
1518 SelectedColor := SetAlpha(HSLtoRGB(FHue, FSaturation, 0.5), SelectedColor shr 24);
1519end;
1520
1521procedure TCustomColorPickerHS.SelectedColorChanged;
1522var
1523 H, S, L: Single;
1524begin
1525 RGBtoHSL(FSelectedColor, H, S, L);
1526 if not (pcHue in FPreserveComponent) then
1527 FHue := H;
1528 if not (pcSaturation in FPreserveComponent) then
1529 FSaturation := S;
1530
1531 FPreserveComponent := [];
1532
1533 inherited;
1534end;
1535
1536procedure TCustomColorPickerHS.SetHue(const Value: Single);
1537begin
1538 if FHue <> Value then
1539 begin
1540 FHue := Value;
1541 FPreserveComponent := FPreserveComponent + [pcHue];
1542 SelectedColor := SetAlpha(HSLtoRGB(FHue, FSaturation, 1), SelectedColor shr 24);
1543 end;
1544end;
1545
1546procedure TCustomColorPickerHS.SetSaturation(const Value: Single);
1547begin
1548 if FSaturation <> Value then
1549 begin
1550 FSaturation := Value;
1551 FPreserveComponent := FPreserveComponent + [pcSaturation];
1552 SelectedColor := SetAlpha(HSLtoRGB(FHue, FSaturation, 1), SelectedColor shr 24);
1553 end;
1554end;
1555
1556procedure TCustomColorPickerHS.SetMarkerType(const Value: TMarkerType);
1557begin
1558 if FMarkerType <> Value then
1559 begin
1560 FMarkerType := Value;
1561 Invalidate;
1562 end;
1563end;
1564
1565
1566{ TCustomColorPickerHSV }
1567
1568constructor TCustomColorPickerHSV.Create(AOwner: TComponent);
1569begin
1570 inherited Create(AOwner);
1571
1572 FVisualAid := [vaHueLine, vaSaturationCircle, vaSelection];
1573 FVisualAidOptions.LineWidth := 1.5;
1574 RGBToHSV(FSelectedColor, FHue, FSaturation, FValue);
1575
1576 { Setting a initial size here will cause the control to crash under LCL }
1577{$IFNDEF FPC}
1578 Height := 192;
1579 Width := 256;
1580{$ENDIF}
1581end;
1582
1583procedure TCustomColorPickerHSV.PaintColorPicker;
1584var
1585 Polygon: TArrayOfFloatPoint;
1586 ValueRect: TRect;
1587 GradientFiller: TLinearGradientPolygonFiller;
1588 HueSaturationFiller: THueSaturationCirclePolygonFiller;
1589 InvertFiller: TInvertPolygonFiller;
1590 LineWidth: Single;
1591begin
1592 FBuffer.Clear(Color32(Color));
1593
1594 Polygon := Circle(FCenter, FRadius, FCircleSteps);
1595 HueSaturationFiller := THueSaturationCirclePolygonFiller.Create(FCenter,
1596 FRadius, FValue, FWebSafe);
1597 try
1598 PolygonFS(FBuffer, Polygon, HueSaturationFiller);
1599 finally
1600 HueSaturationFiller.Free;
1601 end;
1602
1603 if FBorder then
1604 PolylineFS(FBuffer, Polygon, clBlack32, True, 1);
1605
1606 LineWidth := FVisualAidOptions.LineWidth;
1607
1608 InvertFiller := TInvertPolygonFiller.Create;
1609 try
1610 if vaSaturationCircle in FVisualAid then
1611 begin
1612 Polygon := Circle(FCenter, FSaturation * FRadius, -1);
1613 case FVisualAidOptions.RenderType of
1614 vatInvert:
1615 PolylineFS(FBuffer, Polygon, InvertFiller, True, LineWidth);
1616 vatBW:
1617 if Intensity(FSelectedColor) < 127 then
1618 PolylineFS(FBuffer, Polygon, clWhite32, True, LineWidth)
1619 else
1620 PolylineFS(FBuffer, Polygon, clBlack32, True, LineWidth);
1621 else
1622 PolylineFS(FBuffer, Polygon, FVisualAidOptions.Color, True, LineWidth);
1623 end;
1624 end;
1625
1626 if vaHueLine in FVisualAid then
1627 begin
1628 SetLength(Polygon, 2);
1629 Polygon[0] := FCenter;
1630 Polygon[1] := FloatPoint(
1631 FCenter.X - FRadius * Cos(2 * Pi * FHue),
1632 FCenter.Y - FRadius * Sin(2 * Pi * FHue));
1633
1634 case FVisualAidOptions.RenderType of
1635 vatInvert:
1636 PolylineFS(FBuffer, Polygon, InvertFiller, False, LineWidth);
1637 vatBW:
1638 if Intensity(FSelectedColor) < 127 then
1639 PolylineFS(FBuffer, Polygon, clWhite32, False, LineWidth)
1640 else
1641 PolylineFS(FBuffer, Polygon, clBlack32, False, LineWidth);
1642 else
1643 PolylineFS(FBuffer, Polygon, FVisualAidOptions.Color, False, LineWidth);
1644 end;
1645 end;
1646
1647 if vaSelection in FVisualAid then
1648 begin
1649 Polygon := Circle(
1650 FCenter.X - FSaturation * FRadius * Cos(2 * Pi * FHue),
1651 FCenter.Y - FSaturation * FRadius * Sin(2 * Pi * FHue), 4, 8);
1652 PolygonFS(FBuffer, Polygon, FSelectedColor);
1653
1654 case FVisualAidOptions.RenderType of
1655 vatInvert:
1656 PolylineFS(FBuffer, Polygon, InvertFiller, True, LineWidth);
1657 vatBW:
1658 if Intensity(FSelectedColor) < 127 then
1659 PolylineFS(FBuffer, Polygon, clWhite32, True, LineWidth)
1660 else
1661 PolylineFS(FBuffer, Polygon, clBlack32, True, LineWidth);
1662 else
1663 PolylineFS(FBuffer, Polygon, FVisualAidOptions.Color, True, LineWidth);
1664 end;
1665 end;
1666
1667 ValueRect := Rect(Width - 24, 8, Width - 8, Height - 8);
1668 Polygon := Rectangle(FloatRect(ValueRect));
1669
1670 GradientFiller := TLinearGradientPolygonFiller.Create;
1671 try
1672 GradientFiller.SimpleGradientY(ValueRect.Top, clWhite32,
1673 ValueRect.Bottom, clBlack32);
1674 PolygonFS(FBuffer, Polygon, GradientFiller);
1675 finally
1676 GradientFiller.Free;
1677 end;
1678
1679 SetLength(Polygon, 3);
1680 Polygon[0] := FloatPoint(Width - 8, 8 + (1 - FValue) * (Height - 16));
1681 Polygon[1] := FloatPoint(Polygon[0].X + 7, Polygon[0].Y - 4);
1682 Polygon[2] := FloatPoint(Polygon[0].X + 7, Polygon[0].Y + 4);
1683 case FVisualAidOptions.RenderType of
1684 vatInvert:
1685 PolygonFS(FBuffer, Polygon, InvertFiller);
1686 vatBW:
1687 if Intensity(FSelectedColor) < 127 then
1688 PolygonFS(FBuffer, Polygon, clWhite32)
1689 else
1690 PolygonFS(FBuffer, Polygon, clBlack32);
1691 else
1692 PolygonFS(FBuffer, Polygon, FVisualAidOptions.Color);
1693 end;
1694
1695 if FBorder then
1696 begin
1697 FBuffer.FrameRectTS(ValueRect, $DF000000);
1698 FBuffer.RaiseRectTS(ValueRect.Left + 1, ValueRect.Top + 1,
1699 ValueRect.Right - 1, ValueRect.Bottom - 1, 20);
1700 end;
1701 finally
1702 InvertFiller.Free;
1703 end;
1704
1705 inherited;
1706end;
1707
1708procedure TCustomColorPickerHSV.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
1709 Y: Integer);
1710begin
1711 if Button = mbLeft then
1712 begin
1713 if X > Width - 28 then
1714 FAdjustCalc := PickValue
1715 else
1716 FAdjustCalc := PickHue;
1717 end;
1718
1719 if Assigned(FAdjustCalc) then
1720 FAdjustCalc(X, Y);
1721
1722 inherited;
1723end;
1724
1725procedure TCustomColorPickerHSV.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
1726 Y: Integer);
1727begin
1728 FAdjustCalc := nil;
1729 inherited;
1730end;
1731
1732procedure TCustomColorPickerHSV.MouseMove(Shift: TShiftState; X, Y: Integer);
1733begin
1734 if (ssLeft in Shift) and Assigned(FAdjustCalc) then
1735 FAdjustCalc(X, Y);
1736 inherited;
1737end;
1738
1739procedure TCustomColorPickerHSV.Resize;
1740begin
1741 inherited;
1742
1743 if Height < Width then
1744 begin
1745 FRadius := Min(0.5 * Width - 1 - 16, 0.5 * Height - 1);
1746 FCircleSteps := CalculateCircleSteps(FRadius);
1747 FCenter := FloatPoint(0.5 * Width - 16, 0.5 * Height);
1748 end
1749 else
1750 begin
1751 FRadius := Min(0.5 * Width - 1, 0.5 * Height - 1 - 16);
1752 FCircleSteps := CalculateCircleSteps(FRadius);
1753 FCenter := FloatPoint(0.5 * Width, 0.5 * Height - 16);
1754 end;
1755end;
1756
1757procedure TCustomColorPickerHSV.PickHue(X, Y: Single);
1758const
1759 CTwoPiInv = 1 / (2 * Pi);
1760begin
1761 FHue := 0.5 + ArcTan2(Y - FCenter.Y, X - FCenter.X) * CTwoPiInv;
1762 FSaturation := Sqrt(Sqr(Y - FCenter.Y) + Sqr(X - FCenter.X)) / FRadius;
1763 if FSaturation > 1 then
1764 FSaturation := 1;
1765
1766 FPreserveComponent := FPreserveComponent + [pcSaturation, pcHue];
1767 SelectedColor := SetAlpha(HSVtoRGB(FHue, FSaturation, FValue), SelectedColor shr 24);
1768end;
1769
1770procedure TCustomColorPickerHSV.PickValue(X, Y: Single);
1771begin
1772 Value := 1 - EnsureRange((Y - 8) / (Height - 16), 0, 1);
1773end;
1774
1775procedure TCustomColorPickerHSV.SetHue(const Value: Single);
1776begin
1777 if FHue <> Value then
1778 begin
1779 FHue := Value;
1780 FPreserveComponent := FPreserveComponent + [pcHue];
1781 SelectedColor := SetAlpha(HSVtoRGB(FHue, FSaturation, FValue), SelectedColor shr 24);
1782 end;
1783end;
1784
1785procedure TCustomColorPickerHSV.SetSaturation(const Value: Single);
1786begin
1787 if FSaturation <> Value then
1788 begin
1789 FSaturation := Value;
1790 FPreserveComponent := FPreserveComponent + [pcSaturation];
1791 SelectedColor := SetAlpha(HSVtoRGB(FHue, FSaturation, FValue), SelectedColor shr 24);
1792 end;
1793end;
1794
1795procedure TCustomColorPickerHSV.SelectedColorChanged;
1796var
1797 H, S, V: Single;
1798begin
1799 RGBtoHSV(FSelectedColor, H, S, V);
1800 if not (pcHue in FPreserveComponent) then
1801 FHue := H;
1802 if not (pcSaturation in FPreserveComponent) then
1803 FSaturation := S;
1804 if not (pcValue in FPreserveComponent) then
1805 FValue := V;
1806
1807 FPreserveComponent := [];
1808
1809 inherited;
1810end;
1811
1812procedure TCustomColorPickerHSV.SetValue(const Value: Single);
1813begin
1814 if FValue <> Value then
1815 begin
1816 FValue := Value;
1817 FPreserveComponent := FPreserveComponent + [pcValue];
1818 SelectedColor := SetAlpha(HSVtoRGB(FHue, FSaturation, FValue), SelectedColor shr 24);
1819 end;
1820end;
1821
1822procedure TCustomColorPickerHSV.SetVisualAid(const Value: TVisualAid);
1823begin
1824 if FVisualAid <> Value then
1825 begin
1826 FVisualAid := Value;
1827 Invalidate;
1828 end;
1829end;
1830
1831
1832{ TCustomColorPickerGTK }
1833
1834constructor TCustomColorPickerGTK.Create(AOwner: TComponent);
1835begin
1836 inherited Create(AOwner);
1837
1838 FVisualAid := [vagHueLine, vagSelection];
1839 FVisualAidOptions.RenderType := vatBW;
1840 FVisualAidOptions.LineWidth := 2;
1841 RGBToHSV(FSelectedColor, FHue, FSaturation, FValue);
1842
1843 { Setting a initial size here will cause the control to crash under LCL }
1844{$IFNDEF FPC}
1845 Height := 192;
1846 Width := 192;
1847{$ENDIF}
1848end;
1849
1850procedure TCustomColorPickerGTK.PaintColorPicker;
1851var
1852 Polygon: TArrayOfFloatPoint;
1853 HueBand: TArrayOfArrayOfFloatPoint;
1854 GradientFiller: TBarycentricGradientPolygonFillerEx;
1855 HueFiller: THueCirclePolygonFiller;
1856 InvertFiller: TInvertPolygonFiller;
1857 Pos: TFloatPoint;
1858 HalfInnerRadius: Single;
1859 LineWidth: Single;
1860const
1861 CY = 1.7320508075688772935274463415059;
1862begin
1863 FBuffer.Clear(Color32(Color));
1864
1865 Polygon := Circle(FCenter, 0.5 * (FRadius + FInnerRadius), FCircleSteps);
1866 HueBand := BuildPolyPolyline(PolyPolygon(Polygon), True, FRadius - FInnerRadius);
1867 HueFiller := THueCirclePolygonFiller.Create(FCenter, FWebSafe);
1868 try
1869 PolyPolygonFS(FBuffer, HueBand, HueFiller);
1870 finally
1871 HueFiller.Free;
1872 end;
1873
1874 LineWidth := FVisualAidOptions.LineWidth;
1875
1876 if vagHueLine in FVisualAid then
1877 begin
1878 SetLength(Polygon, 2);
1879 Polygon[0] := FloatPoint(
1880 FCenter.X - FInnerRadius * Cos(2 * Pi * FHue),
1881 FCenter.Y - FInnerRadius * Sin(2 * Pi * FHue));
1882 Polygon[1] := FloatPoint(
1883 FCenter.X - FRadius * Cos(2 * Pi * FHue),
1884 FCenter.Y - FRadius * Sin(2 * Pi * FHue));
1885
1886 case FVisualAidOptions.RenderType of
1887 vatSolid:
1888 PolylineFS(FBuffer, Polygon, FVisualAidOptions.Color, False, LineWidth);
1889 vatInvert:
1890 begin
1891 InvertFiller := TInvertPolygonFiller.Create;
1892 try
1893 PolylineFS(FBuffer, Polygon, InvertFiller, False, LineWidth);
1894 finally
1895 InvertFiller.Free;
1896 end;
1897 end;
1898 vatBW:
1899 if Intensity(HSVtoRGB(FHue, 1, 1)) < 127 then
1900 PolylineFS(FBuffer, Polygon, $F0FFFFFF, True, LineWidth)
1901 else
1902 PolylineFS(FBuffer, Polygon, $F0000000, True, LineWidth)
1903 end;
1904 end;
1905
1906 GR32_Math.SinCos(2 * Pi * FHue, Pos.Y, Pos.X);
1907 SetLength(Polygon, 3);
1908 Polygon[0] := FloatPoint(
1909 FCenter.X - FInnerRadius * Pos.X,
1910 FCenter.Y - FInnerRadius * Pos.Y);
1911 HalfInnerRadius := 0.5 * FInnerRadius;
1912 Pos := FloatPoint(Pos.X + CY * Pos.Y, Pos.X * CY - Pos.Y);
1913 Polygon[1] := FloatPoint(
1914 FCenter.X + HalfInnerRadius * Pos.X,
1915 FCenter.Y - HalfInnerRadius * Pos.Y);
1916 HalfInnerRadius := 0.5 * HalfInnerRadius;
1917 Pos := FloatPoint(Pos.X - CY * Pos.Y, Pos.Y + Pos.X * CY);
1918 Polygon[2] := FloatPoint(
1919 FCenter.X - HalfInnerRadius * Pos.X,
1920 FCenter.Y + HalfInnerRadius * Pos.Y);
1921
1922 GradientFiller := TBarycentricGradientPolygonFillerEx.Create;
1923 try
1924 GradientFiller.SetPoints(Polygon);
1925 GradientFiller.Color[0] := HSVtoRGB(Hue, 1, 1);
1926 GradientFiller.Color[1] := clWhite32;
1927 GradientFiller.Color[2] := clBlack32;
1928 GradientFiller.WebSafe := FWebSafe;
1929 PolygonFS(FBuffer, Polygon, GradientFiller);
1930 finally
1931 GradientFiller.Free;
1932 end;
1933
1934 if FBorder then
1935 begin
1936 PolyPolygonFS(FBuffer, BuildPolyPolyline(HueBand, True, 1), clBlack32);
1937 PolylineFS(FBuffer, Polygon, clBlack32, True, 1);
1938 end;
1939
1940 if vagSelection in FVisualAid then
1941 begin
1942 Polygon := Circle(
1943 Polygon[2].X + FValue * (Polygon[1].X + FSaturation * (Polygon[0].X - Polygon[1].X) - Polygon[2].X),
1944 Polygon[2].Y + FValue * (Polygon[1].Y + FSaturation * (Polygon[0].Y - Polygon[1].Y) - Polygon[2].Y),
1945 4, 12);
1946
1947 PolygonFS(FBuffer, Polygon, FSelectedColor);
1948
1949 case FVisualAidOptions.RenderType of
1950 vatSolid:
1951 PolylineFS(FBuffer, Polygon, FVisualAidOptions.Color, True, LineWidth);
1952 vatInvert:
1953 begin
1954 InvertFiller := TInvertPolygonFiller.Create;
1955 try
1956 PolylineFS(FBuffer, Polygon, InvertFiller, True, LineWidth);
1957 finally
1958 InvertFiller.Free;
1959 end;
1960 end;
1961 vatBW:
1962 if Intensity(FSelectedColor) < 127 then
1963 PolylineFS(FBuffer, Polygon, clWhite32, True, LineWidth)
1964 else
1965 PolylineFS(FBuffer, Polygon, clBlack32, True, LineWidth)
1966 end
1967 end;
1968
1969 inherited;
1970end;
1971
1972procedure TCustomColorPickerGTK.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
1973 Y: Integer);
1974begin
1975 if Button = mbLeft then
1976 begin
1977 if Sqrt(Sqr(X - FCenter.X) + Sqr(Y - FCenter.Y)) > FInnerRadius then
1978 FAdjustCalc := PickHue
1979 else
1980 FAdjustCalc := PickSaturationValue;
1981 end;
1982
1983 if Assigned(FAdjustCalc) then
1984 FAdjustCalc(X, Y);
1985
1986 inherited;
1987end;
1988
1989procedure TCustomColorPickerGTK.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
1990 Y: Integer);
1991begin
1992 FAdjustCalc := nil;
1993 inherited;
1994end;
1995
1996procedure TCustomColorPickerGTK.MouseMove(Shift: TShiftState; X, Y: Integer);
1997begin
1998 if (ssLeft in Shift) and Assigned(FAdjustCalc) then
1999 FAdjustCalc(X, Y);
2000 inherited;
2001end;
2002
2003procedure TCustomColorPickerGTK.Resize;
2004begin
2005 inherited;
2006
2007 Radius := Min(0.5 * Width - 1, 0.5 * Height - 1);
2008 Center := FloatPoint(0.5 * Width, 0.5 * Height);
2009end;
2010
2011procedure TCustomColorPickerGTK.PickHue(X, Y: Single);
2012const
2013 CTwoPiInv = 1 / (2 * Pi);
2014begin
2015 Hue := 0.5 + ArcTan2(Y - FCenter.Y, X - FCenter.X) * CTwoPiInv;
2016 FPreserveComponent := FPreserveComponent + [pcHue];
2017end;
2018
2019procedure TCustomColorPickerGTK.PickSaturationValue(X, Y: Single);
2020var
2021 Pos: TFloatPoint;
2022const
2023 CY = 1.7320508075688772935274463415059;
2024begin
2025 with TBarycentricGradientSampler.Create do
2026 try
2027 GR32_Math.SinCos(2 * Pi * FHue, Pos.Y, Pos.X);
2028 Point[0] := FloatPoint(
2029 FCenter.X - FInnerRadius * Pos.X,
2030 FCenter.Y - FInnerRadius * Pos.Y);
2031 Pos := FloatPoint(-0.5 * (Pos.X + CY * Pos.Y), 0.5 * (Pos.X * CY - Pos.Y));
2032 Point[1] := FloatPoint(
2033 FCenter.X - FInnerRadius * Pos.X,
2034 FCenter.Y - FInnerRadius * Pos.Y);
2035 Pos := FloatPoint(-0.5 * (Pos.X + CY * Pos.Y), 0.5 * (Pos.X * CY - Pos.Y));
2036 Point[2] := FloatPoint(
2037 FCenter.X - FInnerRadius * Pos.X,
2038 FCenter.Y - FInnerRadius * Pos.Y);
2039 Color[0] := HSVtoRGB(Hue, 1, 1);
2040 Color[1] := clWhite32;
2041 Color[2] := clBlack32;
2042
2043 PrepareSampling;
2044 FPreserveComponent := FPreserveComponent + [pcHue];
2045 SelectedColor := SetAlpha(GetSampleFloatInTriangle(X, Y), SelectedColor shr 24);
2046 finally
2047 Free;
2048 end;
2049end;
2050
2051procedure TCustomColorPickerGTK.SetHue(const Value: Single);
2052begin
2053 if FHue <> Value then
2054 begin
2055 FHue := Value;
2056 FPreserveComponent := FPreserveComponent + [pcHue];
2057 SelectedColor := SetAlpha(HSVtoRGB(FHue, FSaturation, FValue), SelectedColor shr 24);
2058 end;
2059end;
2060
2061procedure TCustomColorPickerGTK.SetRadius(const Value: TFloat);
2062begin
2063 if FRadius <> Value then
2064 begin
2065 FRadius := Value;
2066 FInnerRadius := 0.8 * FRadius;
2067 FCircleSteps := CalculateCircleSteps(FRadius);
2068 end;
2069end;
2070
2071procedure TCustomColorPickerGTK.SetSaturation(const Value: Single);
2072begin
2073 if FSaturation <> Value then
2074 begin
2075 FSaturation := Value;
2076 FPreserveComponent := FPreserveComponent + [pcSaturation];
2077 SelectedColor := SetAlpha(HSVtoRGB(FHue, FSaturation, FValue), SelectedColor shr 24);
2078 end;
2079end;
2080
2081procedure TCustomColorPickerGTK.SelectedColorChanged;
2082var
2083 H, S, V: Single;
2084begin
2085 RGBtoHSV(FSelectedColor, H, S, V);
2086 if not (pcHue in FPreserveComponent) then
2087 FHue := H;
2088 if not (pcSaturation in FPreserveComponent) then
2089 FSaturation := S;
2090 if not (pcValue in FPreserveComponent) then
2091 FValue := V;
2092
2093 FPreserveComponent := [];
2094
2095 inherited;
2096end;
2097
2098procedure TCustomColorPickerGTK.SetValue(const Value: Single);
2099begin
2100 if FValue <> Value then
2101 begin
2102 FValue := Value;
2103 FPreserveComponent := FPreserveComponent + [pcValue];
2104 SelectedColor := SetAlpha(HSVtoRGB(FHue, FSaturation, FValue), SelectedColor shr 24);
2105 end;
2106end;
2107
2108procedure TCustomColorPickerGTK.SetVisualAid(const Value: TVisualAidGTK);
2109begin
2110 if FVisualAid <> Value then
2111 begin
2112 FVisualAid := Value;
2113 Invalidate;
2114 end;
2115end;
2116
2117end.
Note: See TracBrowser for help on using the repository browser.