You've already forked lazarus-ccr
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:
@ -65,7 +65,7 @@ begin
|
||||
FChange := false;
|
||||
Layout := lyVertical;
|
||||
SetBlue(255);
|
||||
HintFormat := 'Blue: %value';
|
||||
HintFormat := 'Blue: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -63,7 +63,7 @@ begin
|
||||
FChange := false;
|
||||
Layout := lyVertical;
|
||||
SetCyan(255);
|
||||
HintFormat := 'Cyan: %value';
|
||||
HintFormat := 'Selected cyan value: %value';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -58,7 +58,7 @@ begin
|
||||
FChange := false;
|
||||
Layout := lyVertical;
|
||||
SetGreen(255);
|
||||
HintFormat := 'Green: %value';
|
||||
HintFormat := 'Green: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -58,7 +58,7 @@ begin
|
||||
FArrowPos := ArrowPosFromHue(0);
|
||||
FChange := false;
|
||||
SetHue(0);
|
||||
HintFormat := 'Hue: %value';
|
||||
HintFormat := 'Hue: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -45,6 +45,7 @@ type
|
||||
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;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
|
||||
message CN_KEYDOWN;
|
||||
@ -87,6 +88,7 @@ begin
|
||||
FChange := true;
|
||||
FRadius := 40;
|
||||
FDoChange := false;
|
||||
HintFormat := 'Hue: %h (selected)';
|
||||
end;
|
||||
|
||||
procedure THRingPicker.CreateGradient;
|
||||
@ -336,6 +338,18 @@ begin
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
function THRingPicker.MouseOnPicker(X, Y: Integer): Boolean;
|
||||
var
|
||||
diameter, r: Integer;
|
||||
P, ctr: TPoint;
|
||||
begin
|
||||
diameter := Min(Width, Height);
|
||||
r := diameter div 2; // outer radius
|
||||
P := Point(x, y);
|
||||
ctr := Point(r, r);
|
||||
Result := PtInCircle(P, ctr, r) and not PtInCircle(P, ctr, Radius);
|
||||
end;
|
||||
|
||||
procedure THRingPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
|
@ -128,13 +128,14 @@ begin
|
||||
FLCursor := crDefault;
|
||||
with FHSPicker do
|
||||
begin
|
||||
SetInitialBounds(0, 6, 174, 134);
|
||||
{
|
||||
Height := 134;
|
||||
Width := 174;
|
||||
Top := 6;
|
||||
{$IFDEF DELPHI}
|
||||
Left := 0;
|
||||
}
|
||||
Top := 6;
|
||||
Width := 174;
|
||||
Height := 134;
|
||||
{$ELSE}
|
||||
SetInitialBounds(0, 6, 174, 134);
|
||||
{$ENDIF}
|
||||
Anchors := [akLeft, akTop, akRight, akBottom];
|
||||
Visible := true;
|
||||
OnChange := HSPickerChange;
|
||||
@ -145,12 +146,14 @@ begin
|
||||
with FLPicker do
|
||||
begin
|
||||
Layout := lyVertical;
|
||||
SetInitialBounds(184, 0, 25, 146);
|
||||
{
|
||||
Height := 146;
|
||||
Top := 0;
|
||||
{$IFDEF DELPHI}
|
||||
Left := 184;
|
||||
}
|
||||
Top := 0;
|
||||
Width := 25;
|
||||
Height := 146;
|
||||
{$ELSE}
|
||||
SetInitialBounds(184, 0, 25, 146);
|
||||
{$ENDIF}
|
||||
Anchors := [akRight, akTop, akBottom];
|
||||
Visible := true;
|
||||
OnChange := LPickerChange;
|
||||
|
@ -51,6 +51,7 @@ type
|
||||
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;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
|
||||
message CN_KEYDOWN;
|
||||
@ -417,6 +418,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function THSVColorPicker.MouseOnPicker(X, Y: Integer): Boolean;
|
||||
var
|
||||
diameter, r: Integer;
|
||||
P, ctr: TPoint;
|
||||
begin
|
||||
diameter := Min(Width, Height);
|
||||
r := diameter div 2;
|
||||
P := Point(x, y);
|
||||
ctr := Point(r, r);
|
||||
Result := PtInCircle(P, ctr, r);
|
||||
end;
|
||||
|
||||
function THSVColorPicker.GetSelectedColor: TColor;
|
||||
begin
|
||||
if FSelectedColor <> clNone then
|
||||
|
@ -63,7 +63,7 @@ begin
|
||||
FChange := false;
|
||||
Layout := lyVertical;
|
||||
SetBlack(255);
|
||||
HintFormat := 'Black: %value';
|
||||
HintFormat := 'Black: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -57,7 +57,7 @@ begin
|
||||
FArrowPos := ArrowPosFromLum(MaxLum div 2);
|
||||
FChange := false;
|
||||
SetLuminance(MaxLum div 2);
|
||||
HintFormat := 'Luminance: %value';
|
||||
HintFormat := 'Luminance: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -63,7 +63,7 @@ begin
|
||||
FChange := false;
|
||||
Layout := lyVertical;
|
||||
SetMagenta(255);
|
||||
HintFormat := 'Magenta: %value';
|
||||
HintFormat := 'Magenta: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -65,7 +65,7 @@ begin
|
||||
FChange := false;
|
||||
Layout := lyVertical;
|
||||
SetRed(255);
|
||||
HintFormat := 'Red: %value';
|
||||
HintFormat := 'Red: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -58,7 +58,7 @@ begin
|
||||
FArrowPos := ArrowPosFromSat(0);
|
||||
FChange := false;
|
||||
SetSat(255);
|
||||
HintFormat := 'Saturation: %value';
|
||||
HintFormat := 'Saturation: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -54,7 +54,7 @@ begin
|
||||
FArrowPos := ArrowPosFromVal(255);
|
||||
FChange := false;
|
||||
SetValue(255);
|
||||
HintFormat := 'Value: %value';
|
||||
HintFormat := 'Value: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -64,7 +64,7 @@ begin
|
||||
FChange := false;
|
||||
Layout := lyVertical;
|
||||
SetYellow(255);
|
||||
HintFormat := 'Yellow: %value';
|
||||
HintFormat := 'Yellow: %value (selected)';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
@ -42,9 +42,9 @@ object Form1: TForm1
|
||||
Height = 331
|
||||
Top = 6
|
||||
Width = 399
|
||||
ActivePage = TabSheet1
|
||||
ActivePage = TabSheet8
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
TabIndex = 0
|
||||
TabIndex = 8
|
||||
TabOrder = 0
|
||||
OnMouseMove = PageControl1MouseMove
|
||||
object TabSheet1: TTabSheet
|
||||
@ -56,7 +56,7 @@ object Form1: TForm1
|
||||
Height = 287
|
||||
Top = 8
|
||||
Width = 377
|
||||
SelectedColor = 424966
|
||||
SelectedColor = 422918
|
||||
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
|
||||
LPickerHintFormat = 'Luminance: %l'
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
@ -218,7 +218,7 @@ object Form1: TForm1
|
||||
Left = 0
|
||||
Height = 234
|
||||
Top = 0
|
||||
Width = 364
|
||||
Width = 360
|
||||
Align = alTop
|
||||
Colors.Strings = (
|
||||
'clBlack'
|
||||
@ -605,7 +605,7 @@ object Form1: TForm1
|
||||
Height = 302
|
||||
Top = 2
|
||||
Width = 22
|
||||
HintFormat = 'Value: %v'
|
||||
HintFormat = 'Value: %v (selected)'
|
||||
Layout = lyVertical
|
||||
NewArrowStyle = True
|
||||
Anchors = [akTop, akRight, akBottom]
|
||||
@ -624,7 +624,7 @@ object Form1: TForm1
|
||||
Height = 291
|
||||
Top = 6
|
||||
Width = 381
|
||||
HPickerHintFormat = 'Hue: %h'
|
||||
HPickerHintFormat = 'Hue: %h (selected)'
|
||||
SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
TabOrder = 0
|
||||
@ -702,7 +702,7 @@ object Form1: TForm1
|
||||
Height = 25
|
||||
Top = 192
|
||||
Width = 343
|
||||
HintFormat = 'Luminance: %l'
|
||||
HintFormat = 'Luminance: %l (selected)'
|
||||
SelectionIndicator = siRect
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
TabOrder = 2
|
||||
@ -715,7 +715,7 @@ object Form1: TForm1
|
||||
Height = 21
|
||||
Top = 160
|
||||
Width = 343
|
||||
HintFormat = 'Value: %v'
|
||||
HintFormat = 'Value: %v (selected)'
|
||||
ArrowPlacement = spBefore
|
||||
NewArrowStyle = True
|
||||
SelectionIndicator = siRect
|
||||
@ -731,7 +731,7 @@ object Form1: TForm1
|
||||
Height = 61
|
||||
Top = 231
|
||||
Width = 343
|
||||
HintFormat = 'Hue: %h'
|
||||
HintFormat = 'Hue: %h (selected)'
|
||||
Increment = 5
|
||||
ArrowPlacement = spBoth
|
||||
SelectionIndicator = siRect
|
||||
@ -745,7 +745,7 @@ object Form1: TForm1
|
||||
Height = 222
|
||||
Top = 70
|
||||
Width = 19
|
||||
HintFormat = 'Saturation: %s'
|
||||
HintFormat = 'Saturation: %s (selected)'
|
||||
Layout = lyVertical
|
||||
ArrowPlacement = spBefore
|
||||
NewArrowStyle = True
|
||||
@ -805,8 +805,8 @@ object Form1: TForm1
|
||||
end
|
||||
object TabSheet8: TTabSheet
|
||||
Caption = 'Other'
|
||||
ClientHeight = 292
|
||||
ClientWidth = 372
|
||||
ClientHeight = 303
|
||||
ClientWidth = 391
|
||||
ImageIndex = 7
|
||||
object HSColorPicker1: THSColorPicker
|
||||
Left = 6
|
||||
@ -837,7 +837,7 @@ object Form1: TForm1
|
||||
Height = 130
|
||||
Top = 164
|
||||
Width = 133
|
||||
HintFormat = 'Hue: %h'
|
||||
HintFormat = 'Hue: %h (selected)'
|
||||
TabOrder = 2
|
||||
OnMouseMove = HRingPicker1MouseMove
|
||||
OnChange = HRingPicker1Change
|
||||
@ -861,7 +861,7 @@ object Form1: TForm1
|
||||
Height = 267
|
||||
Top = 18
|
||||
Width = 22
|
||||
HintFormat = 'Cyan: %c'
|
||||
HintFormat = 'Cyan: %c (selected)'
|
||||
TabOrder = 0
|
||||
SelectedColor = clAqua
|
||||
end
|
||||
@ -870,7 +870,7 @@ object Form1: TForm1
|
||||
Height = 267
|
||||
Top = 18
|
||||
Width = 22
|
||||
HintFormat = 'Magenta: %m'
|
||||
HintFormat = 'Magenta: %m (selected)'
|
||||
ArrowPlacement = spBefore
|
||||
TabOrder = 1
|
||||
SelectedColor = clFuchsia
|
||||
@ -880,7 +880,7 @@ object Form1: TForm1
|
||||
Height = 267
|
||||
Top = 19
|
||||
Width = 31
|
||||
HintFormat = 'Yellow: %y'
|
||||
HintFormat = 'Yellow: %y (selected)'
|
||||
ArrowPlacement = spBoth
|
||||
TabOrder = 2
|
||||
SelectedColor = clYellow
|
||||
@ -890,7 +890,7 @@ object Form1: TForm1
|
||||
Height = 267
|
||||
Top = 18
|
||||
Width = 22
|
||||
HintFormat = 'Black: %k'
|
||||
HintFormat = 'Black: %k (selected)'
|
||||
NewArrowStyle = True
|
||||
TabOrder = 3
|
||||
Cyan = 0
|
||||
@ -902,7 +902,7 @@ object Form1: TForm1
|
||||
Height = 268
|
||||
Top = 18
|
||||
Width = 22
|
||||
HintFormat = 'Red: %r'
|
||||
HintFormat = 'Red: %r (selected)'
|
||||
ArrowPlacement = spBefore
|
||||
NewArrowStyle = True
|
||||
TabOrder = 4
|
||||
@ -913,7 +913,7 @@ object Form1: TForm1
|
||||
Height = 268
|
||||
Top = 18
|
||||
Width = 34
|
||||
HintFormat = 'Green: %g'
|
||||
HintFormat = 'Green: %g (selected)'
|
||||
ArrowPlacement = spBoth
|
||||
NewArrowStyle = True
|
||||
TabOrder = 5
|
||||
@ -924,7 +924,7 @@ object Form1: TForm1
|
||||
Height = 268
|
||||
Top = 18
|
||||
Width = 22
|
||||
HintFormat = 'Blue: %b'
|
||||
HintFormat = 'Blue: %b (selected)'
|
||||
SelectionIndicator = siRect
|
||||
TabOrder = 6
|
||||
SelectedColor = 16743034
|
||||
@ -937,7 +937,7 @@ object Form1: TForm1
|
||||
BevelInner = bvRaised
|
||||
BevelOuter = bvRaised
|
||||
BorderStyle = bsSingle
|
||||
HintFormat = 'Black: %k'
|
||||
HintFormat = 'Black: %k (selected)'
|
||||
ArrowPlacement = spBoth
|
||||
NewArrowStyle = True
|
||||
TabOrder = 7
|
||||
@ -953,7 +953,7 @@ object Form1: TForm1
|
||||
BevelInner = bvLowered
|
||||
BevelOuter = bvRaised
|
||||
BorderStyle = bsSingle
|
||||
HintFormat = 'Magenta: %m'
|
||||
HintFormat = 'Magenta: %m (selected)'
|
||||
Layout = lyHorizontal
|
||||
ArrowPlacement = spBoth
|
||||
NewArrowStyle = True
|
||||
@ -968,7 +968,7 @@ object Form1: TForm1
|
||||
BevelInner = bvRaised
|
||||
BevelOuter = bvLowered
|
||||
BorderStyle = bsSingle
|
||||
HintFormat = 'Cyan: %c'
|
||||
HintFormat = 'Cyan: %c (selected)'
|
||||
ArrowPlacement = spBoth
|
||||
NewArrowStyle = True
|
||||
TabOrder = 9
|
||||
@ -982,7 +982,7 @@ object Form1: TForm1
|
||||
BevelInner = bvLowered
|
||||
BevelOuter = bvLowered
|
||||
BorderStyle = bsSingle
|
||||
HintFormat = 'Yellow: %y'
|
||||
HintFormat = 'Yellow: %y (selected)'
|
||||
ArrowPlacement = spBoth
|
||||
NewArrowStyle = True
|
||||
TabOrder = 10
|
||||
|
@ -10,23 +10,36 @@ uses
|
||||
{$ELSE}
|
||||
Messages,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, Graphics, Controls;
|
||||
Classes, SysUtils, Graphics, Controls, ExtCtrls, Forms;
|
||||
|
||||
type
|
||||
THintState = (hsOff, hsWaitingToShow, hsWaitingToHide);
|
||||
|
||||
{ TmbBasicPicker }
|
||||
|
||||
TmbBasicPicker = class(TCustomControl)
|
||||
private
|
||||
FHintWindow: THintWindow;
|
||||
FHintTimer: TTimer;
|
||||
FHintState: THintState;
|
||||
procedure HintTimer(Sender: TObject);
|
||||
protected
|
||||
FGradientBmp: TBitmap;
|
||||
FGradientWidth: Integer;
|
||||
FGradientHeight: Integer;
|
||||
FHintShown: Boolean;
|
||||
procedure CreateGradient; virtual;
|
||||
function GetGradientColor(AValue: Integer): TColor; virtual;
|
||||
function GetGradientColor2D(X, Y: Integer): TColor; virtual;
|
||||
function GetHintText: String; virtual;
|
||||
procedure HideHintWindow; virtual;
|
||||
procedure MouseLeave; override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
function MouseOnPicker(X, Y: Integer): Boolean; virtual;
|
||||
procedure PaintParentBack; virtual; overload;
|
||||
procedure PaintParentBack(ACanvas: TCanvas); overload;
|
||||
procedure PaintParentBack(ABitmap: TBitmap); overload;
|
||||
function ShowHintWindow(APoint: TPoint; AText: String): Boolean; virtual;
|
||||
{$IFDEF DELPHI}
|
||||
procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
|
||||
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
||||
@ -36,6 +49,7 @@ type
|
||||
{$ENDIF}
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; override;
|
||||
published
|
||||
property ParentColor default true;
|
||||
@ -43,11 +57,29 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLIntf;
|
||||
|
||||
const
|
||||
HINT_SHOW_DELAY = 50;
|
||||
HINT_HIDE_DELAY = 3000;
|
||||
|
||||
constructor TmbBasicPicker.Create(AOwner: TComponent);
|
||||
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;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.CMParentColorChanged(var Message: TLMessage);
|
||||
@ -79,6 +111,58 @@ begin
|
||||
Result := clNone;
|
||||
end;
|
||||
|
||||
function TmbBasicPicker.GetHintText: String;
|
||||
begin
|
||||
Result := Hint;
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.HideHintWindow;
|
||||
begin
|
||||
FHintTimer.Enabled := false;
|
||||
FHintState := hsOff;
|
||||
FreeAndNil(FHintWindow);
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.HintTimer(Sender: TObject);
|
||||
begin
|
||||
case FHintState of
|
||||
hsWaitingToShow:
|
||||
ShowHintWindow(Mouse.CursorPos, GetHintText);
|
||||
hsWaitingToHide:
|
||||
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 //and not FHintShown then
|
||||
begin
|
||||
FHintTimer.Enabled := false;
|
||||
FHintState := hsWaitingToShow;
|
||||
FHintTimer.Interval := HINT_SHOW_DELAY;
|
||||
FHintTimer.Enabled := true;
|
||||
end
|
||||
else
|
||||
HideHintWindow;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TmbBasicPicker.MouseOnPicker(X, Y: Integer): Boolean;
|
||||
begin
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.PaintParentBack;
|
||||
begin
|
||||
PaintParentBack(Canvas);
|
||||
@ -123,6 +207,44 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// Build and show the hint window
|
||||
function TmbBasicPicker.ShowHintWindow(APoint: TPoint; AText: String): Boolean;
|
||||
const
|
||||
MAXWIDTH = 400;
|
||||
var
|
||||
RScr, RHint, R: TRect;
|
||||
begin
|
||||
FHintTimer.Enabled := false;
|
||||
|
||||
if AText = '' then
|
||||
begin
|
||||
HideHintWindow;
|
||||
exit(false);
|
||||
end;
|
||||
|
||||
if FHintWindow = nil then
|
||||
FHintWindow := THintWindow.Create(nil);
|
||||
RScr := Screen.WorkAreaRect;
|
||||
RHint := FHintWindow.CalcHintRect(MAXWIDTH, AText, nil);
|
||||
OffsetRect(RHint, APoint.X, APoint.Y);
|
||||
OffsetRect(RHint, 0, -(RHint.Bottom - RHint.Top));
|
||||
R := RHint;
|
||||
if R.Left < RScr.Left then
|
||||
R := RHint;
|
||||
RHint := R;
|
||||
if (R.Bottom > RScr.Bottom) then begin
|
||||
R := RHint;
|
||||
OffsetRect(R, 0, R.Bottom - RScr.Bottom);
|
||||
end;
|
||||
FHintWindow.ActivateHint(R, AText);
|
||||
|
||||
FHintState := hsWaitingToHide;
|
||||
FHintTimer.Interval := HINT_HIDE_DELAY;
|
||||
FHintTimer.Enabled := true;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.WMEraseBkgnd(
|
||||
var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF} );
|
||||
begin
|
||||
|
@ -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
|
||||
|
@ -84,12 +84,15 @@ type
|
||||
procedure CreateWnd; override;
|
||||
procedure Execute(tbaAction: integer); dynamic;
|
||||
function GetArrowPos: integer; dynamic;
|
||||
function GetHintStr: string;
|
||||
function GetHintText: 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;
|
||||
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
|
||||
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}
|
||||
@ -597,6 +600,12 @@ begin
|
||||
Result := pos;
|
||||
end;
|
||||
|
||||
procedure TmbTrackBarPicker.MouseLeave;
|
||||
begin
|
||||
inherited;
|
||||
FHintShown := false;
|
||||
end;
|
||||
|
||||
procedure TmbTrackBarPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
R: TRect;
|
||||
@ -623,6 +632,11 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TmbTrackBarPicker.MouseOnPicker(X, Y: Integer): Boolean;
|
||||
begin
|
||||
Result := PtInRect(FPickRect, Point(X, Y));
|
||||
end;
|
||||
|
||||
procedure TmbTrackBarPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if Button <> mbLeft then Exit;
|
||||
@ -742,7 +756,7 @@ begin
|
||||
if not FInherited and Assigned(OnKeyDown) then
|
||||
OnKeyDown(Self, Message.CharCode, Shift);
|
||||
end;
|
||||
|
||||
(*
|
||||
procedure TmbTrackBarPicker.CMHintShow(var Message: TCMHintShow);
|
||||
begin
|
||||
with TCMHintShow(Message) do
|
||||
@ -761,7 +775,7 @@ begin
|
||||
HintStr := GetHintStr;
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
end; *)
|
||||
|
||||
procedure TmbTrackBarPicker.CMGotFocus(
|
||||
var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF});
|
||||
@ -865,7 +879,7 @@ begin
|
||||
//handled in descendants
|
||||
end;
|
||||
|
||||
function TmbTrackBarPicker.GetHintStr: string;
|
||||
function TmbTrackBarPicker.GetHintText: string;
|
||||
begin
|
||||
Result := ReplaceFlags(FHintFormat, ['%value', '%h', '%s', '%l', '%v', '%c',
|
||||
'%m', '%y', '%k', '%r', '%g', '%b'], GetSelectedValue);
|
||||
@ -907,4 +921,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TmbTrackbarPicker.ShowHintWindow(APoint: TPoint; AText: String): Boolean;
|
||||
begin
|
||||
Result := inherited;
|
||||
if Result then
|
||||
FHintShown := true;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -9,6 +9,7 @@ uses
|
||||
|
||||
procedure Clamp(var AValue:Integer; AMin, AMax: Integer);
|
||||
function PointInCircle(p: TPoint; Size: integer): boolean;
|
||||
function PtInCircle(p, ctr: TPoint; Radius: Integer): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
@ -26,6 +27,11 @@ begin
|
||||
Result := (sqr(p.x - r) + sqr(p.y - r) <= sqr(r));
|
||||
end;
|
||||
|
||||
function PtInCircle(p, ctr: TPoint; Radius: Integer): Boolean;
|
||||
begin
|
||||
Result := sqr(p.x - ctr.x) + sqr(p.y - ctr.y) <= sqr(Radius);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
Reference in New Issue
Block a user