paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-15 14:29:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: make the new TArrow code as default. NewArrow define is not needed.

Browse Source 
git-svn-id: trunk@40964 -
This commit is contained in:
juha 2013-05-01 08:44:31 +00:00
parent 05929ec254
commit f59a82f602
4 changed files with 0 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
lcl/interfaces/qt/qtwsarrow.pp
View File

@ -48,9 +48,6 @@ type
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType); override;
{$IFnDEF NewArrow}
class procedure DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas); override;
{$ENDIF}
end;
@ -97,38 +94,4 @@ begin
QtArrow.ArrowType := Ord(AArrowType);
end;
{$IFnDEF NewArrow}
class procedure TQtWSArrow.DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas);
const
QtArrowTypeMap: array[TArrowType] of QStylePrimitiveElement =
(
{atUp } QStylePE_IndicatorArrowUp,
{atDown } QStylePE_IndicatorArrowDown,
{atLeft } QStylePE_IndicatorArrowLeft,
{atRight} QStylePE_IndicatorArrowRight
);
var
DC: TQtDeviceContext;
ARect: TRect;
StyleOption: QStyleOptionH;
begin
DC := TQtDeviceContext(ACanvas.Handle);
ARect := AArrow.ClientRect;
StyleOption := QStyleOption_create(QStyleOptionVersion, QStyleOptionSO_Default);
try
// I do not know the reason, but under windows down arrow size is very small
// and is not dependent on passed ARect.
// There is nothing in qt source that can cause such bad painting.
// Other styles draw down arrow very well.
QStyleOption_initFrom(StyleOption, DC.Parent);
QStyleOption_setRect(StyleOption, @ARect);
QStyle_drawPrimitive(QApplication_style, QtArrowTypeMap[AArrow.ArrowType],
StyleOption, DC.Widget, DC.Parent);
finally
QStyleOption_destroy(StyleOption);
end;
end;
{$ENDIF}
end.

23
lcl/interfaces/win32/win32wsarrow.pp
View File

@ -45,9 +45,6 @@ type
published
class procedure SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType); override;
{$IFnDEF NewArrow}
class procedure DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas); override;
{$ENDIF}
end;
@ -61,24 +58,4 @@ begin
// TODO: implement me!
end;
{$IFnDEF NewArrow}
class procedure TWin32WSArrow.DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas);
const
ArrowTypeToState: array[TArrowType] of dword = // up, down, left, right
(DFCS_SCROLLUP, DFCS_SCROLLDOWN, DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT);
var
drawRect: Windows.RECT;
canvasHandle: HDC;
begin
drawRect := AArrow.ClientRect;
canvasHandle := ACanvas.Handle;
Windows.FillRect(canvasHandle, drawRect, GetSysColorBrush(COLOR_BTNFACE));
dec(drawRect.Left, 2);
dec(drawRect.Top, 2);
inc(drawRect.Right, 2);
inc(drawRect.Bottom, 2);
Windows.DrawFrameControl(canvasHandle, drawRect, DFC_SCROLL, ArrowTypeToState[AArrow.ArrowType]);
end;
{$ENDIF}
end.

23
lcl/interfaces/wince/wincewsarrow.pp
View File

@ -41,9 +41,6 @@ type
published
class procedure SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType); override;
{$IFnDEF NewArrow}
class procedure DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas); override;
{$ENDIF}
end;
@ -57,24 +54,4 @@ begin
// TODO: implement me!
end;
{$IFnDEF NewArrow}
class procedure TWinCEWSArrow.DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas);
const
ArrowTypeToState: array[TArrowType] of dword = // up, down, left, right
(DFCS_SCROLLUP, DFCS_SCROLLDOWN, DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT);
var
drawRect: Windows.RECT;
canvasHandle: HDC;
begin
drawRect := AArrow.ClientRect;
canvasHandle := ACanvas.Handle;
Windows.FillRect(canvasHandle, drawRect, GetSysColorBrush(COLOR_BTNFACE or SYS_COLOR_INDEX_FLAG));
dec(drawRect.Left, 2);
dec(drawRect.Top, 2);
inc(drawRect.Right, 2);
inc(drawRect.Bottom, 2);
Windows.DrawFrameControl(canvasHandle, @drawRect, DFC_SCROLL, ArrowTypeToState[AArrow.ArrowType]);
end;
{$ENDIF}
end.

48
lcl/widgetset/wsarrow.pp
View File

@ -72,7 +72,6 @@ class procedure TWSArrow.SetType(const AArrow: TArrow; const AArrowType: TArrowT
begin
end;
{$IFDEF NewArrow}
class procedure TWSArrow.DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas);
const
SpaceFactor = 5;
@ -151,53 +150,6 @@ begin
end;
end;
{$ELSE}
class procedure TWSArrow.DrawArrow(const AArrow: TArrow; const ACanvas: TCanvas);
var
P: Array [0..2] of TPoint;
R: TRect;
S: Integer;
begin
R := AArrow.ClientRect;
InflateRect(R, -1, -1);
// arrow bounds are square
S := Min(R.Right - R.Left, R.Bottom - R.Top);
R := Bounds((R.Left + R.Right - S) div 2, (R.Top + R.Bottom - S) div 2, S, S);
ACanvas.Brush.Color := clBlack;
ACanvas.Pen.Color := clBlack;
case Ord(AArrow.ArrowType) of
0: // up
begin
P[0] := Point(R.Left, R.Bottom);
P[1] := Point((R.Left + R.Right) div 2, R.Top);
P[2] := R.BottomRight;
end;
1: // down
begin
P[0] := R.TopLeft;
P[1] := Point(R.Right, R.Top);
P[2] := Point((R.Left + R.Right) div 2, R.Bottom);
end;
2: // left
begin
P[0] := R.BottomRight;
P[1] := Point(R.Left, (R.Top + R.Bottom) div 2);
P[2] := Point(R.Right, R.Top);
end;
3: // right
begin
P[0] := R.TopLeft;
P[1] := Point(R.Right, (R.Top + R.Bottom) div 2);
P[2] := Point(R.Left, R.Bottom);
end;
end;
ACanvas.Polygon(P);
end;
{$ENDIF}
{ WidgetSetRegistration }
procedure RegisterArrow;