From 32710fa5af0dcd34cdcdc7609509b1e2995537b6 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 19 Dec 2016 21:36:01 +0000 Subject: [PATCH] mbColorLib: Fix keyboard handling of all colorLib components (arrow keys stay within control and don't focus next control any more). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5541 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/mbColorLib/BAxisColorPicker.pas | 137 +++++++++---- components/mbColorLib/CIEAColorPicker.pas | 191 ++++++++--------- components/mbColorLib/CIEBColorPicker.pas | 192 ++++++++--------- components/mbColorLib/CIELColorPicker.pas | 193 ++++++++---------- components/mbColorLib/GAxisColorPicker.pas | 126 +++++++++--- components/mbColorLib/HRingPicker.pas | 48 ++++- components/mbColorLib/HSColorPicker.pas | 62 ++++++ components/mbColorLib/HSLColorPicker.pas | 7 +- components/mbColorLib/HSLRingPicker.pas | 29 ++- components/mbColorLib/HSVColorPicker.pas | 69 ++++++- components/mbColorLib/HexaColorPicker.pas | 2 +- components/mbColorLib/RAxisColorPicker.pas | 113 ++++++++-- components/mbColorLib/SLColorPicker.pas | 62 +++++- components/mbColorLib/SLHColorPicker.pas | 64 +++--- .../mbColorLib/examples/fulldemo/Demo.lpi | 1 - .../mbColorLib/examples/fulldemo/main.lfm | 66 ++++-- .../mbColorLib/examples/fulldemo/main.pas | 44 +++- components/mbColorLib/mbBasicPicker.pas | 6 - components/mbColorLib/mbTrackBarPicker.pas | 87 +++++++- 19 files changed, 1007 insertions(+), 492 deletions(-) diff --git a/components/mbColorLib/BAxisColorPicker.pas b/components/mbColorLib/BAxisColorPicker.pas index 43c365299..78d60439e 100644 --- a/components/mbColorLib/BAxisColorPicker.pas +++ b/components/mbColorLib/BAxisColorPicker.pas @@ -24,18 +24,21 @@ type procedure SetGValue(g: integer); procedure SetBValue(b: integer); protected + procedure CorrectCoords(var x, y: integer); + procedure CreateWnd; override; + procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - procedure SetSelectedColor(c: TColor); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + *) + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure DrawMarker(x, y: integer); procedure Paint; override; procedure Resize; override; - procedure CreateWnd; override; - procedure CorrectCoords(var x, y: integer); + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -78,24 +81,18 @@ begin MarkerStyle := msCircle; end; -procedure TBAxisColorPicker.CreateWnd; -begin - inherited; - CreateGradient; -end; - -{ x is RED, y is GREEN } -function TBAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor; -begin - Result := RGB(x, FBufferBmp.Height - 1 - y, FB); -end; - procedure TBAxisColorPicker.CorrectCoords(var x, y: integer); begin Clamp(x, 0, Width - 1); Clamp(y, 0, Height - 1); end; +procedure TBAxisColorPicker.CreateWnd; +begin + inherited; + CreateGradient; +end; + procedure TBAxisColorPicker.DrawMarker(x, y: integer); var c: TColor; @@ -104,8 +101,6 @@ begin FR := GetRValue(FSelected); FG := GetGValue(FSelected); FB := GetBValue(FSelected); - if Assigned(FOnChange) then - FOnChange(Self); dx := x; dy := y; if Focused or (csDesigning in ComponentState) then @@ -115,18 +110,10 @@ begin InternalDrawMarker(x, y, c); end; -procedure TBAxisColorPicker.SetSelectedColor(c: TColor); +{ x is RED, y is GREEN } +function TBAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor; begin - if WebSafe then c := GetWebSafe(c); - FR := GetRValue(c); - FG := GetGValue(c); - FB := GetBValue(c); - FSelected := c; - FManual := false; - mxx := Round(FR*(Width/255)); - myy := Round((255-FG)*(Height/255)); - CreateGradient; - Invalidate; + Result := RGB(x, FBufferBmp.Height - 1 - y, FB); end; procedure TBAxisColorPicker.Paint; @@ -144,6 +131,77 @@ begin inherited; end; +procedure TBAxisColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FR := GetRValue(c); + FG := GetGValue(c); + FB := GetBValue(c); + FSelected := c; + FManual := false; + mxx := Round(FR*(Width/255)); + myy := Round((255-FG)*(Height/255)); + Invalidate; + if Assigned(FOnChange) then FOnChange(self); +end; + +procedure TBAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; + delta: Integer; +begin + eraseKey := true; + if (ssCtrl in Shift) then delta := 10 else delta := 1; + + case Key of + VK_LEFT: + begin + mxx := dx - delta; + myy := dy; + if mxx < 0 then mxx := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + VK_RIGHT: + begin + mxx := dx + delta; + myy := dy; + if mxx >= Width then mxx := Width - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + if myy < 0 then myy := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + if myy >= Height then myy := Height - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + else + eraseKey := false; + end; + + if eraseKey then Key := 0; + inherited; +end; + procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var @@ -154,10 +212,10 @@ begin myy := y; if Button = mbLeft then begin + {$IFDEF DELPHI} R := ClientRect; R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} FSelected := GetColorAtPoint(x, y); @@ -173,11 +231,15 @@ begin {$IFDEF DELPHI} ClipCursor(nil); {$ENDIF} - mxx := x; - myy := y; - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; + if ssLeft in Shift then + begin + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; end; procedure TBAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); @@ -190,9 +252,10 @@ begin FSelected := GetColorAtPoint(x, y); FManual := true; Invalidate; + if Assigned(FOnChange) then FOnChange(self); end; end; - +(* procedure TBAxisColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var @@ -289,7 +352,7 @@ begin if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; - + *) procedure TBAxisColorPicker.SetRValue(r: integer); begin Clamp(r, 0, 255); diff --git a/components/mbColorLib/CIEAColorPicker.pas b/components/mbColorLib/CIEAColorPicker.pas index a6139eea9..4919705b3 100644 --- a/components/mbColorLib/CIEAColorPicker.pas +++ b/components/mbColorLib/CIEAColorPicker.pas @@ -24,18 +24,21 @@ type procedure SetAValue(a: integer); procedure SetBValue(b: integer); protected + procedure CorrectCoords(var x, y: integer); + procedure CreateWnd; override; + procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - procedure SetSelectedColor(c: TColor); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + *) + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure DrawMarker(x, y: integer); procedure Paint; override; procedure Resize; override; - procedure CreateWnd; override; - procedure CorrectCoords(var x, y: integer); + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -112,8 +115,6 @@ begin FL := Round(GetCIELValue(FSelected)); FA := Round(GetCIEAValue(FSelected)); FB := Round(GetCIEBValue(FSelected)); - if Assigned(FOnChange) then - FOnChange(Self); dx := x; dy := y; if Focused or (csDesigning in ComponentState) then @@ -131,10 +132,11 @@ begin FB := Round(GetCIEBValue(c)); FSelected := c; FManual := false; - mxx := Round((FB+128)*(Width/255)); - myy := Round(((100-FL)*255/100)*(Height/255)); - CreateGradient; + mxx := Round((FB + 128) * Width / 255); + myy := Round((100 - FL) * 255 / 100 * Height / 255); Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; procedure TCIEAColorPicker.Paint; @@ -147,8 +149,8 @@ end; procedure TCIEAColorPicker.Resize; begin FManual := false; - mxx := Round((FB+128)*(Width/255)); - myy := Round(((100-FL)*255/100)*(Height/255)); + mxx := Round((FB + 128) * Width / 255); + myy := Round(((100 - FL) * 255 / 100) * Height / 255); inherited; end; @@ -161,15 +163,17 @@ begin myy := y; if Button = mbLeft then begin + {$IFDEF DELPHI} R := ClientRect; R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} FSelected := GetColorAtPoint(x, y); FManual := true; Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; SetFocus; end; @@ -180,11 +184,16 @@ begin {$IFDEF DELPHI} ClipCursor(nil); {$ENDIF} - mxx := x; - myy := y; - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; + if ssLeft in Shift then + begin + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; end; procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); @@ -197,104 +206,70 @@ begin FSelected := GetColorAtPoint(x, y); FManual := true; Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; end; -procedure TCIEAColorPicker.CNKeyDown( - var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +procedure TCIEAColorPicker.KeyDown(var Key: Word; Shift: TShiftState); var - Shift: TShiftState; - FInherited: boolean; + eraseKey: Boolean; + delta: Integer; begin - FInherited := false; - Shift := KeyDataToShiftState(Message.KeyData); - if not (ssCtrl in Shift) then - case Message.CharCode of - VK_LEFT: - begin - mxx := dx - 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; + eraseKey := true; + if (ssCtrl in Shift) then delta := 10 else delta := 1; + + case Key of + VK_LEFT: + begin + mxx := dx - delta; + myy := dy; + if mxx < 0 then mxx := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_RIGHT: + begin + mxx := dx + delta; + myy := dy; + if mxx >= Width then mxx := Width - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + if myy < 0 then myy := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + if myy >= Height then myy := Height - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; else - begin - FInherited := true; - inherited; - end; - end - else - case Message.CharCode of - VK_LEFT: - begin - mxx := dx - 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - else - begin - FInherited := true; - inherited; - end; + eraseKey := false; end; - if not FInherited then - if Assigned(OnKeyDown) then - OnKeyDown(Self, Message.CharCode, Shift); + + if eraseKey then Key := 0; + inherited; end; procedure TCIEAColorPicker.SetLValue(l: integer); diff --git a/components/mbColorLib/CIEBColorPicker.pas b/components/mbColorLib/CIEBColorPicker.pas index 4eb981ddf..ad66b030d 100644 --- a/components/mbColorLib/CIEBColorPicker.pas +++ b/components/mbColorLib/CIEBColorPicker.pas @@ -27,18 +27,20 @@ type procedure SetAValue(a: integer); procedure SetBValue(b: integer); protected + procedure CorrectCoords(var x, y: integer); + procedure CreateWnd; override; + procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - procedure SetSelectedColor(c: TColor); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); - message CN_KEYDOWN; + message CN_KEYDOWN;*) + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure DrawMarker(x, y: integer); procedure Paint; override; procedure Resize; override; - procedure CreateWnd; override; - procedure CorrectCoords(var x, y: integer); + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -110,8 +112,6 @@ begin FL := Round(GetCIELValue(FSelected)); FA := Round(GetCIEAValue(FSelected)); FB := Round(GetCIEBValue(FSelected)); - if Assigned(FOnChange) then - FOnChange(Self); dx := x; dy := y; if Focused or (csDesigning in ComponentState) then @@ -129,10 +129,11 @@ begin FB := Round(GetCIEBValue(c)); FSelected := c; FManual := false; - mxx := Round((FA+128)*(Width/255)); - myy := Round(((100-FL)*255/100)*(Height/255)); - CreateGradient; + mxx := Round((FA + 128) * Width / 255); + myy := Round((100 - FL) * 255 / 100* Height / 255); Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; procedure TCIEBColorPicker.Paint; @@ -175,14 +176,19 @@ end; procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; - {$IFDEF DELPHI} - ClipCursor(nil); - {$ENDIF} - mxx := x; - myy := y; - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; + if ssLeft in Shift then + begin + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; end; procedure TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); @@ -195,104 +201,70 @@ begin FSelected := GetColorAtPoint(x, y); FManual := true; Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; end; -procedure TCIEBColorPicker.CNKeyDown( - var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +procedure TCIEBColorPicker.KeyDown(var Key: Word; Shift: TShiftState); var - Shift: TShiftState; - FInherited: boolean; + eraseKey: Boolean; + delta: Integer; begin - FInherited := false; - Shift := KeyDataToShiftState(Message.KeyData); - if not (ssCtrl in Shift) then - case Message.CharCode of - VK_LEFT: - begin - mxx := dx - 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - else - begin - FInherited := true; - inherited; - end; - end - else - case Message.CharCode of - VK_LEFT: - begin - mxx := dx - 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - else - begin - FInherited := true; - inherited; - end; + eraseKey := true; + if (ssCtrl in Shift) then delta := 10 else delta := 1; + + case Key of + VK_LEFT: + begin + mxx := dx - delta; + myy := dy; + if myy < 0 then myy := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_RIGHT: + begin + mxx := dx + delta; + myy := dy; + if myy >= Width then myy := Width - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + if myy < 0 then myy := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + if myy >= Height then myy := Height - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + else + eraseKey := false; end; - if not FInherited then - if Assigned(OnKeyDown) then - OnKeyDown(Self, Message.CharCode, Shift); + + if eraseKey then Key := 0; + inherited; end; procedure TCIEBColorPicker.SetLValue(L: integer); diff --git a/components/mbColorLib/CIELColorPicker.pas b/components/mbColorLib/CIELColorPicker.pas index 8aa422ecf..4119f166e 100644 --- a/components/mbColorLib/CIELColorPicker.pas +++ b/components/mbColorLib/CIELColorPicker.pas @@ -24,18 +24,21 @@ type procedure SetAValue(a: integer); procedure SetBValue(b: integer); protected + procedure CorrectCoords(var x, y: integer); + procedure CreateWnd; override; + procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - procedure SetSelectedColor(c: TColor); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + *) + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure DrawMarker(x, y: integer); procedure Paint; override; procedure Resize; override; - procedure CreateWnd; override; - procedure CorrectCoords(var x, y: integer); + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -77,6 +80,7 @@ begin mxx := 0; myy := 0; MarkerStyle := msCircle; + SetSelectedColor(clAqua); end; procedure TCIELColorPicker.CreateWnd; @@ -105,8 +109,6 @@ begin FL := Round(GetCIELValue(FSelected)); FA := Round(GetCIEAValue(FSelected)); FB := Round(GetCIEBValue(FSelected)); - if Assigned(FOnChange) then - FOnChange(Self); dx := x; dy := y; if Focused or (csDesigning in ComponentState) then @@ -124,10 +126,11 @@ begin FB := Round(GetCIEBValue(c)); FSelected := c; FManual := false; - mxx := Round((FA+128)*(Width/255)); - myy := Round((255-(FB+128))*(Height/255)); - CreateGradient; + mxx := Round((FA + 128) * Width / 255); + myy := Round((255 - (FB + 128)) * Height / 255); Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; procedure TCIELColorPicker.Paint; @@ -140,8 +143,8 @@ end; procedure TCIELColorPicker.Resize; begin FManual := false; - mxx := Round((FA+128)*(Width/255)); - myy := Round((255-(FB+128))*(Height/255)); + mxx := Round((FA + 128) * Width / 255); + myy := Round((255 - (FB + 128)) * Height / 255); inherited; end; @@ -170,14 +173,19 @@ end; procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; - {$IFDEF DELPHI} - ClipCursor(nil); - {$ENDIF} - mxx := x; - myy := y; - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; + if ssLeft in Shift then + begin + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; end; procedure TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); @@ -190,104 +198,69 @@ begin FSelected := GetColorAtPoint(x, y); FManual := true; Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; end; -procedure TCIELColorPicker.CNKeyDown( - var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +procedure TCIELColorPicker.KeyDown(var Key: Word; Shift: TShiftState); var - Shift: TShiftState; - FInherited: boolean; + eraseKey: Boolean; + delta: Integer; begin - FInherited := false; - Shift := KeyDataToShiftState(Message.KeyData); - if not (ssCtrl in Shift) then - case Message.CharCode of - VK_LEFT: - begin - mxx := dx - 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; + erasekey := true; + if (ssCtrl in Shift) then delta := 10 else delta := 1; + case Key of + VK_LEFT: + begin + mxx := dx - delta; + myy := dy; + if mxx < 0 then mxx := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_RIGHT: + begin + mxx := dx + delta; + myy := dy; + if mxx >= Width then mxx := Width - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + if myy < 0 then myy := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + if myy >= Height then myy := Height - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; else - begin - FInherited := true; - inherited; - end; - end - else - case Message.CharCode of - VK_LEFT: - begin - mxx := dx - 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - else - begin - FInherited := true; - inherited; - end; + eraseKey := false; end; - if not FInherited then - if Assigned(OnKeyDown) then - OnKeyDown(Self, Message.CharCode, Shift); + + if eraseKey then Key := 0; + inherited; end; procedure TCIELColorPicker.SetLValue(l: integer); diff --git a/components/mbColorLib/GAxisColorPicker.pas b/components/mbColorLib/GAxisColorPicker.pas index bbcdbe79c..5b0d41b76 100644 --- a/components/mbColorLib/GAxisColorPicker.pas +++ b/components/mbColorLib/GAxisColorPicker.pas @@ -24,18 +24,21 @@ type procedure SetGValue(g: integer); procedure SetBValue(b: integer); protected + procedure CorrectCoords(var x, y: integer); + procedure CreateWnd; override; + procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - procedure SetSelectedColor(c: TColor); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + *) procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure DrawMarker(x, y: integer); procedure Paint; override; procedure Resize; override; - procedure CreateWnd; override; - procedure CorrectCoords(var x, y: integer); + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -78,6 +81,12 @@ begin MarkerStyle := msCircle; end; +procedure TGAxisColorPicker.CorrectCoords(var x, y: integer); +begin + Clamp(x, 0, Width-1); + Clamp(y, 0, Height-1); +end; + procedure TGAxisColorPicker.CreateWnd; begin inherited; @@ -89,12 +98,6 @@ begin Result := RGB(FBufferBmp.Height - 1 - y, FG, x); end; -procedure TGAxisColorPicker.CorrectCoords(var x, y: integer); -begin - Clamp(x, 0, Width-1); - Clamp(y, 0, Height-1); -end; - procedure TGAxisColorPicker.DrawMarker(x, y: integer); var c: TColor; @@ -103,8 +106,6 @@ begin FR := GetRValue(FSelected); FG := GetGValue(FSelected); FB := GetBValue(FSelected); - if Assigned(FOnChange) then - FOnChange(Self); dx := x; dy := y; if Focused or (csDesigning in ComponentState) then @@ -122,10 +123,11 @@ begin FB := GetBValue(c); FSelected := c; FManual := false; - myy := Round((255-FR)*(Height/255)); - mxx := Round(FB*(Width/255)); - CreateGradient; + myy := Round((255 - FR) * Height / 255); + mxx := Round(FB * Width / 255); Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; procedure TGAxisColorPicker.Paint; @@ -138,8 +140,69 @@ end; procedure TGAxisColorPicker.Resize; begin FManual := false; - myy := Round((255-FR)*(Height/255)); - mxx := Round(FB*(Width/255)); + myy := Round((255 - FR) * Height / 255); + mxx := Round(FB * Width / 255); + inherited; +end; + +procedure TGAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; + delta: Integer; +begin + eraseKey := true; + if (ssCtrl in Shift) then delta := 10 else delta := 1; + + case Key of + VK_LEFT: + begin + mxx := dx - delta; + myy := dy; + if mxx < 0 then mxx := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_RIGHT: + begin + mxx := dx + delta; + myy := dy; + if mxx >= Width then mxx := Width - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + if myy < 0 then myy := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + if myy >= Height then myy := Height - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + else + eraseKey := false; + end; + + if eraseKey then Key := 0; inherited; end; @@ -152,10 +215,10 @@ begin myy := y; if Button = mbLeft then begin + {$IFDEF DELPHI} R := ClientRect; R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} FSelected := GetColorAtPoint(x, y); @@ -168,14 +231,19 @@ end; procedure TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; - {$IFDEF DELPHI} - ClipCursor(nil); - {$ENDIF} - mxx := X; - myy := Y; - FSelected := GetColorAtPoint(X, Y); - FManual := true; - Invalidate; + if ssLeft in Shift then + begin + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := X; + myy := Y; + FSelected := GetColorAtPoint(X, Y); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; end; procedure TGAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); @@ -188,9 +256,11 @@ begin FSelected := GetColorAtPoint(X, Y); FManual := true; Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); end; end; - +(* procedure TGAxisColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); var @@ -287,7 +357,7 @@ begin if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; - + *) procedure TGAxisColorPicker.SetRValue(r: integer); begin Clamp(r, 0, 255); diff --git a/components/mbColorLib/HRingPicker.pas b/components/mbColorLib/HRingPicker.pas index 116f47abf..c61a57bbb 100644 --- a/components/mbColorLib/HRingPicker.pas +++ b/components/mbColorLib/HRingPicker.pas @@ -51,12 +51,15 @@ type procedure Paint; override; procedure Resize; override; // procedure CreateWnd; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); 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; + function MouseOnPicker(X, Y: Integer): Boolean; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + *) public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; @@ -185,7 +188,8 @@ end; procedure THRingPicker.SetHue(h: integer); begin - Clamp(h, 0, FMaxHue); + if h > FMaxHue then h := h - (FMaxHue + 1); + if h < 0 then h := h + (FMaxHue + 1); if GetHue() <> h then begin FHue := h / FMaxHue; @@ -339,6 +343,42 @@ begin Invalidate; end; +procedure THRingPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; + delta: Integer; +begin + eraseKey := true; + if ssCtrl in Shift then + delta := 10 + else + delta := 1; + + case Key of + VK_LEFT: + begin + FChange := false; + SetHue(RadHue(GetHue() + delta)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + begin + FChange := false; + SetHue(RadHue(GetHue() - delta)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end + else + erasekey := false; + end; + + if eraseKey then Key := 0; + inherited; +end; + procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin @@ -475,7 +515,7 @@ begin if New > (FMaxHue + 1) then New := New - (FMaxHue + 1); Result := New; end; - + (* procedure THRingPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var @@ -516,5 +556,5 @@ begin if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; - +*) end. diff --git a/components/mbColorLib/HSColorPicker.pas b/components/mbColorLib/HSColorPicker.pas index 162bade34..7691f5ec6 100644 --- a/components/mbColorLib/HSColorPicker.pas +++ b/components/mbColorLib/HSColorPicker.pas @@ -39,8 +39,11 @@ type procedure CorrectCoords(var x, y: integer); function GetGradientColor2D(X, Y: Integer): TColor; override; procedure SetSelectedColor(c: TColor); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + *) procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; @@ -187,6 +190,63 @@ begin inherited; end; +procedure THSColorPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; + delta: Integer; +begin + eraseKey := true; + if (ssCtrl in Shift) then + delta := 10 + else + delta := 1; + case Key of + VK_LEFT: + begin + mxx := dx - delta; + myy := dy; + FSelected := GetColorAtPoint(mxx, myy); + if Assigned(OnChange) then OnChange(Self); + FManual := true; + Invalidate; + end; + VK_RIGHT: + begin + mxx := dx + delta; + myy := dy; + FSelected := GetColorAtPoint(mxx, myy); + if Assigned(OnChange) then OnChange(Self); + FManual := true; + Invalidate; + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + FSelected := GetColorAtPoint(mxx, myy); + if Assigned(OnChange) then OnChange(Self); + FManual := true; + Invalidate; + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + FSelected := GetColorAtPoint(mxx, myy); + if Assigned(OnChange) then OnChange(Self); + FManual := true; + Invalidate; + end; + else + eraseKey := false; + end; + + if eraseKey then + Key := 0; + + inherited; +end; + procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); {$IFDEF DELPHI} var @@ -249,6 +309,7 @@ begin Result := HSLToRGB(H, S, L); end; +(* procedure THSColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var @@ -306,6 +367,7 @@ begin if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; +*) procedure THSColorPicker.SetHue(H: integer); begin diff --git a/components/mbColorLib/HSLColorPicker.pas b/components/mbColorLib/HSLColorPicker.pas index 772fe354c..ebe7869ef 100644 --- a/components/mbColorLib/HSLColorPicker.pas +++ b/components/mbColorLib/HSLColorPicker.pas @@ -137,6 +137,7 @@ begin FLumIncrement := 1; FHSCursor := crDefault; FLCursor := crDefault; + with FHSPicker do begin {$IFDEF DELPHI} @@ -155,6 +156,7 @@ begin OnChange := HSPickerChange; OnMouseMove := DoMouseMove; end; + FLPicker := TLColorPicker.Create(Self); InsertControl(FLPicker); with FLPicker do @@ -177,6 +179,7 @@ begin OnChange := LPickerChange; OnMouseMove := DoMouseMove; end; + Hue := 0; Saturation := 240; Luminance := 120; @@ -190,8 +193,8 @@ end; destructor THSLColorPicker.Destroy; begin PBack.Free; - FHSPicker.Free; - FLPicker.Free; + //FHSPicker.Free; + //FLPicker.Free; inherited Destroy; end; diff --git a/components/mbColorLib/HSLRingPicker.pas b/components/mbColorLib/HSLRingPicker.pas index aefd8c367..04d12463e 100644 --- a/components/mbColorLib/HSLRingPicker.pas +++ b/components/mbColorLib/HSLRingPicker.pas @@ -62,11 +62,14 @@ type procedure SLPickerChange(Sender: TObject); procedure DoChange; procedure Resize; override; + procedure SetFocus; override; + (* {$IFDEF DELPHI} procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; {$ELSE} procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; {$ENDIF} + *) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -131,12 +134,16 @@ begin {$ELSE} SetInitialBounds(0, 0, 245, 245); {$ENDIF} + TabStop := true; FSelectedColor := clRed; - FRingPicker := THRingPicker.Create(Self); - InsertControl(FRingPicker); FRingCursor := crDefault; FSLCursor := crDefault; + FRingHint := 'Hue: %h'; + FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; + + FRingPicker := THRingPicker.Create(Self); + InsertControl(FRingPicker); with FRingPicker do begin {$IFDEF DELPHI} @@ -156,6 +163,7 @@ begin OnChange := RingPickerChange; OnMouseMove := DoMouseMove; end; + FSLPicker := TSLColorPicker.Create(Self); InsertControl(FSLPicker); with FSLPicker do @@ -176,15 +184,13 @@ begin OnChange := SLPickerChange; OnMouseMove := DoMouseMove; end; - FRingHint := 'Hue: %h'; - FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; end; destructor THSLRingPicker.Destroy; begin PBack.Free; - FRingPicker.Free; - FSLPicker.Free; + //FRingPicker.Free; + //FSLPicker.Free; inherited Destroy; end; @@ -197,7 +203,7 @@ begin if (FRingPicker = nil) or (FSLPicker = nil) then exit; - ctr := Min(Width, Height)/100; + ctr := Min(Width, Height) / 100; circ.x := Min(Width, Height) div 2; circ.y := circ.x; @@ -350,13 +356,20 @@ begin FSLCursor := c; FSLPicker.Cursor := c; end; - + (* procedure THSLRingPicker.WMSetFocus( var Message: {$IFDEF DELPHI}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF} ); begin FRingPicker.SetFocus; Message.Result := 1; end; +*) + +procedure THSLRingPicker.SetFocus; +begin + inherited; + FRingPicker.SetFocus; +end; function THSLRingPicker.GetManual:boolean; begin diff --git a/components/mbColorLib/HSVColorPicker.pas b/components/mbColorLib/HSVColorPicker.pas index d415580bc..1da4dcc2c 100644 --- a/components/mbColorLib/HSVColorPicker.pas +++ b/components/mbColorLib/HSVColorPicker.pas @@ -56,12 +56,15 @@ type procedure Paint; override; procedure Resize; override; procedure CreateWnd; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); 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; +// 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; + *) public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; @@ -223,7 +226,9 @@ end; procedure THSVColorPicker.SetHue(h: integer); begin - Clamp(h, 0, FMaxHue); + if h > FMaxHue then h := h - (FMaxHue + 1); + if h < 0 then h := h + (FMaxHue + 1); +// Clamp(h, 0, FMaxHue); if GetHue() <> h then begin FHue := h / FMaxHue; @@ -419,6 +424,58 @@ begin Invalidate; end; +procedure THSVColorPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; + delta: Integer; +begin + eraseKey := true; + if ssCtrl in shift then + delta := 10 + else + delta := 1; + + case Key of + VK_LEFT: + begin + FChange := false; + SetHue(RadHue(GetHue() + delta)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + begin + FChange := false; + SetHue(RadHue(GetHue() - delta)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_UP: + begin + FChange := false; + SetSat(GetSat() + delta); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + begin + FChange := false; + SetSat(GetSat() - delta); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + else + eraseKey := false; + end; + + if eraseKey then Key := 0; + inherited; +end; + procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin @@ -480,7 +537,7 @@ begin FManual := true; end; end; - + (* function THSVColorPicker.MouseOnPicker(X, Y: Integer): Boolean; var diameter, r: Integer; @@ -492,7 +549,7 @@ begin ctr := Point(r, r); Result := PtInCircle(P, ctr, r); end; - + *) function THSVColorPicker.GetSelectedColor: TColor; begin if FSelectedColor <> clNone then @@ -556,7 +613,7 @@ begin if New > (FMaxHue + 1) then New := New - (FMaxHue + 1); Result := New; end; - +(* procedure THSVColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var @@ -614,5 +671,5 @@ begin if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; - + *) end. diff --git a/components/mbColorLib/HexaColorPicker.pas b/components/mbColorLib/HexaColorPicker.pas index 72d1a961c..710bdde86 100644 --- a/components/mbColorLib/HexaColorPicker.pas +++ b/components/mbColorLib/HexaColorPicker.pas @@ -238,7 +238,7 @@ destructor THexaColorPicker.Destroy; begin FBWCombs := nil; FColorCombs := nil; - FBufferBmp.Free; + // FBufferBmp.Free; is already destroyed by ancestor TmbBasicPicker inherited; end; diff --git a/components/mbColorLib/RAxisColorPicker.pas b/components/mbColorLib/RAxisColorPicker.pas index 014c72623..18abb25bf 100644 --- a/components/mbColorLib/RAxisColorPicker.pas +++ b/components/mbColorLib/RAxisColorPicker.pas @@ -24,25 +24,28 @@ type procedure SetGValue(g: integer); procedure SetBValue(b: integer); protected + procedure CorrectCoords(var x, y: integer); + procedure CreateWnd; override; + procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - procedure SetSelectedColor(c: TColor); override; + (* procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + *) + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure DrawMarker(x, y: integer); procedure Paint; override; procedure Resize; override; - procedure CreateWnd; override; - procedure CorrectCoords(var x, y: integer); + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published property SelectedColor default clRed; - property RValue: integer read FR write SetRValue default 255; - property GValue: integer read FG write SetGValue default 0; - property BValue: integer read FB write SetBValue default 0; + property Red: integer read FR write SetRValue default 255; + property Green: integer read FG write SetGValue default 0; + property Blue: integer read FB write SetBValue default 0; property MarkerStyle default msCircle; property OnChange; end; @@ -104,8 +107,6 @@ begin FR := GetRValue(FSelected); FG := GetGValue(FSelected); FB := GetBValue(FSelected); - if Assigned(FOnChange) then - FOnChange(Self); dx := x; dy := y; if Focused or (csDesigning in ComponentState) then @@ -125,8 +126,8 @@ begin FManual := false; myy := Round((255-FG)*(Height/255)); mxx := Round(FB*(Width/255)); - CreateGradient; Invalidate; + if Assigned(FOnChange) then FOnChange(self); end; procedure TRAxisColorPicker.Paint; @@ -139,8 +140,70 @@ end; procedure TRAxisColorPicker.Resize; begin FManual := false; - myy := Round((255-FG)*(Height/255)); - mxx := Round(FB*(Width/255)); + myy := Round((255 - FG) * Height / 255); + mxx := Round(FB * Width / 255); + inherited; +end; + +procedure TRAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + delta: Integer; + eraseKey: Boolean; +begin + eraseKey := true; + if ssCtrl in Shift then + delta := 10 + else + delta := 1; + + case Key of + VK_LEFT: + begin + mxx := dx - delta; + if mxx < 0 then mxx := 0; + myy := dy; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + VK_RIGHT: + begin + mxx := dx + delta; + if mxx >= Width then mxx := Width - 1; + myy := dy; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + if myy < 0 then myy := 0; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + if myy >= Height then + myy := Height - 1; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; + else + eraseKey := false; + end; + + if eraseKey then Key := 0; + inherited; end; @@ -153,10 +216,10 @@ begin myy := y; if Button = mbLeft then begin + {$IFDEF DELPHI} R := ClientRect; R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} FSelected := GetColorAtPoint(x, y); @@ -169,14 +232,18 @@ end; procedure TRAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; - {$IFDEF DELPHI} - ClipCursor(nil); - {$ENDIF} - mxx := x; - myy := y; - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; + if ssLeft in Shift then + begin + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + if Assigned(FOnChange) then FOnChange(self); + end; end; procedure TRAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); @@ -189,9 +256,11 @@ begin FSelected := GetColorAtPoint(x, y); FManual := true; Invalidate; + if Assigned(FOnChange) then FOnChange(self); end; end; +(* procedure TRAxisColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var @@ -288,7 +357,7 @@ begin if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; - +*) procedure TRAxisColorPicker.SetRValue(r: integer); begin Clamp(r, 0, 255); diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas index f76c68a60..5e75a66c6 100644 --- a/components/mbColorLib/SLColorPicker.pas +++ b/components/mbColorLib/SLColorPicker.pas @@ -40,11 +40,12 @@ type procedure Paint; override; procedure Resize; override; procedure CreateWnd; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); - message CN_KEYDOWN; +// procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); +// message CN_KEYDOWN; public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; @@ -235,6 +236,61 @@ begin FChange := true; end; + +procedure TSLColorPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; + delta: Integer; +begin + eraseKey := true; + if ssCtrl in Shift then + delta := 10 + else + delta := 1; + + case Key of + VK_LEFT: + if (mdx - delta >= 0) then + begin + Dec(mdx, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + if (mdx + delta < Width) then + begin + Inc(mdx, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_UP: + if (mdy - delta >= 0) then + begin + Dec(mdy, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + if (mdy + delta < Height) then + begin + Inc(mdy, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + else + eraseKey := false; + end; + + if eraseKey then + Key := 0; + + inherited; +end; + procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin @@ -324,6 +380,7 @@ begin Result := GetWebSafe(Result); end; +(* procedure TSLColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var @@ -382,5 +439,6 @@ begin if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); end; +*) end. diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas index 5953ca061..54322cf66 100644 --- a/components/mbColorLib/SLHColorPicker.pas +++ b/components/mbColorLib/SLHColorPicker.pas @@ -62,8 +62,11 @@ type procedure Paint; override; // procedure PaintParentBack; override; procedure Resize; override; + procedure SetFocus; override; + (* procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF}; + *) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -140,6 +143,31 @@ begin FHCursor := crDefault; FSLCursor := crDefault; + // Saturation-Lightness picker + FSLPicker := TSLColorPicker.Create(Self); + InsertControl(FSLPicker); + with FSLPicker do + begin + {$IFDEF DELPHI} + Left := 0; + Top := DELTA; + Width := 255; + Height := self.Height - 2 * VDELTA; + {$ELSE} + SetInitialBounds(0, VDELTA, WSL, HSL); + {$ENDIF} + //Anchors := [akLeft, akRight, akTop, akBottom]; + Visible := true; + SelectedColor := clRed; + MaxHue := FMaxH; + MaxSaturation := FMaxS; + MaxLuminance := FMaxL; + Saturation := FMaxS; + Luminance := FMaxL; + OnChange := SLPickerChange; + OnMouseMove := DoMouseMove; + end; + // Hue picker with FHPicker do begin @@ -166,30 +194,6 @@ begin OnMouseMove := DoMouseMove; end; - // Saturation-Lightness picker - FSLPicker := TSLColorPicker.Create(Self); - InsertControl(FSLPicker); - with FSLPicker do - begin - {$IFDEF DELPHI} - Left := 0; - Top := DELTA; - Width := 255; - Height := self.Height - 2 * VDELTA; - {$ELSE} - SetInitialBounds(0, VDELTA, WSL, HSL); - {$ENDIF} - //Anchors := [akLeft, akRight, akTop, akBottom]; - Visible := true; - SelectedColor := clRed; - MaxHue := FMaxH; - MaxSaturation := FMaxS; - MaxLuminance := FMaxL; - Saturation := FMaxS; - Luminance := FMaxL; - OnChange := SLPickerChange; - OnMouseMove := DoMouseMove; - end; FHValue := 0; FSValue := 1.0; FLValue := 1.0; @@ -203,8 +207,8 @@ end; destructor TSLHColorPicker.Destroy; begin PBack.Free; - FHPicker.Free; - FSLPicker.Free; +// FHPicker.Free; +// FSLPicker.Free; inherited Destroy; end; @@ -368,12 +372,18 @@ begin FSLPicker.Cursor := c; end; +procedure TSLHColorPicker.SetFocus; +begin + FSLPicker.SetFocus; +end; +(* procedure TSLHColorPicker.WMSetFocus( var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} ); begin - FHPicker.SetFocus; + FSLPicker.SetFocus; Message.Result := 1; end; +*) function TSLHColorPicker.GetManual:boolean; begin diff --git a/components/mbColorLib/examples/fulldemo/Demo.lpi b/components/mbColorLib/examples/fulldemo/Demo.lpi index c0d02c90a..e63005e08 100644 --- a/components/mbColorLib/examples/fulldemo/Demo.lpi +++ b/components/mbColorLib/examples/fulldemo/Demo.lpi @@ -58,7 +58,6 @@ - diff --git a/components/mbColorLib/examples/fulldemo/main.lfm b/components/mbColorLib/examples/fulldemo/main.lfm index 58c62ea17..2427f2968 100644 --- a/components/mbColorLib/examples/fulldemo/main.lfm +++ b/components/mbColorLib/examples/fulldemo/main.lfm @@ -43,9 +43,9 @@ object Form1: TForm1 Height = 384 Top = 6 Width = 403 - ActivePage = TabSheet1 + ActivePage = TabSheet5 Anchors = [akTop, akLeft, akRight, akBottom] - TabIndex = 0 + TabIndex = 4 TabOrder = 0 OnChange = PageControl1Change OnMouseMove = PageControl1MouseMove @@ -720,9 +720,9 @@ object Form1: TForm1 Anchors = [akLeft, akRight, akBottom] TabOrder = 2 Hue = 0 - Saturation = 51 + Saturation = 0 Luminance = 240 - SelectedColor = clWhite + SelectedColor = 6579300 end object VColorPicker1: TVColorPicker Left = 34 @@ -1027,6 +1027,7 @@ object Form1: TForm1 Width = 100 HintFormat = 'G: %g B: %b'#13'Hex: #%hex' TabOrder = 0 + OnChange = RAxisColorPicker1Change end object GAxisColorPicker1: TGAxisColorPicker Left = 130 @@ -1036,6 +1037,7 @@ object Form1: TForm1 HintFormat = 'R: %r B: %b'#13'Hex: #%hex' TabOrder = 1 MarkerStyle = msCross + OnChange = GAxisColorPicker1Change end object BAxisColorPicker1: TBAxisColorPicker Left = 250 @@ -1045,11 +1047,12 @@ object Form1: TForm1 HintFormat = 'R: %r G: %g'#13'Hex: #%hex' TabOrder = 2 MarkerStyle = msCrossCirc + OnChange = BAxisColorPicker1Change end object CIELColorPicker1: TCIELColorPicker Left = 10 Height = 100 - Top = 164 + Top = 188 Width = 100 SelectedColor = 16119089 HintFormat = 'A: %cieA B: %cieB'#13'Hex: #%hex' @@ -1057,11 +1060,12 @@ object Form1: TForm1 LValue = 88 AValue = -47 BValue = -32 + OnChange = CIELColorPicker1Change end object CIEAColorPicker1: TCIEAColorPicker Left = 130 Height = 100 - Top = 164 + Top = 188 Width = 100 SelectedColor = 16515327 HintFormat = 'L: %cieL B: %cieB'#13'Hex: #%hex' @@ -1070,11 +1074,12 @@ object Form1: TForm1 AValue = 96 BValue = -78 MarkerStyle = msSquare + OnChange = CIEAColorPicker1Change end object CIEBColorPicker1: TCIEBColorPicker Left = 250 Height = 100 - Top = 164 + Top = 188 Width = 100 SelectedColor = 130823 HintFormat = 'L: %cieL A: %cieA'#13'Hex: #%hex' @@ -1082,6 +1087,7 @@ object Form1: TForm1 LValue = 88 AValue = -88 BValue = 74 + OnChange = CIEBColorPicker1Change end object Label10: TLabel Left = 130 @@ -1110,7 +1116,7 @@ object Form1: TForm1 object Label13: TLabel Left = 10 Height = 15 - Top = 144 + Top = 168 Width = 84 Caption = 'CIELColorPicker' ParentColor = False @@ -1118,7 +1124,7 @@ object Form1: TForm1 object Label14: TLabel Left = 130 Height = 15 - Top = 144 + Top = 168 Width = 86 Caption = 'CIEAColorPicker' ParentColor = False @@ -1126,11 +1132,47 @@ object Form1: TForm1 object Label15: TLabel Left = 250 Height = 15 - Top = 144 + Top = 168 Width = 85 Caption = 'CIEBColorPicker' ParentColor = False end + object RAxisIndicator: TShape + Left = 88 + Height = 21 + Top = 132 + Width = 22 + end + object GAxisIndicator: TShape + Left = 208 + Height = 21 + Top = 132 + Width = 22 + end + object BAxisIndicator: TShape + Left = 328 + Height = 21 + Top = 132 + Width = 22 + end + object CIEBIndicator: TShape + Left = 328 + Height = 21 + Top = 296 + Width = 22 + end + object CIEAIndicator: TShape + Left = 208 + Height = 21 + Top = 296 + Width = 22 + end + object CIELIndicator: TShape + Left = 88 + Height = 21 + Top = 296 + Width = 22 + end end end object sc: TmbColorPreview @@ -1182,7 +1224,7 @@ object Form1: TForm1 Anchors = [akTop, akRight] Caption = 'WebSafe' OnClick = CbWebSsafeClick - TabOrder = 5 + TabOrder = 6 end object CbSwatchStyle: TCheckBox Left = 416 @@ -1192,7 +1234,7 @@ object Form1: TForm1 Anchors = [akTop, akRight] Caption = 'SwatchStyle' OnClick = CbSwatchStyleClick - TabOrder = 6 + TabOrder = 5 end object CbShowHints: TCheckBox Left = 416 diff --git a/components/mbColorLib/examples/fulldemo/main.pas b/components/mbColorLib/examples/fulldemo/main.pas index bce9cabf9..feb92d7ca 100644 --- a/components/mbColorLib/examples/fulldemo/main.pas +++ b/components/mbColorLib/examples/fulldemo/main.pas @@ -5,7 +5,7 @@ interface uses LCLIntf, LCLType, LMessages, SysUtils, Variants,Classes, Graphics, Controls, - Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, mbColorPreview, + Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview, HexaColorPicker, mbColorPalette, HSLRingPicker, HSVColorPicker, PalUtils, SLHColorPicker, mbDeskPickerButton, mbOfficeColorDialog, SColorPicker, HColorPicker, VColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker, @@ -20,8 +20,10 @@ type { TForm1 } TForm1 = class(TForm) + CIEBIndicator: TShape; CbShowHints: TCheckBox; CbEnabled: TCheckBox; + CIEAIndicator: TShape; Label10: TLabel; Label11: TLabel; Label12: TLabel; @@ -29,6 +31,10 @@ type Label14: TLabel; Label15: TLabel; PageControl1: TPageControl; + RAxisIndicator: TShape; + GAxisIndicator: TShape; + BAxisIndicator: TShape; + CIELIndicator: TShape; TabSheet1: TTabSheet; TabSheet2: TTabSheet; TabSheet3: TTabSheet; @@ -105,13 +111,19 @@ type Memo1: TMemo; Label9: TLabel; CbSwatchStyle: TCheckBox; + procedure BAxisColorPicker1Change(Sender: TObject); procedure CbEnabledChange(Sender: TObject); procedure CbShowHintsChange(Sender: TObject); + procedure CIEAColorPicker1Change(Sender: TObject); + procedure CIEBColorPicker1Change(Sender: TObject); + procedure CIELColorPicker1Change(Sender: TObject); + procedure GAxisColorPicker1Change(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); + procedure RAxisColorPicker1Change(Sender: TObject); procedure tb1Change(Sender: TObject); procedure tb2Change(Sender: TObject); procedure HSLColorPicker1Change(Sender: TObject); @@ -208,6 +220,11 @@ begin uc.color := hexacolorpicker1.ColorUnderCursor; end; +procedure TForm1.BAxisColorPicker1Change(Sender: TObject); +begin + BAxisIndicator.Brush.Color := BAxisColorPicker1.SelectedColor; +end; + procedure TForm1.Button1Click(Sender: TObject); begin mbColorPalette1.GeneratePalette(clblue); @@ -281,6 +298,11 @@ begin uc.color := HSLColorpicker1.ColorUnderCursor; end; +procedure TForm1.RAxisColorPicker1Change(Sender: TObject); +begin + RAxisIndicator.Brush.Color := RAxisColorPicker1.SelectedColor; +end; + procedure TForm1.OfficeColorDialogButtonClick(Sender: TObject); begin if mbOfficeColorDialog1.Execute then @@ -341,6 +363,11 @@ begin end; end; +procedure TForm1.GAxisColorPicker1Change(Sender: TObject); +begin + GAxisIndicator.Brush.Color := GAxisColorPicker1.SelectedColor; +end; + procedure TForm1.HColorPicker1GetHintStr(Sender: TObject; X, Y: Integer; var AText: String); begin @@ -362,6 +389,21 @@ begin hexacolorpicker1.NewArrowStyle := checkbox2.checked; end; +procedure TForm1.CIEAColorPicker1Change(Sender: TObject); +begin + CIEAIndicator.Brush.Color := CIEAColorPicker1.SelectedColor; +end; + +procedure TForm1.CIEBColorPicker1Change(Sender: TObject); +begin + CIEBIndicator.Brush.Color := CIEBColorPicker1.SelectedColor; +end; + +procedure TForm1.CIELColorPicker1Change(Sender: TObject); +begin + CIELIndicator.Brush.Color := CIELColorPicker1.SelectedColor; +end; + procedure TForm1.Button4Click(Sender: TObject); begin if opendialog1.Execute then diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas index 141188655..4937ba6f8 100644 --- a/components/mbColorLib/mbBasicPicker.pas +++ b/components/mbColorLib/mbBasicPicker.pas @@ -41,7 +41,6 @@ type 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; procedure PaintParentBack; virtual; overload; procedure PaintParentBack(ACanvas: TCanvas); overload; procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload; @@ -243,11 +242,6 @@ begin } end; -function TmbBasicPicker.MouseOnPicker(X, Y: Integer): Boolean; -begin - Result := true; -end; - procedure TmbBasicPicker.PaintParentBack; begin PaintParentBack(Canvas); diff --git a/components/mbColorLib/mbTrackBarPicker.pas b/components/mbColorLib/mbTrackBarPicker.pas index 0fc13ca9e..b06053c06 100644 --- a/components/mbColorLib/mbTrackBarPicker.pas +++ b/components/mbColorLib/mbTrackBarPicker.pas @@ -91,19 +91,20 @@ type function GetHintPos(X, Y: Integer): TPoint; override; function GetHintStr(X, Y: Integer): String; override; function GetSelectedValue: integer; virtual; abstract; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; 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; +// 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 CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER; procedure CMLostFocus(var Message: TCMLostFocus); message CM_EXIT; {$ELSE} - procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN; +// procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN; procedure CMGotFocus(var Message: TLMessage); message CM_ENTER; procedure CMLostFocus(var Message: TLMessage); message CM_EXIT; {$ENDIF} @@ -608,6 +609,78 @@ begin Result := pos; end; +procedure TmbTrackBarPicker.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; +begin + eraseKey := true; + case Key of + VK_UP: + if FLayout = lyHorizontal then + eraseKey := false + else + begin + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKUp) + else + Execute(TBA_VKCtrlUp); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_LEFT: + if FLayout = lyVertical then + eraseKey := false + else + begin + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKLeft) + else + Execute(TBA_VKCtrlLeft); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + if FLayout = lyVertical then + eraseKey := false + else + begin + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKRight) + else + Execute(TBA_VKCtrlRight); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + if FLayout = lyHorizontal then + eraseKey := false + else + begin + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKDown) + else + Execute(TBA_VKCtrlDown); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end + else + eraseKey := false; + end; // case + + if eraseKey then + Key := 0; + + inherited; +end; + procedure TmbTrackBarPicker.MouseLeave; begin inherited; @@ -639,11 +712,11 @@ begin end; inherited; end; - + (* function TmbTrackBarPicker.MouseOnPicker(X, Y: Integer): Boolean; begin Result := PtInRect(FPickRect, Point(X, Y)); -end; +end; *) procedure TmbTrackBarPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin @@ -681,7 +754,7 @@ begin Invalidate; inherited; end; - + (* procedure TmbTrackBarPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); var @@ -764,7 +837,7 @@ 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