mbColorLib: Add locking mechanism for OnChange events. Fix OfficeDlg forgetting selected color if picker type is changed on custom page.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5599 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-01-06 14:02:14 +00:00
parent a8a50d3df3
commit 69b268fa82
6 changed files with 58 additions and 19 deletions

View File

@ -53,7 +53,7 @@ type
implementation
uses
Math, mbUtils;
Math, mbUtils, PalUtils;
{ THSColorPicker }
@ -91,7 +91,10 @@ begin
if Focused or (csDesigning in ComponentState) then
c := clBlack
else
c := clWhite;
case BrightnessMode of
bmLuminance: c := clWhite;
bmValue : c := clGray;
end;
InternalDrawMarker(x, y, c);
end;
@ -154,9 +157,10 @@ begin
if WebSafe then c := GetWebSafe(c);
ColorToHSLV(c, H, S, L, V);
{
if (H = FHue) and (S = FSat) then
exit;
}
FHue := H;
FSat := S;
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);

View File

@ -109,7 +109,7 @@ type
property LVPickerCursor: TCursor read FLVCursor write SetLVCursor default crDefault;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 255;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 127;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 255;
property MaxValue: Integer read GetMaxVal write SetMaxVal default 255;
property TabStop default true;
property ShowHint;
@ -314,12 +314,17 @@ begin
end;
procedure THSLColorPicker.HSPickerChange(Sender: TObject);
var
c: TColor;
begin
if FHSPicker.Hue <> FLVPicker.Hue then
FLVPicker.Lock; // Lock the LVPicker to generate OnChange events here.
try
FLVPicker.Hue := FHSPicker.Hue;
if FHSPicker.Saturation <> FLVPicker.Saturation then
FLVPicker.Saturation := FHSPicker.Saturation;
DoChange;
finally
FLVPicker.Unlock;
DoChange;
end;
end;
procedure THSLColorPicker.LVPickerChange(Sender: TObject);
@ -331,9 +336,9 @@ procedure THSLColorPicker.Resize;
begin
inherited;
if (FHSPicker = nil) or (FLVPicker = nil) then
{ if (FHSPicker = nil) or (FLVPicker = nil) then
exit;
}
FHSPicker.Width := Width - FLVPicker.Width - 15;
FHSPicker.Height := Height - 12;
@ -498,14 +503,12 @@ begin
if c <> Value then
begin
case GetBrightnessMode of
bmLuminance: ColorToHSL(c, H, S, LV);
bmValue : ColorToHSV(c, H, S, LV);
bmLuminance: ColorToHSL(Value, H, S, LV);
bmValue : ColorToHSV(value, H, S, LV);
end;
// FSelectedColor := c;
FHSPicker.RelHue := H;
FHSPicker.RelSaturation := S;
// FHSPicker.SelectedColor := c;
FLVPicker.SelectedColor := c;
FLVPicker.SelectedColor := Value;
end;
end;
@ -514,5 +517,4 @@ begin
FLVPicker.Value := V;
end;
end.

View File

@ -582,9 +582,11 @@ begin
bmValue : ColortoHSV(c, H, S, V);
end;
if PickerNotebook.ActivePage = nbHSL.Name then
HSL.SelectedColor := c
else
if PickerNotebook.ActivePage = nbHSL.Name then begin
// HSL.Lock;
HSL.SelectedColor := c;
// HSL.Unlock;
end else
if PickerNotebook.ActivePage = nbHSLRing.Name then
HSLRing.SelectedColor := c
else

View File

@ -36,6 +36,9 @@ function mbColorToString(c: TColor): string;
//blends two colors together in proportion C1 : C2 = W1 : 100 - W1, where 0 <= W1 <= 100
function Blend(C1, C2: TColor; W1: Integer): TColor;
// Inverts a color
function InvertedColor(C: TColor): TColor;
//generates a white-color-black or a black-color-white gradient palette
function MakePalette(BaseColor: TColor; SortOrder: TSortOrder): string;
@ -60,6 +63,9 @@ function ReadPhotoshopAct(PalFile: TFileName): string;
implementation
uses
Math;
function ReplaceFlags(s: string; flags: array of string; value: integer): string;
var
i, p: integer;
@ -170,6 +176,11 @@ begin
Result := Result or G;
end;
function InvertedColor(C: TColor): TColor;
begin
Result := RgbToColor(255 - GetRValue(c), 255 - GetGValue(c), 255 - GetBValue(c));
end;
function IsMember(sl: TStrings; s: string): boolean;
var
i: integer;

View File

@ -17,6 +17,7 @@ type
private
FOnChange: TNotifyEvent;
FOnGetHintStr: TGetHintStrEvent;
FLockChange: Integer;
protected
FBufferBmp: TBitmap;
FGradientWidth: Integer;
@ -46,6 +47,9 @@ type
function GetColorAtPoint(X, Y: Integer): TColor; virtual;
function GetHexColorAtPoint(X, Y: integer): string;
function GetHexColorUnderCursor: string; virtual;
procedure Lock;
function IsLocked: Boolean;
procedure Unlock;
published
property ParentColor default true;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
@ -115,7 +119,7 @@ end;
procedure TmbBasicPicker.DoChange;
begin
if Assigned(FOnChange) then
if (FLockChange = 0) and Assigned(FOnChange) and (ComponentState = []) then
FOnChange(self);
end;
@ -164,6 +168,16 @@ begin
FOnGetHintStr(Self, X, Y, Result);
end;
function TmbBasicPicker.IsLocked: Boolean;
begin
Result := FLockChange > 0;
end;
procedure TmbBasicPicker.Lock;
begin
inc(FLockChange);
end;
procedure TmbBasicPicker.PaintParentBack;
begin
PaintParentBack(Canvas);
@ -209,5 +223,10 @@ begin
end;
end;
procedure TmbBasicPicker.Unlock;
begin
dec(FLockChange);
end;
end.

View File

@ -217,6 +217,7 @@ begin
begin
FSelColor := c;
Invalidate;
DoChange;
end;
end;