pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mbColorLib: Add property BrightnessMode (Luminance or Value) to most pickers to get consistent usage of luminance of value parameters. Add new LVColorPicker (switchable between Luminance and Value). Office dialog working again (still buggy).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5596 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-01-05 18:49:22 +00:00
parent 212a9470c7
commit b24e7d5d2c
46 changed files with 2759 additions and 1868 deletions
Download Patch File Download Diff File Expand all files Collapse all files

200
components/mbColorLib/HSLRingPicker.pas
View File

@@ -9,7 +9,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics,
Forms, Menus, Math, Themes,
RGBHSLUtils, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker;
mbColorConv, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker;
type
THSLRingPicker = class(TmbBasicPicker)
@@ -17,41 +17,50 @@ type
FRingPicker: THRingPicker;
FSLPicker: TSLColorPicker;
FSelectedColor: TColor;
FRValue, FGValue, FBValue: integer;
// FRValue, FGValue, FBValue: integer;
FRingHint, FSLHint: string;
FSLMenu, FRingMenu: TPopupMenu;
FSLCursor, FRingCursor: TCursor;
PBack: TBitmap;
function GetBrightnessMode: TBrightnessMode;
function GetHue: Integer;
function GetLum: Integer;
function GetSat: Integer;
function GetVal: Integer;
function GetMaxHue: Integer;
function GetMaxLum: Integer;
function GetMaxSat: Integer;
function GetRed: Integer;
function GetGreen: Integer;
function GetBlue: Integer;
function GetLVHint(AMode: TBrightnessMode): String;
procedure SetBrightnessMode(AMode: TBrightnessMode);
procedure SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLum(L: integer);
procedure SetVal(V: Integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure SetR(v: integer);
procedure SetG(v: integer);
procedure SetB(v: integer);
procedure SetRed(R: integer);
procedure SetGreen(G: integer);
procedure SetBlue(B: integer);
procedure SetRingHint(h: string);
procedure SetSLHint(h: string);
procedure SetSLMenu(m: TPopupMenu);
procedure SetRingMenu(m: TPopupMenu);
procedure SetRingCursor(c: TCursor);
procedure SetSLCursor(c: TCursor);
procedure SetLVHint(AMode: TBrightnessMode; AText: String);
protected
procedure CreateWnd; override;
// procedure CreateWnd; override;
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
function GetSelectedColor: TColor; override;
procedure Paint; override;
procedure Resize; override;
procedure RingPickerChange(Sender: TObject);
procedure SelectColor(c: TColor);
procedure SetSelectedColor(c: TColor); override;
procedure SLPickerChange(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
@@ -60,21 +69,25 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
property Red: integer read FRValue write SetR;
property Green: integer read FGValue write SetG;
property Blue: integer read FBValue write SetB;
property Red: integer read GetRed write SetRed;
property Green: integer read GetGreen write SetGreen;
property Blue: integer read GetBlue write SetBlue;
published
property BrightnessMode: TBrightnessMode read GetBrightnessMode
write SetBrightnessMode default bmValue;
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 240;
property Luminance: integer read GetLum write SetLum default 120;
property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
property Saturation: integer read GetSat write SetSat default 255;
property Luminance: integer read GetLum write SetLum default 127;
property Value: Integer read GetVal write SetVal default 255;
property SelectedColor default clRed;
property RingPickerPopupMenu: TPopupMenu read FRingMenu write SetRingMenu;
property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
property RingPickerHintFormat: string read FRingHint write SetRingHint;
property SLPickerHintFormat: string read FSLHint write SetSLHint;
property SLPickerHintFormat: string index bmLuminance read GetLVHint write SetLVHint;
property SVPickerHintFormat: String index bmValue read GetLVHint write SetLVHint;
property RingPickerCursor: TCursor read FRingCursor write SetRingCursor default crDefault;
property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 359;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240;
property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240;
property TabStop default true;
@@ -100,30 +113,20 @@ begin
inherited;
// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
FRValue := 255;
FGValue := 0;
FBValue := 0;
PBack := TBitmap.Create;
// PBack.PixelFormat := pf32bit;
SetInitialBounds(0, 0, 245, 245);
TabStop := true;
FSelectedColor := clRed;
FRingCursor := crDefault;
FSLCursor := crDefault;
FRingHint := 'Hue: %h';
FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
FRingPicker := THRingPicker.Create(Self);
InsertControl(FRingPicker);
with FRingPicker do
begin
SetInitialBounds(0, 0, 246, 246);
//Radius := 40;
BrightnessMode := bmValue;
Align := alClient;
Visible := true;
Saturation := FRingPicker.MaxSaturation;
Value := FRingPicker.MaxValue;
Hue := 0;
OnChange := RingPickerChange;
OnMouseMove := DoMouseMove;
end;
@@ -133,14 +136,14 @@ begin
with FSLPicker do
begin
SetInitialBounds(63, 63, 120, 120);
MaxSaturation := 240;
MaxLuminance := 240;
Saturation := 240;
Luminance := 240;
Visible := true;
BrightnessMode := bmValue;
SLHintFormat := 'S: %hslS L: %l'#13'Hex: %hex';
SVHintFormat := 'S: %hslS V: %v'#13'Hex: %hex';
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
SetSelectedColor(clRed);
end;
destructor THSLRingPicker.Destroy;
@@ -148,22 +151,16 @@ begin
PBack.Free;
inherited Destroy;
end;
(*
procedure THSLRingPicker.CreateWnd;
begin
inherited;
PaintParentBack(PBack);
end;
//PaintParentBack(PBack);
end; *)
procedure THSLRingPicker.DoChange;
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor);
FSelectedColor := FSLPicker.SelectedColor;
inherited;
end;
@@ -174,11 +171,26 @@ begin
inherited;
end;
function THSLRingPicker.GetBlue: Integer;
begin
Result := GetRValue(FSelectedColor);
end;
function THSLRingPicker.GetBrightnessMode: TBrightnessMode;
begin
Result := FSLPicker.BrightnessMode;
end;
function THSLRingPicker.GetColorUnderCursor: TColor;
begin
Result := FSLPicker.ColorUnderCursor;
end;
function THSLRingPicker.GetGreen: Integer;
begin
Result := GetGValue(FSelectedColor);
end;
function THSLRingPicker.GetHexColorUnderCursor: string;
begin
Result := FSLPicker.GetHexColorUnderCursor;
@@ -194,6 +206,14 @@ begin
Result := FSLPicker.Luminance;
end;
function THSLRingPicker.GetLVHint(AMode: TBrightnessMode): String;
begin
case BrightnessMode of
bmLuminance: Result := FSLPicker.SLHintFormat;
bmValue : Result := FSLPicker.SVHintFormat;
end;
end;
function THSLRingPicker.GetMaxHue: Integer;
begin
Result := FRingPicker.MaxHue;
@@ -209,16 +229,31 @@ begin
Result := FSLPicker.MaxLuminance;
end;
function THSLRingPicker.GetRed: Integer;
begin
Result := GetRValue(FSelectedColor);
end;
function THSLRingPicker.GetSat: Integer;
begin
Result := FSLPicker.Saturation;
end;
function THSLRingPicker.GetSelectedColor: TColor;
begin
Result := FSelectedColor;
end;
function THSLRingPicker.GetSelectedHexColor: string;
begin
Result := ColorToHex(FSelectedColor);
end;
function THSLRingPicker.GetVal: Integer;
begin
Result := FSLPicker.Value;
end;
procedure THSLRingPicker.Paint;
begin
PaintParentBack(PBack);
@@ -250,8 +285,6 @@ end;
procedure THSLRingPicker.RingPickerChange(Sender: TObject);
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
if FSLPicker.Hue <> FRingPicker.Hue then
begin
FSLPicker.Hue := FRingPicker.Hue;
@@ -259,23 +292,15 @@ begin
end;
end;
procedure THSLRingPicker.SelectColor(c: TColor);
procedure THSLRingPicker.SetBlue(B: integer);
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
FRingPicker.Hue := GetHValue(c);
//FRingPicker.Saturation := FRingPicker.MaxSaturation;
//FRingPicker.Value := FRingPicker.MaxValue;
FSLPicker.SelectedColor := c;
FSelectedColor := c;
SetSelectedColor(RgbToColor(Red, Green, B));
end;
procedure THSLRingPicker.SetB(v: integer);
procedure THSLRingPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
FBValue := v;
SelectColor(RGB(FRValue, FGValue, FBValue));
FRingPicker.BrightnessMode := AMode;
FSLPicker.BrightnessMode := AMode;
end;
procedure THSLRingPicker.SetFocus;
@@ -284,47 +309,51 @@ begin
FRingPicker.SetFocus;
end;
procedure THSLRingPicker.SetG(v: integer);
procedure THSLRingPicker.SetGreen(G: integer);
begin
FGValue := v;
SelectColor(RGB(FRValue, FGValue, FBValue));
SetSelectedColor(RgbToColor(Red, G, Blue));
end;
procedure THSLRingPicker.SetHue(H: integer);
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
FRingPicker.Hue := H;
FSLPicker.Hue := H;
end;
procedure THSLRingPicker.SetLum(L: integer);
begin
if (FSLPicker = nil) then
exit;
FSLPicker.Luminance := L;
end;
procedure THSLRingPicker.SetLVHint(AMode: TBrightnessMode; AText: string);
begin
case AMode of
bmLuminance: FSLPicker.SLHintFormat := AText;
bmValue : FSLPicker.SVHintFormat := AText;
end;
end;
procedure THSLRingPicker.SetMaxHue(H: Integer);
begin
FRingPicker.MaxHue := H;
FSLPicker.MaxHue := H;
end;
procedure THSLRingPicker.SetMaxLum(L: Integer);
begin
FRingPicker.MaxLuminance := L;
FSLPicker.MaxLuminance := L;
end;
procedure THSLRingPicker.SetMaxSat(S: Integer);
begin
FRingPicker.MaxSaturation := S;
FSLPicker.MaxSaturation := S;
end;
procedure THSLRingPicker.SetR(v: integer);
procedure THSLRingPicker.SetRed(R: integer);
begin
FRValue := v;
SelectColor(RGB(FRValue, FGValue, FBValue));
SetSelectedColor(RgbToColor(R, Green, Blue));
end;
procedure THSLRingPicker.SetRingCursor(c: TCursor);
@@ -347,36 +376,45 @@ end;
procedure THSLRingPicker.SetSat(S: integer);
begin
if (FSLPicker = nil) then
exit;
FSLPicker.Saturation := S;
end;
procedure THSLRingPicker.SetSelectedColor(c: TColor);
var
H, S, LV: Double;
begin
case BrightnessMode of
bmLuminance: ColorToHSL(c, H, S, LV);
bmValue : ColorToHSV(c, H, S, LV);
end;
FRingPicker.RelHue := H;
FSLPicker.SelectedColor := c;
FSelectedColor := FSLPicker.SelectedColor;
end;
procedure THSLRingPicker.SetSLCursor(c: TCursor);
begin
FSLCursor := c;
FSLPicker.Cursor := c;
end;
procedure THSLRingPicker.SetSLHint(h: string);
begin
FSLHint := h;
FSLPicker.HintFormat := h;
end;
procedure THSLRingPicker.SetSLMenu(m: TPopupMenu);
begin
FSLMenu := m;
FSLPicker.PopupMenu := m;
end;
procedure THSLRingPicker.SetVal(V: integer);
begin
FSLPicker.Value := V;
end;
procedure THSLRingPicker.SLPickerChange(Sender: TObject);
begin
if (FSLPicker <> nil) and (FSelectedColor <> FSLPicker.SelectedColor) then
begin
FSelectedColor := FSLPicker.SelectedColor;
DoChange;
end;
if FSelectedColor = FSLPicker.SelectedColor then
exit;
FSelectedColor := FSLPicker.SelectedColor;
DoChange;
end;
end.