mbColorLib: Fix mouse wheel events of TmbTrackbar descendents being shown in Object Inspector as not assigned.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5546 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-19 23:28:29 +00:00
parent 2cf4c24eb5
commit 6b7ac652ec
3 changed files with 47 additions and 17 deletions

View File

@ -55,14 +55,14 @@ type
procedure SetSLCursor(c: TCursor);
protected
procedure CreateWnd; override;
procedure Paint; override;
procedure DoChange;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
procedure RingPickerChange(Sender: TObject);
procedure SLPickerChange(Sender: TObject);
procedure DoChange;
procedure Paint; override;
procedure Resize; override;
procedure RingPickerChange(Sender: TObject);
procedure SetFocus; override;
procedure SLPickerChange(Sender: TObject);
(*
{$IFDEF DELPHI}
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;

View File

@ -43,9 +43,9 @@ object Form1: TForm1
Height = 384
Top = 6
Width = 403
ActivePage = TabSheet5
ActivePage = TabSheet1
Anchors = [akTop, akLeft, akRight, akBottom]
TabIndex = 4
TabIndex = 0
TabOrder = 0
OnChange = PageControl1Change
OnMouseMove = PageControl1MouseMove
@ -721,8 +721,8 @@ object Form1: TForm1
TabOrder = 2
Hue = 0
Saturation = 0
Luminance = 240
SelectedColor = 6579300
Luminance = 94
SelectedColor = 6184542
end
object VColorPicker1: TVColorPicker
Left = 34
@ -844,7 +844,7 @@ object Form1: TForm1
Height = 147
Top = 144
Width = 161
SelectedColor = 2763306
SelectedColor = 6579300
HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex'
TabOrder = 1
OnMouseMove = SLColorPicker1MouseMove
@ -920,8 +920,8 @@ object Form1: TForm1
NewArrowStyle = True
TabOrder = 3
Cyan = 0
Black = 255
SelectedColor = clBlack
Black = 1
SelectedColor = 16711422
end
object RColorPicker1: TRColorPicker
Left = 150
@ -932,6 +932,8 @@ object Form1: TForm1
ArrowPlacement = spBefore
NewArrowStyle = True
TabOrder = 4
Green = 122
Blue = 122
SelectedColor = 8026879
end
object GColorPicker1: TGColorPicker
@ -943,6 +945,8 @@ object Form1: TForm1
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 5
Red = 122
Blue = 122
SelectedColor = 8060794
end
object BColorPicker1: TBColorPicker
@ -953,6 +957,8 @@ object Form1: TForm1
HintFormat = 'Blue: %b (selected)'
SelectionIndicator = siRect
TabOrder = 6
Red = 122
Green = 122
SelectedColor = 16743034
end
object KColorPicker2: TKColorPicker
@ -968,8 +974,8 @@ object Form1: TForm1
NewArrowStyle = True
TabOrder = 7
Cyan = 0
Black = 255
SelectedColor = clBlack
Black = 1
SelectedColor = 16711422
end
object MColorPicker2: TMColorPicker
Left = 272
@ -1253,7 +1259,7 @@ object Form1: TForm1
Height = 19
Top = 371
Width = 62
Anchors = [akRight, akBottom]
Anchors = [akTop, akRight]
Caption = 'Enabled'
Checked = True
OnChange = CbEnabledChange

View File

@ -80,6 +80,8 @@ type
FLimit: integer;
FBack: TBitmap;
procedure CreateGradient; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure Paint; override;
// procedure PaintParentBack;
procedure DrawFrames; dynamic;
@ -97,8 +99,10 @@ type
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
// function MouseOnPicker(X, Y: Integer): Boolean;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
{
procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
}
{$IFDEF DELPHI}
// procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER;
@ -218,8 +222,8 @@ begin
FIncrement := 1;
FArrowPos := GetArrowPos;
FHintFormat := '';
OnMouseWheelUp := WheelUp;
OnMouseWheelDown := WheelDown;
// OnMouseWheelUp := WheelUp;
// OnMouseWheelDown := WheelDown;
FManual := false;
FChange := true;
FLayout := lyHorizontal;
@ -917,6 +921,25 @@ begin
Invalidate;
end;
function TmbTrackbarPicker.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if not Result then
begin
Result := True;
FChange := false;
if WheelDelta > 0 then
Execute(TBA_WheelUp)
else
Execute(TBA_WheelDown);
FManual := true;
FChange := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
(*
procedure TmbTrackBarPicker.WheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
@ -936,7 +959,8 @@ begin
FManual := true;
FChange := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
end; *)
{ IMPORTANT: If pickers are created at designtime the layout must be set before
defining the picker width and height because changing the layout will flip the