From d68a23ef911151c2cd822aaad36f439795a53013 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 13 Dec 2016 22:51:29 +0000 Subject: [PATCH] mbColorLib: Add HSLRingPicker and RGBColorPickers to OfficeMoreColorsDialog, fix hints in OfficeMoreColorsDialog git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5476 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/mbColorLib/HSLColorPicker.pas | 21 +- .../mbColorLib/OfficeMoreColorsDialog.lfm | 246 +++++++++++++----- .../mbColorLib/OfficeMoreColorsDialog.pas | 211 ++++++++++++--- components/mbColorLib/SLHColorPicker.pas | 16 +- .../mbColorLib/examples/fulldemo/main.lfm | 120 +++++---- .../mbColorLib/examples/fulldemo/main.pas | 26 +- components/mbColorLib/mbBasicPicker.pas | 4 +- 7 files changed, 447 insertions(+), 197 deletions(-) diff --git a/components/mbColorLib/HSLColorPicker.pas b/components/mbColorLib/HSLColorPicker.pas index 42788379d..9f4d9f7e3 100644 --- a/components/mbColorLib/HSLColorPicker.pas +++ b/components/mbColorLib/HSLColorPicker.pas @@ -33,8 +33,6 @@ type FHSCursor, FLCursor: TCursor; PBack: TBitmap; function GetManual: boolean; - function GetShowHint: Boolean; - procedure SetShowHint(AValue: Boolean); procedure SetLumIncrement(i: integer); procedure SelectColor(c: TColor); procedure SetH(v: integer); @@ -52,15 +50,15 @@ type procedure SetSelectedColor(Value: TColor); protected procedure CreateWnd; override; + procedure DoChange; + procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Resize; override; procedure Paint; override; // procedure PaintParentBack; override; procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF}; - procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure HSPickerChange(Sender: TObject); procedure LPickerChange(Sender: TObject); - procedure DoChange; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -85,7 +83,7 @@ type property HSPickerCursor: TCursor read FHSCursor write SetHSCursor default crDefault; property LPickerCursor: TCursor read FLCursor write SetLCursor default crDefault; property TabStop default true; - property ShowHint read GetShowHint write SetShowHint; + property ShowHint; property ParentShowHint; property Anchors; property Align; @@ -326,18 +324,6 @@ begin Result := FHSPicker.Manual or FLPicker.Manual; end; -function THSLColorPicker.GetShowHint: Boolean; -begin - Result := inherited ShowHint; -end; - -procedure THSLColorPicker.SetShowHint(AValue: Boolean); -begin - inherited ShowHint := AValue; - FHSPicker.ShowHint := AValue; - FLPicker.ShowHint := AValue; -end; - (* procedure THSLColorPicker.PaintParentBack; begin @@ -361,7 +347,6 @@ end; procedure THSLColorPicker.Resize; begin inherited; - // PaintParentBack(Canvas); if (FHSPicker = nil) or (FLPicker = nil) then exit; diff --git a/components/mbColorLib/OfficeMoreColorsDialog.lfm b/components/mbColorLib/OfficeMoreColorsDialog.lfm index a4c455c75..1020ee026 100644 --- a/components/mbColorLib/OfficeMoreColorsDialog.lfm +++ b/components/mbColorLib/OfficeMoreColorsDialog.lfm @@ -1,15 +1,15 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Left = 265 - Height = 300 + Height = 310 Top = 115 - Width = 331 + Width = 343 ActiveControl = OKbtn BorderIcons = [biSystemMenu] Caption = 'More colors...' - ClientHeight = 300 - ClientWidth = 331 - Constraints.MinHeight = 300 - Constraints.MinWidth = 331 + ClientHeight = 310 + ClientWidth = 343 + Constraints.MinHeight = 310 + Constraints.MinWidth = 340 Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Shell Dlg 2' @@ -19,7 +19,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Position = poMainFormCenter LCLVersion = '1.7' object Label4: TLabel - Left = 264 + Left = 276 Height = 13 Top = 72 Width = 21 @@ -28,7 +28,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin ParentColor = False end object Label5: TLabel - Left = 256 + Left = 268 Height = 13 Top = 160 Width = 37 @@ -38,9 +38,9 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin end object Pages: TPageControl Left = 6 - Height = 280 + Height = 290 Top = 6 - Width = 227 + Width = 239 ActivePage = Custom Anchors = [akTop, akLeft, akRight, akBottom] TabIndex = 1 @@ -48,8 +48,8 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin OnChange = PagesChange object Standard: TTabSheet Caption = 'Standard' - ClientHeight = 254 - ClientWidth = 219 + ClientHeight = 264 + ClientWidth = 231 object Label2: TLabel Left = 6 Height = 13 @@ -61,9 +61,9 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin end object Hexa: THexaColorPicker Left = 0 - Height = 227 + Height = 237 Top = 26 - Width = 216 + Width = 228 Anchors = [akTop, akLeft, akRight, akBottom] HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' IntensityText = 'Intensity' @@ -75,8 +75,8 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin end object Custom: TTabSheet Caption = 'Custom' - ClientHeight = 254 - ClientWidth = 219 + ClientHeight = 264 + ClientWidth = 231 ImageIndex = 1 object Label1: TLabel Left = 6 @@ -90,17 +90,17 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin object Label3: TLabel Left = 6 Height = 13 - Top = 150 + Top = 160 Width = 32 Anchors = [akLeft, akBottom] - Caption = 'Mo&del:' - FocusControl = ColorModel + Caption = '&Picker:' + FocusControl = cbColorDisplay ParentColor = False end object LRed: TLabel Left = 6 Height = 13 - Top = 176 + Top = 186 Width = 23 Anchors = [akLeft, akBottom] Caption = '&Red:' @@ -109,7 +109,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin object LGreen: TLabel Left = 6 Height = 13 - Top = 202 + Top = 212 Width = 33 Anchors = [akLeft, akBottom] Caption = '&Green:' @@ -118,55 +118,35 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin object LBlue: TLabel Left = 6 Height = 13 - Top = 228 + Top = 238 Width = 24 Anchors = [akLeft, akBottom] Caption = '&Blue:' ParentColor = False end - object HSL: THSLColorPicker - Left = 6 - Height = 124 - Top = 20 - Width = 210 - HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' - LPickerHintFormat = 'Luminance: %l' - Anchors = [akTop, akLeft, akRight, akBottom] - TabOrder = 0 - OnChange = HSLChange - end - object ColorModel: TComboBox + object cbColorDisplay: TComboBox Left = 48 Height = 21 - Top = 146 + Top = 156 Width = 147 Anchors = [akLeft, akBottom] ItemHeight = 13 ItemIndex = 0 Items.Strings = ( - 'RGB' - 'HSL' + 'HS box, L bar' + 'H ring, SL box' + 'SL box, H bar' + 'RGB trackbars' ) - OnChange = ColorModelChange + OnChange = cbColorDisplayChange Style = csDropDownList - TabOrder = 1 - Text = 'RGB' - end - object SLH: TSLHColorPicker - Left = 6 - Height = 80 - Top = 20 - Width = 115 - HPickerHintFormat = 'Hue: %h' - SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex' - ParentShowHint = False - TabOrder = 2 - OnChange = SLHChange + TabOrder = 0 + Text = 'HS box, L bar' end object LHue: TLabel Left = 120 Height = 13 - Top = 176 + Top = 186 Width = 23 Anchors = [akLeft, akBottom] Caption = '&Hue:' @@ -175,7 +155,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin object LSat: TLabel Left = 120 Height = 13 - Top = 202 + Top = 212 Width = 20 Anchors = [akLeft, akBottom] Caption = '&Sat:' @@ -184,16 +164,166 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin object LLum: TLabel Left = 120 Height = 13 - Top = 228 + Top = 238 Width = 23 Anchors = [akLeft, akBottom] Caption = 'L&um:' ParentColor = False end + object PickerNotebook: TNotebook + Left = 6 + Height = 132 + Top = 22 + Width = 220 + PageIndex = 3 + Anchors = [akTop, akLeft, akRight, akBottom] + TabOrder = 1 + object nbHSL: TPage + object HSL: THSLColorPicker + Left = 0 + Height = 132 + Top = 0 + Width = 220 + HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' + LPickerHintFormat = 'Luminance: %l' + Align = alClient + TabOrder = 0 + OnChange = ColorPickerChange + end + end + object nbHSLRing: TPage + object HSLRing: THSLRingPicker + AnchorSideLeft.Control = nbHSLRing + AnchorSideLeft.Side = asrCenter + Left = 42 + Height = 124 + Top = 0 + Width = 136 + RingPickerHintFormat = 'Hue: %h' + SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex' + ParentShowHint = False + Anchors = [akTop, akLeft, akBottom] + TabOrder = 0 + OnChange = ColorPickerChange + end + object Bevel1: TBevel + Left = 0 + Height = 5 + Top = 127 + Width = 220 + Align = alBottom + Shape = bsSpacer + end + end + object nbSLH: TPage + object SLH: TSLHColorPicker + Left = 0 + Height = 122 + Top = 0 + Width = 238 + HPickerHintFormat = 'Hue: %h' + SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex' + ParentShowHint = False + Align = alClient + TabOrder = 0 + OnChange = ColorPickerChange + end + end + object nbRGB: TPage + object RTrackbar: TRColorPicker + AnchorSideRight.Control = nbRGB + AnchorSideRight.Side = asrBottom + Left = 14 + Height = 32 + Top = 0 + Width = 206 + HintFormat = 'Red: %value (selected)' + Layout = lyHorizontal + SelectionIndicator = siRect + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + OnChange = ColorPickerChange + SelectedColor = 8026879 + end + object GTrackbar: TGColorPicker + AnchorSideRight.Control = nbRGB + AnchorSideRight.Side = asrBottom + Left = 16 + Height = 32 + Top = 40 + Width = 204 + BevelInner = bvLowered + BevelOuter = bvRaised + HintFormat = 'Green: %value (selected)' + Layout = lyHorizontal + SelectionIndicator = siRect + Anchors = [akTop, akLeft, akRight] + TabOrder = 1 + OnChange = ColorPickerChange + SelectedColor = 8060794 + end + object BTrackbar: TBColorPicker + AnchorSideRight.Control = nbRGB + AnchorSideRight.Side = asrBottom + Left = 16 + Height = 32 + Top = 80 + Width = 204 + HintFormat = 'Blue: %value (selected)' + Layout = lyHorizontal + SelectionIndicator = siRect + Anchors = [akTop, akLeft, akRight] + TabOrder = 2 + OnChange = ColorPickerChange + SelectedColor = 16743034 + end + object Label6: TLabel + AnchorSideTop.Control = RTrackbar + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = RTrackbar + Left = 4 + Height = 13 + Top = 10 + Width = 7 + Anchors = [akTop, akRight] + BorderSpacing.Right = 3 + Caption = 'R' + ParentColor = False + end + object Label7: TLabel + AnchorSideTop.Control = GTrackbar + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = GTrackbar + Left = 4 + Height = 13 + Top = 50 + Width = 7 + Anchors = [akTop, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Right = 5 + Caption = 'G' + ParentColor = False + end + object Label8: TLabel + AnchorSideTop.Control = BTrackbar + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = BTrackbar + Left = 5 + Height = 13 + Top = 90 + Width = 6 + Anchors = [akTop, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Right = 5 + Caption = 'B' + ParentColor = False + end + end + end end end object OKbtn: TButton - Left = 242 + Left = 254 Height = 23 Top = 6 Width = 73 @@ -203,7 +333,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin TabOrder = 1 end object Cancelbtn: TButton - Left = 242 + Left = 254 Height = 23 Top = 36 Width = 73 @@ -214,7 +344,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin TabOrder = 2 end object NewSwatch: TmbColorPreview - Left = 242 + Left = 254 Height = 32 Hint = 'RGB(255, 255, 255)' Top = 92 @@ -225,7 +355,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin OnColorChange = NewSwatchColorChange end object OldSwatch: TmbColorPreview - Left = 242 + Left = 254 Height = 32 Hint = 'RGB(255, 255, 255)'#13#10'Hex: FFFFFF' Top = 123 diff --git a/components/mbColorLib/OfficeMoreColorsDialog.pas b/components/mbColorLib/OfficeMoreColorsDialog.pas index fc9100a07..0695f2451 100644 --- a/components/mbColorLib/OfficeMoreColorsDialog.pas +++ b/components/mbColorLib/OfficeMoreColorsDialog.pas @@ -14,17 +14,31 @@ uses Forms, StdCtrls, ExtCtrls, ComCtrls, HexaColorPicker, HSLColorPicker, RGBHSLUtils, mbColorPreview, {$IFDEF mbXP_Lib}mbXPSpinEdit, mbXPSizeGrip,{$ELSE} Spin,{$ENDIF} - HTMLColors, SLHColorPicker; + HTMLColors, SLHColorPicker, HSLRingPicker, RColorPicker, GColorPicker, + BColorPicker; type { TOfficeMoreColorsWin } TOfficeMoreColorsWin = class(TForm) + BTrackbar: TBColorPicker; + Bevel1: TBevel; + GTrackbar: TGColorPicker; + HSLRing: THSLRingPicker; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; LLum: TLabel; LSat: TLabel; LHue: TLabel; + nbRGB: TPage; + PickerNotebook: TNotebook; + nbHSL: TPage; + nbHSLRing: TPage; + nbSLH: TPage; Pages: TPageControl; + RTrackbar: TRColorPicker; SLH: TSLHColorPicker; Standard: TTabSheet; Custom: TTabSheet; @@ -33,7 +47,7 @@ type Label1: TLabel; Label2: TLabel; Label3: TLabel; - ColorModel: TComboBox; + cbColorDisplay: TComboBox; LRed: TLabel; LGreen: TLabel; LBlue: TLabel; @@ -43,7 +57,7 @@ type Cancelbtn: TButton; NewSwatch: TmbColorPreview; OldSwatch: TmbColorPreview; - procedure ColorModelChange(Sender: TObject); + procedure cbColorDisplayChange(Sender: TObject); procedure HSLChange(Sender: TObject); procedure ERedChange(Sender: TObject); procedure EGreenChange(Sender: TObject); @@ -56,10 +70,11 @@ type procedure FormResize(Sender: TObject); function GetHint(c: TColor): string; procedure HexaChange(Sender: TObject); + procedure HSLRingChange(Sender: TObject); procedure NewSwatchColorChange(Sender: TObject); procedure OldSwatchColorChange(Sender: TObject); procedure PagesChange(Sender: TObject); - procedure SetAllToSel(c: TColor); + procedure ColorPickerChange(Sender: TObject); procedure SLHChange(Sender: TObject); private {$IFDEF mbXP_Lib} @@ -71,9 +86,15 @@ type EHue, ESat, ELum: TSpinEdit; {$ENDIF} FLockChange: Integer; + function GetShowHint: Boolean; + procedure SetAllCustom(c: TColor); + procedure SetAllToSel(c: TColor); + procedure SetShowHint(AValue: boolean); protected procedure CreateParams(var Params: TCreateParams); override; - procedure CreateWnd; override; +// procedure CreateWnd; override; + published + property ShowHint: Boolean read GetShowHint write SetShowHint; end; var @@ -87,31 +108,77 @@ implementation {$R *.lfm} {$ENDIF} +procedure TOfficeMoreColorsWin.ColorPickerChange(Sender: TObject); +begin + if FLockChange <> 0 then + exit; + if Sender = HSL then + SetAllCustom(HSL.SelectedColor); + if Sender = HSLRing then + SetAllCustom(HSLRing.SelectedColor); + if Sender = SLH then + SetAllCustom(SLH.SelectedColor); + if Sender = RTrackbar then + SetAllCustom(RTrackbar.SelectedColor); + if Sender = GTrackbar then + SetAllCustom(GTrackbar.SelectedColor); + if Sender = BTrackbar then + SetAllCustom(BTrackbar.SelectedColor); +end; + procedure TOfficeMoreColorsWin.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.Style := WS_CAPTION or WS_SIZEBOX or WS_SYSMENU; Params.ExStyle := WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE; end; - + (* procedure TOfficeMoreColorsWin.CreateWnd; begin inherited CreateWnd; { wp : LM_SETICON not used in LCL } // SendMessage(Self.Handle, {$IFDEF FPC}LM_SETICON{$ELSE}WM_SETICON{$ENDIF}, 1, 0); end; - -procedure TOfficeMoreColorsWin.ColorModelChange(Sender: TObject); + *) +procedure TOfficeMoreColorsWin.cbColorDisplayChange(Sender: TObject); begin - HSL.Visible := ColorModel.ItemIndex = 0; - SLH.Visible := ColorModel.ItemIndex = 1; - HSL.SelectedColor := NewSwatch.Color; - SLH.SelectedColor := NewSwatch.Color; + PickerNotebook.PageIndex := cbColorDisplay.ItemIndex; + SetAllCustom(NewSwatch.Color); + exit; + + + + + { + HSL.Visible := cbColorDisplay.ItemIndex = 0; + HSLRing.Visible := cbColorDisplay.ItemIndex = 1; + SLH.Visible := cbColorDisplay.ItemIndex = 2; + } + if HSL.Visible then + HSL.SelectedColor := NewSwatch.Color; + if HSLRing.Visible then + HSLRing.SelectedColor := NewSwatch.Color; + if SLH.Visible then + SLH.SelectedColor := NewSwatch.Color; +end; + +function TOfficeMoreColorsWin.GetShowHint: Boolean; +begin + Result := inherited ShowHint; end; procedure TOfficeMoreColorsWin.HSLChange(Sender: TObject); begin - NewSwatch.Color := HSL.SelectedColor; + if FLockChange <> 0 then + exit; + SetAllCustom(HSL.SelectedColor); +end; + +procedure TOfficeMoreColorsWin.HSLRingChange(Sender: TObject); +begin + if FLockChange <> 0 then + exit; + SetAllCustom(HSLRing.SelectedColor); end; procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject); @@ -223,12 +290,23 @@ begin then exit; + SetAllCustom(NewSwatch.Color); + { + ERed.Value := GetRValue(NewSwatch.Color); EGreen.Value := GetGValue(NewSwatch.Color); EBlue.Value := GetBValue(NewSwatch.Color); EHue.Value := GetHValue(NewSwatch.Color); ESat.Value := GetSValue(NewSwatch.Color); ELum.Value := GetLValue(NewSwatch.Color); + + if HSL.Visible then + HSL.SelectedColor := NewSwatch.Color; + if HSLRing.Visible then + HSLRing.SelectedColor := NewSwatch.Color; + if SLH.Visible then + SLH.SelectedColor := NewSwatch.Color; + } end; procedure TOfficeMoreColorsWin.OldSwatchColorChange(Sender: TObject); @@ -245,24 +323,73 @@ begin // Standard Page 0: Hexa.SelectedColor := c; // Custom Page - 1: begin - HSL.SelectedColor := c; - SLH.SelectedColor := c; - ERed.Value := GetRValue(c); - EGreen.Value := GetGValue(c); - EBlue.Value := GetBValue(c); - RGBtoHSLRange(c, h, s, l); - EHue.Value := h; - ESat.Value := s; - ELum.Value := l; - end; + 1: SetAllCustom(c); end; NewSwatch.Color := c; end; +procedure TOfficeMoreColorsWin.SetAllCustom(c: TColor); +var + r, g, b: Integer; + h, s, l: Integer; +begin + if (ERed = nil) or (EGreen = nil) or (EBlue = nil) or + (EHue = nil) or (ESat = nil) or (ELum = nil) or + (PickerNotebook = nil) or (HSL = nil) or (HSLRing = nil) or (SLH = nil) + then + exit; + + inc(FLockChange); + try + NewSwatch.Color := c; + r := GetRValue(c); + g := GetGValue(c); + b := GetBValue(c); + RGBtoHSLRange(c, h, s, l); + + if PickerNotebook.ActivePage = nbHSL.Name then + HSL.SelectedColor := c + else + if PickerNotebook.ActivePage = nbHSLRing.Name then + HSLRing.SelectedColor := c + else + if PickerNotebook.ActivePage = nbSLH.Name then + SLH.SelectedColor := c + else + if PickerNotebook.ActivePage = nbRGB.Name then + begin + RTrackbar.SelectedColor := c; + GTrackbar.SelectedColor := c; + BTrackbar.SelectedColor := c; + end + else + exit; //raise Exception.Create('Notbook page not prepared for color pickers'); + + ERed.Value := r; + EGreen.Value := g; + EBlue.Value := b; + EHue.Value := h; + ESat.Value := s; + ELum.Value := l; + finally + dec(FLockChange); + end; +end; + +procedure TOfficeMoreColorsWin.SetShowHint(AValue: Boolean); +begin + inherited ShowHint := AValue; + // Unfortunately Notebook does not have a Hint and ParentHint... + HSL.ShowHint := AValue; + HSLRing.ShowHint := AValue; + SLH.ShowHint := AValue; +end; + procedure TOfficeMoreColorsWin.SLHChange(Sender: TObject); begin - NewSwatch.Color := SLH.SelectedColor; + if FLockChange <> 0 then + exit; + SetAllCustom(SLH.SelectedColor); end; procedure TOfficeMoreColorsWin.PagesChange(Sender: TObject); @@ -272,8 +399,13 @@ end; procedure TOfficeMoreColorsWin.FormResize(Sender: TObject); begin + { SLH.Width := SLH.Parent.ClientWidth - SLH.Left; - SLH.Height := ColorModel.Top - SLH.Top; + SLH.Height := cbColorDisplay.Top - SLH.Top; + + HSLRing.Width := SLH.Width; + HSLRing.Height := SLH.Height - 4; + } {$IFDEF mbXP_Lib} grip.Left := ClientWidth - 15; grip.Top := ClientHeight - 15; @@ -282,13 +414,6 @@ end; procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject); begin - SLH.Width := HSL.Width; - SLH.Height := HSL.Height; - SLH.Top := HSL.Top; - SLH.Left := HSL.Left; - SLH.Hide; -// SLH.Anchors := [akLeft, akTop, akRight, akBottom]; - {$IFDEF mbXP_Lib} ERed := TmbXPSpinEdit.CreateParented(Custom.Handle); EGreen := TmbXPSpinEdit.CreateParented(Custom.Handle); @@ -299,7 +424,7 @@ begin EGreen := TSpinEdit.CreateParented(Custom.Handle); EBlue := TSpinEdit.CreateParented(Custom.Handle); EHue := TSpinEdit.CreateParented(Custom.Handle); - ESat := TSpinEdit.createParented(Custom.Handle); + ESat := TSpinEdit.CreateParented(Custom.Handle); ELum := TSpinEdit.CreateParented(Custom.Handle); {$ENDIF} with ERed do @@ -307,8 +432,8 @@ begin Name := 'ERed'; Width := 47; Height := 22; - Left := ColorModel.Left; - Top := LRed.Top - 4; //198; + Left := cbColorDisplay.Left; + Top := LRed.Top - 4; Alignment := taRightJustify; Anchors := [akLeft, akBottom]; MaxValue := 255; @@ -321,8 +446,8 @@ begin Name := 'EGreen'; Width := 47; Height := 22; - Left := ColorModel.Left; - Top := LGreen.Top - 3; //224; + Left := cbColorDisplay.Left; + Top := LGreen.Top - 3; Alignment := taRightJustify; Anchors := [akLeft, akBottom]; MaxValue := 255; @@ -335,8 +460,8 @@ begin Name := 'EBlue'; Width := 47; Height := 22; - Left := ColorModel.Left; - Top := LBlue.Top - 4; //251; + Left := cbColorDisplay.Left; + Top := LBlue.Top - 4; Alignment := taRightJustify; Anchors := [akLeft, akBottom]; MaxValue := 255; @@ -349,7 +474,7 @@ begin Name := 'EHue'; Width := 47; Height := 22; - Left := ColorModel.Left + ColorModel.Width - Width; + Left := cbColorDisplay.Left + cbColorDisplay.Width - Width; Top := ERed.Top; Alignment := taRightJustify; Anchors := [akLeft, akBottom]; @@ -363,7 +488,7 @@ begin Name := 'ESat'; Width := 47; Height := 22; - Left := ColorModel.Left + ColorModel.Width - Width; + Left := cbColorDisplay.Left + cbColorDisplay.Width - Width; Top := EGreen.Top; Alignment := taRightJustify; Anchors := [akLeft, akBottom]; @@ -377,7 +502,7 @@ begin Name := 'ELum'; Width := 47; Height := 22; - Left := ColorModel.Left + ColorModel.Width - Width; + Left := cbColorDisplay.Left + cbColorDisplay.Width - Width; Top := EBlue.Top; Alignment := taRightJustify; Anchors := [akLeft, akBottom]; diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas index 2391daea9..0fd521300 100644 --- a/components/mbColorLib/SLHColorPicker.pas +++ b/components/mbColorLib/SLHColorPicker.pas @@ -32,8 +32,6 @@ type FSLCursor, FHCursor: TCursor; PBack: TBitmap; function GetManual: boolean; - function GetShowHint: Boolean; - procedure SetShowHint(AValue: Boolean); procedure SelectColor(c: TColor); procedure SetH(v: integer); procedure SetS(v: integer); @@ -81,7 +79,7 @@ type property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault; property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault; property TabStop default true; - property ShowHint read GetShowHint write SetShowHint; + property ShowHint; property ParentShowHint; property Anchors; property Align; @@ -328,18 +326,6 @@ begin Result := FHPicker.Manual or FSLPicker.Manual; end; -function TSLHColorPicker.GetShowHint: Boolean; -begin - result := inherited ShowHint; -end; - -procedure TSLHColorPicker.SetShowHint(AValue: Boolean); -begin - inherited ShowHint := AValue; - FSLPicker.ShowHint := AValue; - FHPicker.ShowHint := AValue; -end; - procedure TSLHColorPicker.Resize; begin inherited; diff --git a/components/mbColorLib/examples/fulldemo/main.lfm b/components/mbColorLib/examples/fulldemo/main.lfm index c8db6cb64..c44aee00a 100644 --- a/components/mbColorLib/examples/fulldemo/main.lfm +++ b/components/mbColorLib/examples/fulldemo/main.lfm @@ -1,17 +1,17 @@ object Form1: TForm1 Left = 447 - Height = 344 + Height = 376 Top = 197 - Width = 543 + Width = 539 Caption = 'mbColor Lib v2.0.1 Demo' - ClientHeight = 344 - ClientWidth = 543 + ClientHeight = 376 + ClientWidth = 539 Font.Color = clWindowText OnCreate = FormCreate ShowHint = True LCLVersion = '1.7' object Label1: TLabel - Left = 412 + Left = 416 Height = 15 Top = 8 Width = 73 @@ -20,7 +20,7 @@ object Form1: TForm1 ParentColor = False end object Label2: TLabel - Left = 412 + Left = 416 Height = 15 Top = 112 Width = 96 @@ -29,9 +29,9 @@ object Form1: TForm1 ParentColor = False end object Label5: TLabel - Left = 412 + Left = 416 Height = 75 - Top = 238 + Top = 248 Width = 99 Anchors = [akTop, akRight] Caption = 'Aditional controls:'#13#13'- Arrow keys'#13'- Ctrl + Arrow keys'#13'- Mouse wheel' @@ -39,12 +39,12 @@ object Form1: TForm1 end object PageControl1: TPageControl Left = 6 - Height = 331 + Height = 363 Top = 6 - Width = 399 - ActivePage = TabSheet6 + Width = 403 + ActivePage = TabSheet7 Anchors = [akTop, akLeft, akRight, akBottom] - TabIndex = 5 + TabIndex = 7 TabOrder = 0 OnMouseMove = PageControl1MouseMove object TabSheet1: TTabSheet @@ -616,16 +616,17 @@ object Form1: TForm1 end object TabSheet6: TTabSheet Caption = 'SLHColorPicker' - ClientHeight = 303 - ClientWidth = 391 + ClientHeight = 329 + ClientWidth = 387 ImageIndex = 5 object SLHColorPicker1: TSLHColorPicker - Left = 5 - Height = 291 + Left = 8 + Height = 317 Top = 6 - Width = 381 + Width = 377 HPickerHintFormat = 'Hue: %h (selected)' SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex' + ParentShowHint = False Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 OnChange = SLHColorPicker1Change @@ -634,32 +635,35 @@ object Form1: TForm1 end object TabSheet11: TTabSheet Caption = 'Lists && Trees' - ClientHeight = 303 - ClientWidth = 391 + ClientHeight = 335 + ClientWidth = 395 ImageIndex = 10 object mbColorList1: TmbColorList - Left = 192 - Height = 244 - Top = 12 + Left = 200 + Height = 278 + Top = 10 Width = 183 + Anchors = [akTop, akLeft, akBottom] TabOrder = 0 end object mbColorTree1: TmbColorTree Left = 8 - Height = 247 + Height = 279 Top = 10 - Width = 171 + Width = 184 InfoLabelText = 'Color Values:' InfoDisplay1 = 'RGB: %r.%g.%b' InfoDisplay2 = 'HEX: #%hex' + Anchors = [akTop, akLeft, akBottom] Indent = 51 TabOrder = 1 end object Button5: TButton - Left = 120 + Left = 128 Height = 25 - Top = 264 + Top = 296 Width = 137 + Anchors = [akLeft, akBottom] Caption = 'Add colors from palette' OnClick = Button5Click TabOrder = 2 @@ -667,8 +671,8 @@ object Form1: TForm1 end object TabSheet7: TTabSheet Caption = 'More' - ClientHeight = 303 - ClientWidth = 391 + ClientHeight = 335 + ClientWidth = 395 ImageIndex = 6 object Label9: TLabel Left = 128 @@ -700,8 +704,8 @@ object Form1: TForm1 object LColorPicker1: TLColorPicker Left = 34 Height = 25 - Top = 192 - Width = 343 + Top = 224 + Width = 347 HintFormat = 'Luminance: %l (selected)' SelectionIndicator = siRect Anchors = [akLeft, akRight, akBottom] @@ -713,8 +717,8 @@ object Form1: TForm1 object VColorPicker1: TVColorPicker Left = 34 Height = 21 - Top = 160 - Width = 343 + Top = 192 + Width = 347 HintFormat = 'Value: %v (selected)' ArrowPlacement = spBefore NewArrowStyle = True @@ -729,8 +733,8 @@ object Form1: TForm1 object HColorPicker1: THColorPicker Left = 34 Height = 61 - Top = 231 - Width = 343 + Top = 263 + Width = 347 HintFormat = 'Hue: %h (selected)' Increment = 5 ArrowPlacement = spBoth @@ -742,7 +746,7 @@ object Form1: TForm1 end object SColorPicker1: TSColorPicker Left = 8 - Height = 222 + Height = 254 Top = 70 Width = 19 HintFormat = 'Saturation: %s (selected)' @@ -758,9 +762,9 @@ object Form1: TForm1 end object Memo1: TMemo Left = 128 - Height = 118 + Height = 150 Top = 26 - Width = 249 + Width = 253 Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( 'The following variables will be replaced in the hint at runtime:' @@ -805,8 +809,8 @@ object Form1: TForm1 end object TabSheet8: TTabSheet Caption = 'Other' - ClientHeight = 303 - ClientWidth = 391 + ClientHeight = 335 + ClientWidth = 395 ImageIndex = 7 object HSColorPicker1: THSColorPicker Left = 6 @@ -1108,7 +1112,7 @@ object Form1: TForm1 end end object sc: TmbColorPreview - Left = 412 + Left = 416 Height = 62 Top = 25 Width = 108 @@ -1116,7 +1120,7 @@ object Form1: TForm1 Anchors = [akTop, akRight] end object uc: TmbColorPreview - Left = 412 + Left = 416 Height = 62 Top = 130 Width = 108 @@ -1124,7 +1128,7 @@ object Form1: TForm1 Anchors = [akTop, akRight] end object tb1: TTrackBar - Left = 412 + Left = 416 Height = 20 Hint = 'Opacity' Top = 90 @@ -1137,7 +1141,7 @@ object Form1: TForm1 TabOrder = 3 end object tb2: TTrackBar - Left = 412 + Left = 416 Height = 20 Top = 196 Width = 108 @@ -1148,34 +1152,46 @@ object Form1: TForm1 Anchors = [akTop, akRight] TabOrder = 4 end - object CheckBox3: TCheckBox - Left = 412 + object CbWebSsafe: TCheckBox + Left = 416 Height = 19 - Top = 320 + Top = 328 Width = 66 Anchors = [akTop, akRight] Caption = 'WebSafe' - OnClick = CheckBox3Click + OnClick = CbWebSsafeClick TabOrder = 5 end - object CheckBox4: TCheckBox - Left = 412 + object CbSwatchStyle: TCheckBox + Left = 416 Height = 19 Top = 218 Width = 83 Anchors = [akTop, akRight] Caption = 'SwatchStyle' - OnClick = CheckBox4Click + OnClick = CbSwatchStyleClick TabOrder = 6 end + object CbShowHints: TCheckBox + Left = 416 + Height = 19 + Top = 349 + Width = 78 + Anchors = [akTop, akRight] + Caption = 'Show hints' + Checked = True + OnChange = CbShowHintsChange + State = cbChecked + TabOrder = 7 + end object mbOfficeColorDialog1: TmbOfficeColorDialog UseHints = True - left = 448 + left = 456 top = 136 end object OpenDialog1: TOpenDialog Filter = 'JASC PAL (*.pal)|*.pal|Photoshop (*.act; *.aco)|*.act;*.aco' - left = 440 + left = 456 top = 40 end end diff --git a/components/mbColorLib/examples/fulldemo/main.pas b/components/mbColorLib/examples/fulldemo/main.pas index c61e8f96f..766c7b620 100644 --- a/components/mbColorLib/examples/fulldemo/main.pas +++ b/components/mbColorLib/examples/fulldemo/main.pas @@ -20,6 +20,7 @@ type { TForm1 } TForm1 = class(TForm) + CbShowHints: TCheckBox; Label10: TLabel; Label11: TLabel; Label12: TLabel; @@ -95,14 +96,15 @@ type CIELColorPicker1: TCIELColorPicker; CIEAColorPicker1: TCIEAColorPicker; CIEBColorPicker1: TCIEBColorPicker; - CheckBox3: TCheckBox; + CbWebSsafe: TCheckBox; TabSheet11: TTabSheet; mbColorList1: TmbColorList; mbColorTree1: TmbColorTree; Button5: TButton; Memo1: TMemo; Label9: TLabel; - CheckBox4: TCheckBox; + CbSwatchStyle: TCheckBox; + procedure CbShowHintsChange(Sender: TObject); procedure PageControl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure tb1Change(Sender: TObject); @@ -148,9 +150,9 @@ type procedure ComboBox3Change(Sender: TObject); procedure ComboBox4Change(Sender: TObject); procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean); - procedure CheckBox3Click(Sender: TObject); + procedure CbWebSsafeClick(Sender: TObject); procedure Button5Click(Sender: TObject); - procedure CheckBox4Click(Sender: TObject); + procedure CbSwatchStyleClick(Sender: TObject); private { Private declarations } public @@ -365,13 +367,13 @@ allowchange := true; mbcolorpalette1.CellSize := abs(updown1.Position); end; -procedure TForm1.CheckBox3Click(Sender: TObject); +procedure TForm1.CbWebSsafeClick(Sender: TObject); var i: integer; begin for i := 0 to ComponentCount - 1 do if IsPublishedProp(components[i], 'WebSafe') = true then - SetOrdProp(components[i], 'WebSafe', integer(checkbox3.checked)); + SetOrdProp(components[i], 'WebSafe', integer(CbWebSsafe.checked)); end; procedure TForm1.Button5Click(Sender: TObject); @@ -389,10 +391,16 @@ begin mbcolorlist1.UpdateColors; end; -procedure TForm1.CheckBox4Click(Sender: TObject); +procedure TForm1.CbSwatchStyleClick(Sender: TObject); begin - sc.swatchstyle := checkbox4.Checked; - uc.swatchstyle := checkbox4.checked; + sc.swatchstyle := CbSwatchStyle.Checked; + uc.swatchstyle := CbSwatchStyle.checked; +end; + +procedure TForm1.CbShowHintsChange(Sender: TObject); +begin + PageControl1.ShowHint := CbShowHints.Checked; + mbOfficeColorDialog1.UseHints := CbShowHints.Checked; end; end. diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas index c0e876b02..dd8305368 100644 --- a/components/mbColorLib/mbBasicPicker.pas +++ b/components/mbColorLib/mbBasicPicker.pas @@ -146,7 +146,7 @@ begin inherited; if ShowHint and not FHintShown then begin - if MouseOnPicker(X, Y) then //and not FHintShown then + if MouseOnPicker(X, Y) then begin FHintTimer.Enabled := false; FHintState := hsWaitingToShow; @@ -206,7 +206,7 @@ begin // Offscreen.PixelFormat := pf32bit; if Color = clDefault then begin Offscreen.Transparent := true; - Offscreen.TransparentColor := GetDefaultColor(dctBrush); + Offscreen.TransparentColor := clForm; //GetDefaultColor(dctBrush); end; Offscreen.Width := Width; Offscreen.Height := Height;