pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Fixed draging bugs and add mouseup for draging.

Browse Source 
MouseDown then MouseMove means draging so mouseup not means colorpick.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1582 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
yangjixian
2011-04-19 08:46:45 +00:00
parent 65eac79f62
commit 0fe7c1ebe5
1 changed files with 25 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
components/colorpalette/colorpalette.pas
View File

@ -65,6 +65,7 @@ type
FOnColorPick: TColorMouseEvent;
FRows: Integer;
FColors: TList;
MX, MY: integer;
function GetColors(Index: Integer): TColor;
procedure SetButtonHeight(const AValue: Integer);
procedure SetButtonWidth(const AValue: Integer);
@ -73,9 +74,12 @@ type
protected
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
procedure ColorPick(AColor: TColor; Shift: TShiftState); dynamic;
procedure ColorMouseMove(AColor: TColor; Shift: TShiftState); dynamic;
public
PickedColor: TColor;
PickShift: TShiftState;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
@ -174,21 +178,34 @@ end;
procedure TCustomColorPalette.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
C: TColor;
begin
inherited;
MX := X;
MY := Y;
X := X div FButtonWidth;
Y := Y div FButtonHeight;
// if X + Y * FCols < 0 then
// Exit;
if X + Y * FCols < FColors.Count then
begin
C := TColor(FColors.Items[X + Y * FCols]);
if C <> clNone then ColorPick(C, Shift);
PickedColor := TColor(FColors.Items[X + Y * FCols]);
//if PickedColor <> clNone then ColorPick(PickedColor, Shift);
PickShift := Shift;
end;
end;
procedure TCustomColorPalette.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (PickedColor <> clNone) and (MX = X) and (MY = Y) then
ColorPick(PickedColor, PickShift);
inherited;
end;
procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer);
var
C: TColor;
@ -198,6 +215,8 @@ begin
X := X div FButtonWidth;
Y := Y div FButtonHeight;
if X + Y * FCols < 0 then
Exit;
if X + Y * FCols < FColors.Count then
begin
C := TColor(FColors.Items[X + Y * FCols]);