paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-24 04:45:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

customdrawn: Starts improving the scrollbar move and fixes a bug in the common frame draw routine

Browse Source 
git-svn-id: trunk@34052 -
This commit is contained in:
sekelsenmat 2011-12-08 17:30:11 +00:00
parent f0cd76b3a5
commit c526606ce5
2 changed files with 80 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/customdrawn_common.pas
View File

@ -324,7 +324,7 @@ begin
ADest.Pen.Color := WIN2000_FRAME_WHITE;
ADest.MoveTo(ADestPos.X, ADestPos.Y+ASize.cy-1);
ADest.LineTo(ADestPos.X, ADestPos.Y);
ADest.LineTo(ADestPos.X+ASize.cy-1, ADestPos.Y);
ADest.LineTo(ADestPos.X+ASize.cx-1, ADestPos.Y);
// Grey line on the inside left and top
ADest.Pen.Color := WIN2000_FRAME_LIGHT_GRAY;
ADest.MoveTo(ADestPos.X+1, ADestPos.Y+ASize.cy-2);

88
lcl/customdrawncontrols.pas
View File

@ -267,6 +267,8 @@ type
TCDPositionedControl = class(TCDControl)
private
DragDropStarted: boolean;
FLastMouseDownPos: TPoint;
FPositionAtMouseDown: Integer;
FButton: TCDControlState; // the button currently being clicked
FBtnClickTimer: TTimer;
// fields
@ -284,9 +286,15 @@ type
protected
FSmallChange, FLargeChange: Integer;
FPCState: TCDPositionedCStateEx;
// One can either move by dragging the slider
// or by putting the slider where the mouse is
FMoveByDragging: Boolean;
function GetPositionFromMousePosWithMargins(X, Y, ALeftMargin, ARightMargin: Integer;
AIsHorizontal, AAcceptMouseOutsideStrictArea: Boolean): integer;
function GetPositionFromMousePos(X, Y: Integer): integer; virtual; abstract;
function GetPositionDisplacementWithMargins(AOldMousePos, ANewMousePos: TPoint;
ALeftMargin, ARightMargin: Integer; AIsHorizontal: Boolean): Integer;
function GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint): Integer; virtual; abstract;
function GetButtonFromMousePos(X, Y: Integer): TCDControlState; virtual;
procedure CreateControlStateEx; override;
procedure PrepareControlStateEx; override;
@ -318,6 +326,7 @@ type
protected
function GetPositionFromMousePos(X, Y: Integer): integer; override;
function GetButtonFromMousePos(X, Y: Integer): TCDControlState; override;
function GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint): Integer; override;
function GetControlId: TCDControlID; override;
procedure PrepareControlState; override;
public
@ -416,6 +425,7 @@ type
procedure SetOrientation(AValue: TTrackBarOrientation);
protected
function GetPositionFromMousePos(X, Y: Integer): integer; override;
function GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint): Integer; override;
function GetControlId: TCDControlID; override;
procedure PrepareControlState; override;
public
@ -1771,13 +1781,13 @@ begin
if lCoord > lSize - ARightMargin then
begin
if AAcceptMouseOutsideStrictArea then Result := FMax
else Exit;
if AAcceptMouseOutsideStrictArea then Result := FMax;
Exit;
end
else if lCoord < ALeftMargin then
begin
if AAcceptMouseOutsideStrictArea then Result := FMin
else Exit;
if AAcceptMouseOutsideStrictArea then Result := FMin;
Exit;
end
else Result := FMin + (lCoord - ALeftMargin) * (FMax - FMin + 1) div (lSize - ARightMargin - ALeftMargin);
@ -1786,6 +1796,30 @@ begin
if Result < FMin then Result := FMin;
end;
function TCDPositionedControl.GetPositionDisplacementWithMargins(AOldMousePos,
ANewMousePos: TPoint; ALeftMargin, ARightMargin: Integer; AIsHorizontal: Boolean): Integer;
var
lCoord, lSize: Integer;
begin
if AIsHorizontal then
begin
lCoord := ANewMousePos.X-AOldMousePos.X;
lSize := Width;
end
else
begin
lCoord := ANewMousePos.Y-AOldMousePos.Y;
lSize := Height;
end;
Result := FMin + (lCoord - ALeftMargin) * (FMax - FMin + 1) div (lSize - ARightMargin - ALeftMargin);
Result := FPositionAtMouseDown + Result;
// sanity check
if Result > FMax then Result := FMax;
if Result < FMin then Result := FMin;
end;
function TCDPositionedControl.GetButtonFromMousePos(X, Y: Integer): TCDControlState;
begin
Result := [];
@ -1843,9 +1877,18 @@ var
NewPosition: Integer;
begin
SetFocus;
NewPosition := GetPositionFromMousePos(X, Y);
DragDropStarted := True;
if NewPosition >= 0 then Position := NewPosition;
if FMoveByDragging then
begin
FLastMouseDownPos := Point(X, Y);
FPositionAtMouseDown := Position;
DragDropStarted := True;
end
else
begin
NewPosition := GetPositionFromMousePos(X, Y);
DragDropStarted := True;
if NewPosition >= 0 then Position := NewPosition;
end;
// Check if any buttons were clicked
FButton := GetButtonFromMousePos(X, Y);
@ -1865,8 +1908,16 @@ var
begin
if DragDropStarted then
begin
NewPosition := GetPositionFromMousePos(X, Y);
if NewPosition > 0 then Position := NewPosition;
if FMoveByDragging then
begin
NewPosition := FPositionAtMouseDown + GetPositionDisplacement(FLastMouseDownPos, Point(X, Y));
Position := NewPosition;
end
else
begin
NewPosition := GetPositionFromMousePos(X, Y);
if NewPosition >= 0 then Position := NewPosition;
end;
end;
inherited MouseMove(Shift, X, Y);
end;
@ -1947,6 +1998,18 @@ begin
FDrawer.GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH)) then Result := [csfRightArrow];
end;
function TCDScrollBar.GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint
): Integer;
var
lLeftBorder, lRightBorder: Integer;
begin
lLeftBorder := FDrawer.GetMeasures(TCDSCROLLBAR_LEFT_SPACING);
lRightBorder := FDrawer.GetMeasures(TCDSCROLLBAR_RIGHT_SPACING);
Result := GetPositionDisplacementWithMargins(AOldMousePos, ANewMousePos,
lLeftBorder, lRightBorder, FKind = sbHorizontal);
end;
function TCDScrollBar.GetControlId: TCDControlID;
begin
Result:= cidScrollBar;
@ -1967,6 +2030,7 @@ begin
Width := 121;
Height := 17;
FMax := 100;
FMoveByDragging := True;
end;
destructor TCDScrollBar.Destroy;
@ -2061,6 +2125,12 @@ begin
Result := GetPositionFromMousePosWithMargins(X, Y, lLeftBorder, lRightBorder, FOrientation = trHorizontal, True);
end;
function TCDTrackBar.GetPositionDisplacement(AOldMousePos, ANewMousePos: TPoint
): Integer;
begin
Result := 0; // not used anyway
end;
function TCDTrackBar.GetControlId: TCDControlID;
begin
Result := cidTrackBar;