mbColorLib: Improved handling of hints.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5464 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-12 12:51:46 +00:00
parent cecf6d3ca1
commit 5221fae91e
19 changed files with 242 additions and 55 deletions

View File

@@ -21,6 +21,8 @@ uses
type
TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc);
{ TmbCustomPicker }
TmbCustomPicker = class(TmbBasicPicker)
private
FHintFormat: string;
@@ -34,6 +36,7 @@ type
mx, my, mdx, mdy: integer;
FOnChange: TNotifyEvent;
procedure CreateGradient; override;
function GetHintText: String; override;
function GetSelectedColor: TColor; virtual;
procedure SetSelectedColor(C: TColor); virtual;
procedure InternalDrawMarker(X, Y: Integer; C: TColor);
@@ -42,7 +45,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure CreateWnd; override;
procedure WebSafeChanged; dynamic;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
// procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
{$IFDEF DELPHI}
procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER;
procedure CMLostFocus(var Message: TCMLostFocus); message CM_EXIT;
@@ -208,6 +211,11 @@ begin
{$ENDIF}
end;
function TmbCustomPicker.GetHintText: String;
begin
Result := FormatHint(FHintFormat, GetColorUnderCursor)
end;
function TmbCustomPicker.GetSelectedColor: TColor;
begin
Result := FSelected; // valid for most descendents
@@ -248,7 +256,7 @@ begin
msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
end;
end;
(*
procedure TmbCustomPicker.CMHintShow(var Message: TCMHintShow);
begin
if GetColorUnderCursor <> clNone then
@@ -264,7 +272,7 @@ begin
HintStr := FormatHint(FHintFormat, GetColorUnderCursor);;
end;
inherited;
end;
end; *)
procedure TmbCustomPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin