From 90314c08769967f669db3b7a5e76871343f69b59 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 16 Dec 2016 18:42:32 +0000 Subject: [PATCH] mbColorLib: Redo hints git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5519 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/mbColorLib/HRingPicker.pas | 9 +- components/mbColorLib/HSLColorPicker.pas | 8 +- components/mbColorLib/HSLRingPicker.pas | 8 +- components/mbColorLib/SLColorPicker.pas | 1 + components/mbColorLib/SLHColorPicker.pas | 8 +- .../mbColorLib/examples/fulldemo/Demo.lpi | 4 - .../mbColorLib/examples/fulldemo/main.lfm | 31 +++--- .../mbColorLib/examples/fulldemo/main.pas | 10 +- components/mbColorLib/mbBasicPicker.pas | 95 +++++++++++++++++-- components/mbColorLib/mbColorPalette.pas | 38 +++++--- .../mbColorLib/mbColorPickerControl.pas | 60 ++++++------ components/mbColorLib/mbColorTree.pas | 2 +- components/mbColorLib/mbTrackBarPicker.pas | 70 ++++++++++++-- 13 files changed, 244 insertions(+), 100 deletions(-) diff --git a/components/mbColorLib/HRingPicker.pas b/components/mbColorLib/HRingPicker.pas index 7240c14b7..e9b053e6d 100644 --- a/components/mbColorLib/HRingPicker.pas +++ b/components/mbColorLib/HRingPicker.pas @@ -42,7 +42,7 @@ type procedure SetSelectedColor(c: TColor); override; procedure Paint; override; procedure Resize; override; - procedure CreateWnd; override; +// procedure CreateWnd; override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; function MouseOnPicker(X, Y: Integer): Boolean; override; @@ -52,6 +52,7 @@ type public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; + property ColorUnderCursor; published property Hue: integer read FHue write SetHue default 0; property Saturation: integer read FSat write SetSat default 0; @@ -135,14 +136,14 @@ begin CreateGradient; UpdateCoords; end; - + { procedure THRingPicker.CreateWnd; begin inherited; CreateGradient; UpdateCoords; end; - + } procedure THRingPicker.UpdateCoords; var r, angle: real; @@ -396,7 +397,7 @@ begin s := 255 else s := MulDiv(distance, 255, radius); - if PointInCircle(Point(mx, my), Min(Width, Height)) then + if PointInCircle(Point(x, y), Min(Width, Height)) then begin if not WebSafe then Result := HSVtoColor(h, s, FValue) diff --git a/components/mbColorLib/HSLColorPicker.pas b/components/mbColorLib/HSLColorPicker.pas index 9f4d9f7e3..d2af65f5e 100644 --- a/components/mbColorLib/HSLColorPicker.pas +++ b/components/mbColorLib/HSLColorPicker.pas @@ -52,6 +52,7 @@ type procedure CreateWnd; override; procedure DoChange; procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + function GetColorUnderCursor: TColor; override; procedure Resize; override; procedure Paint; override; // procedure PaintParentBack; override; @@ -62,10 +63,9 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function GetColorUnderCursor: TColor; - function GetHexColorUnderCursor: string; + function GetHexColorUnderCursor: string; override; function GetSelectedHexColor: string; - property ColorUnderCursor: TColor read GetColorUnderCursor; + property ColorUnderCursor; property HValue: integer read FHValue write SetH default 0; property SValue: integer read FSValue write SetS default 240; property LValue: integer read FLValue write SetL default 120; @@ -292,7 +292,7 @@ end; function THSLColorPicker.GetColorUnderCursor: TColor; begin - Result := FHSPicker.GetColorUnderCursor; + Result := FHSPicker.ColorUnderCursor; end; function THSLColorPicker.GetHexColorUnderCursor: string; diff --git a/components/mbColorLib/HSLRingPicker.pas b/components/mbColorLib/HSLRingPicker.pas index fa7399416..fc42854e8 100644 --- a/components/mbColorLib/HSLRingPicker.pas +++ b/components/mbColorLib/HSLRingPicker.pas @@ -49,6 +49,7 @@ type procedure CreateWnd; override; procedure Paint; override; procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + function GetColorUnderCursor: TColor; override; procedure RingPickerChange(Sender: TObject); procedure SLPickerChange(Sender: TObject); procedure DoChange; @@ -61,10 +62,9 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function GetColorUnderCursor: TColor; - function GetHexColorUnderCursor: string; + function GetHexColorUnderCursor: string; override; function GetSelectedHexColor: string; - property ColorUnderCursor: TColor read GetColorUnderCursor; + property ColorUnderCursor; property HValue: integer read FHValue write SetH default 0; property SValue: integer read FSValue write SetS default 240; property LValue: integer read FLValue write SetL default 120; @@ -324,7 +324,7 @@ end; function THSLRingPicker.GetColorUnderCursor: TColor; begin - Result := FSLPicker.GetColorUnderCursor; + Result := FSLPicker.ColorUnderCursor; end; function THSLRingPicker.GetHexColorUnderCursor: string; diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas index b4f72ab2f..d684d3495 100644 --- a/components/mbColorLib/SLColorPicker.pas +++ b/components/mbColorLib/SLColorPicker.pas @@ -41,6 +41,7 @@ type public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; + property ColorUnderCursor; published property Hue: integer read FHue write SetHue default 0; property Saturation: integer read FSat write SetSat default 0; diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas index 0fd521300..d8ee7c718 100644 --- a/components/mbColorLib/SLHColorPicker.pas +++ b/components/mbColorLib/SLHColorPicker.pas @@ -51,6 +51,7 @@ type procedure CreateWnd; override; procedure DoChange; procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + function GetColorUnderCursor: TColor; override; procedure Paint; override; // procedure PaintParentBack; override; procedure Resize; override; @@ -59,10 +60,9 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function GetColorUnderCursor: TColor; - function GetHexColorUnderCursor: string; + function GetHexColorUnderCursor: string; override; function GetSelectedHexColor: string; - property ColorUnderCursor: TColor read GetColorUnderCursor; + property ColorUnderCursor; property HValue: integer read FHValue write SetH default 0; property SValue: integer read FSValue write SetS default 240; property LValue: integer read FLValue write SetL default 120; @@ -294,7 +294,7 @@ end; function TSLHColorPicker.GetColorUnderCursor: TColor; begin - Result := FSLPicker.GetColorUnderCursor; + Result := FSLPicker.ColorUnderCursor; end; function TSLHColorPicker.GetHexColorUnderCursor: string; diff --git a/components/mbColorLib/examples/fulldemo/Demo.lpi b/components/mbColorLib/examples/fulldemo/Demo.lpi index 6f9e155fd..68578641c 100644 --- a/components/mbColorLib/examples/fulldemo/Demo.lpi +++ b/components/mbColorLib/examples/fulldemo/Demo.lpi @@ -9,10 +9,6 @@ <ResourceType Value="res"/> <UseXPManifest Value="True"/> - <XPManifest> - <TextName Value="CompanyName.ProductName.AppName"/> - <TextDesc Value="Your application description."/> - </XPManifest> <Icon Value="0"/> </General> <BuildModes Count="1"> diff --git a/components/mbColorLib/examples/fulldemo/main.lfm b/components/mbColorLib/examples/fulldemo/main.lfm index 30f87aaf2..fa2f62643 100644 --- a/components/mbColorLib/examples/fulldemo/main.lfm +++ b/components/mbColorLib/examples/fulldemo/main.lfm @@ -42,9 +42,9 @@ object Form1: TForm1 Height = 384 Top = 6 Width = 403 - ActivePage = TabSheet5 + ActivePage = TabSheet10 Anchors = [akTop, akLeft, akRight, akBottom] - TabIndex = 4 + TabIndex = 10 TabOrder = 0 OnChange = PageControl1Change OnMouseMove = PageControl1MouseMove @@ -57,8 +57,8 @@ object Form1: TForm1 Height = 340 Top = 8 Width = 381 - SelectedColor = 273922 - HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' + SelectedColor = 2048 + HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex' LPickerHintFormat = 'Luminance: %l' Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 @@ -87,7 +87,7 @@ object Form1: TForm1 Top = 4 Width = 289 Anchors = [akTop, akLeft, akRight, akBottom] - HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + HintFormat = 'RGB(%r, %g, %b)'#13'Hex: #%hex' SliderMarker = smRect IntensityText = 'Intensity' TabOrder = 0 @@ -480,7 +480,7 @@ object Form1: TForm1 'clBlack' 'clBlack' ) - HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + HintFormat = 'RGB(%r, %g, %b)'#13'Hex: #%hex' AutoHeight = True TabOrder = 0 OnSelColorChange = mbColorPalette1SelColorChange @@ -628,7 +628,6 @@ object Form1: TForm1 Width = 385 HPickerHintFormat = 'Hue: %h (selected)' SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex' - ParentShowHint = False Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 OnChange = SLHColorPicker1Change @@ -738,12 +737,13 @@ object Form1: TForm1 Height = 61 Top = 284 Width = 347 - HintFormat = 'Hue: %h (selected)' + HintFormat = 'Hue: %h (under mouse)' Increment = 5 ArrowPlacement = spBoth SelectionIndicator = siRect Anchors = [akLeft, akRight, akBottom] TabOrder = 4 + OnGetHintStr = HColorPicker1GetHintStr Saturation = 120 SelectedColor = 8882175 end @@ -829,7 +829,7 @@ object Form1: TForm1 OnChange = HSColorPicker1Change end object SLColorPicker1: TSLColorPicker - Left = 222 + Left = 224 Height = 147 Top = 144 Width = 161 @@ -1006,7 +1006,7 @@ object Form1: TForm1 Height = 100 Top = 28 Width = 100 - HintFormat = 'G: %g B: %b'#13'Hex: %hex' + HintFormat = 'G: %g B: %b'#13'Hex: #%hex' TabOrder = 0 end object GAxisColorPicker1: TGAxisColorPicker @@ -1014,7 +1014,7 @@ object Form1: TForm1 Height = 100 Top = 28 Width = 100 - HintFormat = 'R: %r B: %b'#13'Hex: %hex' + HintFormat = 'R: %r B: %b'#13'Hex: #%hex' TabOrder = 1 MarkerStyle = msCross end @@ -1023,7 +1023,7 @@ object Form1: TForm1 Height = 100 Top = 28 Width = 100 - HintFormat = 'R: %r G: %g'#13'Hex: %hex' + HintFormat = 'R: %r G: %g'#13'Hex: #%hex' TabOrder = 2 MarkerStyle = msCrossCirc end @@ -1033,7 +1033,7 @@ object Form1: TForm1 Top = 164 Width = 100 SelectedColor = 16119089 - HintFormat = 'A: %cieA B: %cieB'#13'Hex: %hex' + HintFormat = 'A: %cieA B: %cieB'#13'Hex: #%hex' TabOrder = 3 LValue = 88 AValue = -47 @@ -1045,7 +1045,7 @@ object Form1: TForm1 Top = 164 Width = 100 SelectedColor = 16515327 - HintFormat = 'L: %cieL B: %cieB'#13'Hex: %hex' + HintFormat = 'L: %cieL B: %cieB'#13'Hex: #%hex' TabOrder = 4 LValue = 60 AValue = 96 @@ -1058,7 +1058,7 @@ object Form1: TForm1 Top = 164 Width = 100 SelectedColor = 130823 - HintFormat = 'L: %cieL A: %cieA'#13'Hex: %hex' + HintFormat = 'L: %cieL A: %cieA'#13'Hex: #%hex' TabOrder = 5 LValue = 88 AValue = -88 @@ -1192,6 +1192,7 @@ object Form1: TForm1 Height = 19 Top = 371 Width = 62 + Anchors = [akLeft, akBottom] Caption = 'Enabled' Checked = True OnChange = CbEnabledChange diff --git a/components/mbColorLib/examples/fulldemo/main.pas b/components/mbColorLib/examples/fulldemo/main.pas index 2cbab1eb5..bce9cabf9 100644 --- a/components/mbColorLib/examples/fulldemo/main.pas +++ b/components/mbColorLib/examples/fulldemo/main.pas @@ -13,7 +13,7 @@ uses BColorPicker, GColorPicker, RColorPicker, KColorPicker, YColorPicker, MColorPicker, CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo, CIELColorPicker, BAxisColorPicker, GAxisColorPicker, RAxisColorPicker, - mbColorTree, mbColorList {for internet shortcuts}; + mbColorTree, mbColorList {for internet shortcuts}, mbBasicPicker; type @@ -107,6 +107,8 @@ type CbSwatchStyle: TCheckBox; procedure CbEnabledChange(Sender: TObject); procedure CbShowHintsChange(Sender: TObject); + procedure HColorPicker1GetHintStr(Sender: TObject; X, Y: Integer; + var AText: String); procedure PageControl1Change(Sender: TObject); procedure PageControl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); @@ -339,6 +341,12 @@ begin end; end; +procedure TForm1.HColorPicker1GetHintStr(Sender: TObject; X, Y: Integer; + var AText: String); +begin + AText := FormatHint(HColorPicker1.HintFormat, HColorPicker1.GetColorAtPoint(X, Y)); +end; + procedure TForm1.CheckBox1Click(Sender: TObject); begin HexaColorPicker1.SliderVisible := checkbox1.Checked; diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas index 3dc453bc0..6067156d2 100644 --- a/components/mbColorLib/mbBasicPicker.pas +++ b/components/mbColorLib/mbBasicPicker.pas @@ -15,24 +15,30 @@ uses type THintState = (hsOff, hsWaitingToShow, hsWaitingToHide); + TGetHintStrEvent = procedure (Sender: TObject; X, Y: Integer; var AText: String) of object; + { TmbBasicPicker } TmbBasicPicker = class(TCustomControl) private + FOnGetHintStr: TGetHintStrEvent; + { FHintWindow: THintWindow; FHintTimer: TTimer; FHintState: THintState; procedure HintTimer(Sender: TObject); + } protected FBufferBmp: TBitmap; FGradientWidth: Integer; FGradientHeight: Integer; FHintShown: Boolean; procedure CreateGradient; virtual; + function GetColorUnderCursor: TColor; virtual; function GetGradientColor(AValue: Integer): TColor; virtual; function GetGradientColor2D(X, Y: Integer): TColor; virtual; - function GetHintText: String; virtual; - procedure HideHintWindow; virtual; + function GetHintPos(X, Y: Integer): TPoint; virtual; + function GetHintStr(X, Y: Integer): String; virtual; procedure MouseLeave; override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; function MouseOnPicker(X, Y: Integer): Boolean; virtual; @@ -40,7 +46,7 @@ type procedure PaintParentBack(ACanvas: TCanvas); overload; procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload; procedure PaintParentBack(ABitmap: TBitmap); overload; - function ShowHintWindow(APoint: TPoint; AText: String): Boolean; virtual; + procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; {$IFDEF DELPHI} procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; @@ -48,9 +54,14 @@ type procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; // procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND; {$ENDIF} + property ColorUnderCursor: TColor read GetColorUnderCursor; + property OnGetHintStr: TGetHintStrEvent read FOnGetHintStr write FOnGetHintStr; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + function GetColorAtPoint(X, Y: Integer): TColor; virtual; + function GetHexColorAtPoint(X, Y: integer): string; + function GetHexColorUnderCursor: string; virtual; // function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; override; published property ParentColor default true; @@ -59,7 +70,8 @@ type implementation uses - LCLIntf, mbUtils; + LCLIntf, + HTMLColors, mbUtils; const HINT_SHOW_DELAY = 50; @@ -70,16 +82,43 @@ begin inherited Create(AOwner); // ControlStyle := ControlStyle - [csOpaque]; ParentColor := true; + { FHintTimer := TTimer.Create(self); FHintTimer.Interval := HINT_SHOW_DELAY; FHintTimer.Enabled := false; FHintTimer.OnTimer := @HintTimer; FHintState := hsOff; + } end; destructor TmbBasicPicker.Destroy; begin - HideHintWindow; + //HideHintWindow; + inherited; +end; + +procedure TmbBasicPicker.CMHintShow(var Message: TCMHintShow); +var + cp: TPoint; +begin + if GetColorUnderCursor <> clNone then + with TCMHintShow(Message) do + if not ShowHint then + Message.Result := 1 + else + if Hint <> '' then + Message.Result := 0 + else + begin + cp := HintInfo^.CursorPos; + HintInfo^.ReshowTimeout := 0; // must be zero! + HintInfo^.HideTimeout := Application.HintHidePause; + HintInfo^.HintStr := GetHintStr(cp.X, cp.Y); + HintInfo^.HintPos := ClientToScreen(GetHintPos(cp.X, cp.Y)); + HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1); + Result := 0; // 0 means: show hint + end; + inherited; end; @@ -98,6 +137,30 @@ procedure TmbBasicPicker.CreateGradient; begin // to be implemented by descendants end; + +function TmbBasicPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; // valid for most descendents +end; + +function TmbBasicPicker.GetColorUnderCursor: TColor; +var + P: TPoint; +begin + P := ScreenToClient(Mouse.CursorPos); + Result := GetColorAtPoint(P.X, P.Y); +end; + +function TmbBasicPicker.GetHexColorAtPoint(X, Y: integer): string; +begin + Result := ColorToHex(GetColorAtPoint(x, y)); +end; + +function TmbBasicPicker.GetHexColorUnderCursor: string; +begin + Result := ColorToHex(GetColorUnderCursor); +end; + { function TmbBasicPicker.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; begin @@ -114,6 +177,19 @@ begin Result := clNone; end; +function TmbBasicPicker.GetHintPos(X, Y: Integer): TPoint; +begin + Result := Point(X, Y); +end; + +function TmbBasicPicker.GetHintStr(X, Y: Integer): String; +begin + Result := ''; + if Assigned(FOnGetHintStr) then + FOnGetHintStr(Self, X, Y, Result); +end; + +(* function TmbBasicPicker.GetHintText: String; begin Result := Hint; @@ -135,18 +211,21 @@ begin HideHintWindow; end; end; - + *) procedure TmbBasicPicker.MouseLeave; begin inherited; + { HideHintWindow; FHintTimer.Enabled := false; FHintState := hsOff; + } end; procedure TmbBasicPicker.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; + { if ShowHint and not FHintShown then begin if MouseOnPicker(X, Y) then @@ -159,6 +238,7 @@ begin else HideHintWindow; end; + } end; function TmbBasicPicker.MouseOnPicker(X, Y: Integer): Boolean; @@ -245,7 +325,7 @@ begin Offscreen.Free; end; end; - + (* // Build and show the hint window function TmbBasicPicker.ShowHintWindow(APoint: TPoint; AText: String): Boolean; const @@ -283,6 +363,7 @@ begin Result := true; end; +*) (* !!!!!!!!!!!!!!!!! procedure TmbBasicPicker.WMEraseBkgnd( var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF} ); diff --git a/components/mbColorLib/mbColorPalette.pas b/components/mbColorLib/mbColorPalette.pas index f9915e3eb..78fe9ad90 100644 --- a/components/mbColorLib/mbColorPalette.pas +++ b/components/mbColorLib/mbColorPalette.pas @@ -74,6 +74,9 @@ type procedure DrawCell(ACanvas: TCanvas; AColor: string); procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer); procedure ColorsChange(Sender: TObject); + function GetColorUnderCursor: TColor; override; + function GetHintStr(X, Y: Integer): String; override; + function GetIndexUnderCursor: integer; procedure Resize; override; procedure SelectCell(i: integer); // procedure CreateWnd; override; @@ -103,11 +106,8 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function GetColorUnderCursor: TColor; function GetSelectedCellRect: TRect; - function GetIndexUnderCursor: integer; - - property ColorUnderCursor: TColor read GetColorUnderCursor; + property ColorUnderCursor; property VisibleRowCount: integer read FRowCount; property RowCount: integer read GetTotalRowCount; property ColCount: integer read FColCount; @@ -207,7 +207,7 @@ begin FColors := TStringList.Create; (FColors as TStringList).OnChange := ColorsChange; FTotalCells := 0; - FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: %hex'; + FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: #%hex'; FAutoHeight := false; FMinColors := 0; FMaxColors := 0; @@ -838,6 +838,22 @@ begin Result := mbStringToColor(FColors.Strings[FIndex]); end; +function TmbColorPalette.GetHintStr(X, Y: Integer): String; +var + idx: Integer; +begin + idx := GetIndexUnderCursor; + if FIndex < FNames.Count then + Result := FNames.Strings[FIndex] + else + if SameText(FColors.Strings[idx], 'clCustom') or + SameText(FColors.Strings[idx], 'clTransparent') + then + Result := StringReplace(FColors.Strings[idx], 'cl', '', [rfReplaceAll]) + else + Result := FormatHint(FHintFormat, ColorUnderCursor); +end; + function TmbColorPalette.GetIndexUnderCursor: integer; begin Result := -1; @@ -1009,21 +1025,15 @@ begin // show that we want a hint Result := 0; ReshowTimeout := 1; - HideTimeout := 5000; + HideTimeout := Application.HintHidePause; // was: 5000 clr := GetColorUnderCursor; //fire event Handled := false; if Assigned(FOnGetHintText) then FOnGetHintText(clr, GetIndexUnderCursor, HintStr, Handled); - if Handled then Exit; //do default - if FIndex < FNames.Count then - HintStr := FNames.Strings[FIndex] - else - if SameText(FColors.Strings[GetIndexUnderCursor], 'clCustom') or SameText(FColors.Strings[GetIndexUnderCursor], 'clTransparent') then - HintStr := StringReplace(FColors.Strings[GetIndexUnderCursor], 'cl', '', [rfReplaceAll]) - else - HintStr := FormatHint(FHintFormat, GetColorUnderCursor); + if not Handled then + HintStr := GetHintStr(CursorPos.X, CursorPos.Y); end; end; end; diff --git a/components/mbColorLib/mbColorPickerControl.pas b/components/mbColorLib/mbColorPickerControl.pas index 3347848a9..8f60c4f58 100644 --- a/components/mbColorLib/mbColorPickerControl.pas +++ b/components/mbColorLib/mbColorPickerControl.pas @@ -36,7 +36,9 @@ type mx, my, mdx, mdy: integer; FOnChange: TNotifyEvent; procedure CreateGradient; override; - function GetHintText: String; override; +// function GetColorAtPoint(x, y: integer): TColor; override; +// function GetHintText: String; override; + function GetHintStr(X, Y: Integer): String; override; function GetSelectedColor: TColor; virtual; procedure SetSelectedColor(C: TColor); virtual; procedure InternalDrawMarker(X, Y: Integer; C: TColor); @@ -59,11 +61,7 @@ type property OnChange: TNotifyEvent read FOnChange write FOnChange; public constructor Create(AOwner: TComponent); override; - function GetColorAtPoint(x, y: integer): TColor; dynamic; - function GetHexColorAtPoint(X, Y: integer): string; - function GetColorUnderCursor: TColor; - function GetHexColorUnderCursor: string; - property ColorUnderCursor: TColor read GetColorUnderCursor; + property ColorUnderCursor; property Manual: boolean read FManual; published property SelectedColor: TColor read GetSelectedColor write SetSelectedColor; @@ -92,6 +90,7 @@ type property DragKind; property Constraints; property OnContextPopup; + property OnGetHintStr; property OnMouseDown; property OnMouseMove; property OnMouseUp; @@ -210,11 +209,11 @@ begin end; {$ENDIF} end; - + (* function TmbCustomPicker.GetHintText: String; begin Result := FormatHint(FHintFormat, GetColorUnderCursor) -end; +end; *) function TmbCustomPicker.GetSelectedColor: TColor; begin @@ -227,26 +226,6 @@ begin //handled in descendents end; -function TmbCustomPicker.GetColorAtPoint(x, y: integer): TColor; -begin - Result := Canvas.Pixels[x, y]; // valid for most descendents -end; - -function TmbCustomPicker.GetHexColorAtPoint(X, Y: integer): string; -begin - Result := ColorToHex(GetColorAtPoint(x, y)); -end; - -function TmbCustomPicker.GetColorUnderCursor: TColor; -begin - Result := GetColorAtPoint(mx, my); -end; - -function TmbCustomPicker.GetHexColorUnderCursor: string; -begin - Result := ColorToHex(GetColorAtPoint(mx, my)); -end; - procedure TmbCustomPicker.InternalDrawMarker(X, Y: Integer; C: TColor); begin case MarkerStyle of @@ -256,24 +235,41 @@ begin msCrossCirc : DrawSelCrossCirc(x, y, Canvas, c); end; end; - (* + +function TmbCustomPicker.GetHintStr(X, Y: Integer): String; +begin + Result := FormatHint(FHintFormat, GetColorUnderCursor); +end; + + (* procedure TmbCustomPicker.CMHintShow(var Message: TCMHintShow); +var + cp: TPoint; begin if GetColorUnderCursor <> clNone then with TCMHintShow(Message) do if not ShowHint then Message.Result := 1 else + begin + cp := HintInfo^.CursorPos; + HintInfo^.ReshowTimeout := 0; // was: 1 + HintInfo^.HideTimeout := Application.HintHidePause; // was: 5000 + HintInfo^.HintStr := FormatHint(FHintFormat, GetColorUnderCursor); + HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1); + Result := 0; // 0 means: show hint + end; +{ with HintInfo^ do begin Result := 0; ReshowTimeout := 1; HideTimeout := 5000; HintStr := FormatHint(FHintFormat, GetColorUnderCursor);; - end; + end; } inherited; -end; *) - +end; + *) procedure TmbCustomPicker.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; diff --git a/components/mbColorLib/mbColorTree.pas b/components/mbColorLib/mbColorTree.pas index 04f028eef..536e909fe 100644 --- a/components/mbColorLib/mbColorTree.pas +++ b/components/mbColorLib/mbColorTree.pas @@ -10,7 +10,7 @@ interface uses {$IFDEF FPC} - LCLIntf, LCLType, LMessages, + LCLIntf, LCLType, {$ELSE} Windows, Messages, {$ENDIF} diff --git a/components/mbColorLib/mbTrackBarPicker.pas b/components/mbColorLib/mbTrackBarPicker.pas index 84cd5789a..7517bcdaa 100644 --- a/components/mbColorLib/mbTrackBarPicker.pas +++ b/components/mbColorLib/mbTrackBarPicker.pas @@ -40,6 +40,8 @@ type TSliderPlacement = (spBefore, spAfter, spBoth); TSelIndicator = (siArrows, siRect); + { TmbTrackBarPicker } + TmbTrackBarPicker = class(TmbBasicPicker) private mx, my: integer; @@ -85,15 +87,15 @@ type procedure CreateWnd; override; procedure Execute(tbaAction: integer); dynamic; function GetArrowPos: integer; dynamic; - function GetHintText: string; override; +// function GetColorUnderCursor: TColor; override; + function GetHintPos(X, Y: Integer): TPoint; override; + function GetHintStr(X, Y: Integer): String; override; function GetSelectedValue: integer; virtual; abstract; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseLeave; override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; function MouseOnPicker(X, Y: Integer): Boolean; override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - function ShowHintWindow(APoint: TPoint; AText: String): Boolean; override; -// procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); {$IFDEF DELPHI} @@ -143,6 +145,7 @@ type property Constraints; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnContextPopup; + property OnGetHintStr; property OnMouseDown; property OnMouseMove; property OnMouseUp; @@ -762,18 +765,63 @@ begin if not FInherited and Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; - (* + +function TmbTrackBarPicker.GetHintPos(X, Y: Integer): TPoint; +begin + case FLayout of + lyHorizontal: + Result := Point(X - 8, Height + 2); + lyVertical: + Result := Point(Width + 2, Y - 8); + end; +end; + +function TmbTrackBarPicker.GetHintStr(X, Y: Integer): string; +begin + Result := inherited GetHintStr(X, Y); + if Result = '' then + Result := ReplaceFlags(FHintFormat, ['%value', '%h', '%s', '%l', '%v', '%c', + '%m', '%y', '%k', '%r', '%g', '%b'], GetSelectedValue); +end; + (* procedure TmbTrackBarPicker.CMHintShow(var Message: TCMHintShow); +var + cp: TPoint; begin with TCMHintShow(Message) do if not ShowHint then - Message.Result := 1 + Message.Result := 1 // 1 means: hide hint else + begin + cp := HintInfo^.CursorPos; + HintInfo^.ReshowTimeout := 0; // was: 1 + HintInfo^.HideTimeout := Application.HintHidePause; // was: 5000 + HintInfo + case FLayout of + lyHorizontal: + HintInfo^.HintPos := ClientToScreen(Point(cp.X - 8, Height + 2)); + lyVertical: + HintInfo^.HintPos := ClientToScreen(Point(Width +2, cp.Y - 8)); + end; + HintInfo^.HintStr := GetHintStr; + HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1); + Result := 0; // 0 means: show hint + end; + inherited; +end; *) + +{ + with HintInfo^ do begin + if HintControl <> self then + begin + Message.Result := -1; + exit; + end; Result := 0; ReshowTimeout := 1; - HideTimeout := 5000; + HideTimeout := 0; //5000; if FLayout = lyHorizontal then HintPos := ClientToScreen(Point(CursorPos.X - 8, Height + 2)) else @@ -781,8 +829,8 @@ begin HintStr := GetHintStr; end; inherited; -end; *) - +end; + } procedure TmbTrackBarPicker.CMGotFocus( var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF}); begin @@ -885,11 +933,12 @@ begin //handled in descendants end; + (* function TmbTrackBarPicker.GetHintText: string; begin Result := ReplaceFlags(FHintFormat, ['%value', '%h', '%s', '%l', '%v', '%c', '%m', '%y', '%k', '%r', '%g', '%b'], GetSelectedValue); -end; +end; *) procedure TmbTrackBarPicker.SetBevelInner(Value: TBevelCut); begin @@ -927,11 +976,12 @@ begin end; end; +(* function TmbTrackbarPicker.ShowHintWindow(APoint: TPoint; AText: String): Boolean; begin Result := inherited; if Result then FHintShown := true; end; - + *) end.