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

View File

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

View File

@ -582,9 +582,11 @@ begin
bmValue : ColortoHSV(c, H, S, V); bmValue : ColortoHSV(c, H, S, V);
end; end;
if PickerNotebook.ActivePage = nbHSL.Name then if PickerNotebook.ActivePage = nbHSL.Name then begin
HSL.SelectedColor := c // HSL.Lock;
else HSL.SelectedColor := c;
// HSL.Unlock;
end else
if PickerNotebook.ActivePage = nbHSLRing.Name then if PickerNotebook.ActivePage = nbHSLRing.Name then
HSLRing.SelectedColor := c HSLRing.SelectedColor := c
else 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 //blends two colors together in proportion C1 : C2 = W1 : 100 - W1, where 0 <= W1 <= 100
function Blend(C1, C2: TColor; W1: Integer): TColor; 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 //generates a white-color-black or a black-color-white gradient palette
function MakePalette(BaseColor: TColor; SortOrder: TSortOrder): string; function MakePalette(BaseColor: TColor; SortOrder: TSortOrder): string;
@ -60,6 +63,9 @@ function ReadPhotoshopAct(PalFile: TFileName): string;
implementation implementation
uses
Math;
function ReplaceFlags(s: string; flags: array of string; value: integer): string; function ReplaceFlags(s: string; flags: array of string; value: integer): string;
var var
i, p: integer; i, p: integer;
@ -170,6 +176,11 @@ begin
Result := Result or G; Result := Result or G;
end; 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; function IsMember(sl: TStrings; s: string): boolean;
var var
i: integer; i: integer;

View File

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

View File

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