Merged revision(s) 51383 #9f13b0b11a, 52335 #11f4712b8d, 52339-52340 #11f4b132d1-#11f4b132d1, 52346-52347 #cc9413a516-#cc9413a516, 52389 #55188988d4, 52391 #c51bc87bab from trunk:

tachart: fix compiling for the coming TRect advanced functions in FPC 3.1.1 (see issue #29479)
........
TAChart: Add missing declaration of PutPixel to TOpenGLDrawer.
........
TAChart: Remove path to TADrawerOpenGl from opengl demo.
........
TAChart: Fix pen style and pen width in OpenGL drawer.
........
TAChart: Set "AddToUsesPkgSection" flag of TADrawerOpenGL to false (had been changed in r52340 #c3114ad322, resolves issue #0030169)
........
TAChart: Fix missing initialization of glut library in opengl demo.
........
TAChart: Publish event OnContextPopup
........
TAChart: Avoid chart popup menu opening at the end of a pan-drag operation with right mouse button.
........

git-svn-id: branches/fixes_1_6@52456 -
This commit is contained in:
maxim 2016-06-08 22:14:11 +00:00
parent d1fb44a761
commit b7a6b2c951
6 changed files with 85 additions and 10 deletions

View File

@ -2,16 +2,17 @@ object Form1: TForm1
Left = 308
Height = 319
Top = 132
Width = 684
Width = 688
Caption = 'Form1'
ClientHeight = 319
ClientWidth = 684
LCLVersion = '1.1'
ClientWidth = 688
OnCreate = FormCreate
LCLVersion = '1.7'
object OpenGLControl1: TOpenGLControl
Left = 344
Height = 319
Top = 0
Width = 340
Width = 344
Align = alClient
AutoResizeViewport = True
OnPaint = OpenGLControl1Paint
@ -45,7 +46,6 @@ object Form1: TForm1
OnAfterPaint = Chart1AfterPaint
Align = alLeft
Color = clSkyBlue
ParentColor = False
object Chart1LineSeries1: TLineSeries
LinePen.Color = clBlue
LinePen.Width = 3

View File

@ -20,6 +20,7 @@ type
OpenGLControl1: TOpenGLControl;
RandomChartSource1: TRandomChartSource;
procedure Chart1AfterPaint(ASender: TChart);
procedure FormCreate(Sender: TObject);
procedure OpenGLControl1Paint(Sender: TObject);
end;
@ -31,13 +32,27 @@ implementation
{$R *.lfm}
uses
TADrawUtils, TADrawerOpenGL in '..\..\TADrawerOpenGL.pas', TADrawerCanvas;
glut, TADrawUtils, TADrawerOpenGL in '../../tadraweropengl.pas', TADrawerCanvas;
procedure TForm1.Chart1AfterPaint(ASender: TChart);
begin
OpenGLControl1.Invalidate;
end;
{ Initialization of glut library, needed for text output }
procedure TForm1.FormCreate(Sender: TObject);
var
CmdCount : Integer;
Cmd : Array of Pchar;
I: Integer;
begin
CmdCount := Paramcount+1;
SetLength(Cmd,CmdCount);
for I := 0 to CmdCount - 1 do
Cmd[I] := PChar(ParamStr(I));
glutInit (@CmdCount,@Cmd);
end;
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
var
d: IChartDrawer;

View File

@ -30,6 +30,7 @@ type
FPenWidth: Integer;
FPos: TPoint;
procedure ChartGLColor(AColor: TFPColor);
procedure ChartGLPenStyle(APenStyle: TFPPenStyle);
procedure InternalPolyline(
const APoints: array of TPoint; AStartIndex, ANumPts, AMode: Integer);
procedure SetBrush(ABrush: TFPCustomBrush);
@ -56,6 +57,7 @@ type
procedure Polyline(
const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
procedure PrepareSimplePen(AColor: TChartColor);
procedure PutPixel(AX, AY: Integer; AColor: TChartColor); override;
procedure RadialPie(
AX1, AY1, AX2, AY2: Integer;
AStartAngle16Deg, AAngleLength16Deg: Integer);
@ -88,6 +90,27 @@ begin
glColor4us(red, green, blue, (255 - FTransparency) shl 8);
end;
procedure TOpenGLDrawer.ChartGLPenStyle(APenStyle: TFPPenStyle);
var
pattern: Word;
begin
case APenStyle of
psClear : pattern := %0000000000000000;
psDot : pattern := %0011001100110011;
psDash : pattern := %0000000011111111;
psDashDot : pattern := %0001100011111111;
psDashDotDot : pattern := %0001101100111111;
else
glDisable(GL_LINE_STIPPLE); // --> psSolid
exit;
// psPattern will render as psSolid because there are differences in
// implementations between fpc and lcl.
// psInsideFrame will render as psSolid - I don't know what this is...
end;
glLineStipple(1, pattern);
glEnable(GL_LINE_STIPPLE);
end;
procedure TOpenGLDrawer.ClippingStart(const AClipRect: TRect);
type
TGLClipPlaneEqn = record A, B, C, D: GLdouble; end;
@ -156,9 +179,8 @@ var
i: Integer;
begin
if FPenStyle = psClear then exit;
glBegin(AMode);
ChartGLColor(FPenColor);
glLineWidth(FPenWidth);
glBegin(AMode);
for i := AStartIndex to AStartIndex + ANumPts - 1 do
glVertex2iv(@APoints[i]);
glEnd();
@ -169,7 +191,6 @@ begin
if FPenStyle = psClear then exit;
glBegin(GL_LINES);
ChartGLColor(FPenColor);
glLineWidth(FPenWidth);
glVertex2i(AX1, AY1);
glVertex2i(AX2, AY2);
glEnd();
@ -300,12 +321,15 @@ begin
FPenWidth := APen.Width;
FPenColor := APen.FPColor;
FPenStyle := APen.Style;
glLineWidth(FPenWidth);
ChartGLPenStyle(FPenStyle);
end;
procedure TOpenGLDrawer.SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor);
begin
FPenStyle := AStyle;
FPenColor := FChartColorToFPColorFunc(AColor);
ChartGLPenStyle(AStyle);
end;
procedure TOpenGLDrawer.SetTransparency(ATransparency: TChartTransparency);

View File

@ -101,9 +101,11 @@ type
TBasicChartTool = class(TIndexedComponent)
strict protected
FChart: TChart;
FStartMousePos: TPoint;
procedure Activate; virtual;
procedure Deactivate; virtual;
function PopupMenuConflict: Boolean; virtual;
public
property Chart: TChart read FChart;
end;
@ -268,6 +270,8 @@ type
procedure VisitSources(
AVisitor: TChartOnSourceVisitor; AAxis: TChartAxis; var AData);
protected
FDisablePopupMenu: Boolean;
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
function DoMouseWheel(
AShift: TShiftState; AWheelDelta: Integer;
AMousePos: TPoint): Boolean; override;
@ -435,6 +439,7 @@ type
published
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
@ -793,6 +798,12 @@ begin
AxisList.Draw(MaxInt, axisIndex);
end;
procedure TChart.DoContextPopup(MousePos: TPoint; var Handled: Boolean);
begin
if FDisablePopupMenu then Handled := true;
inherited;
end;
function TChart.DoMouseWheel(
AShift: TShiftState; AWheelDelta: Integer; AMousePos: TPoint): Boolean;
const
@ -1873,12 +1884,21 @@ procedure TBasicChartTool.Activate;
begin
FChart.FActiveToolIndex := Index;
FChart.MouseCapture := true;
FChart.FDisablePopupMenu := false;
FStartMousePos := Mouse.CursorPos;
end;
procedure TBasicChartTool.Deactivate;
begin
FChart.MouseCapture := false;
FChart.FActiveToolIndex := -1;
if PopupMenuConflict then
FChart.FDisablePopupMenu := true;
end;
function TBasicChartTool.PopupMenuConflict: Boolean;
begin
Result := false;
end;
procedure SkipObsoleteChartProperties;

View File

@ -1018,7 +1018,7 @@ var
with imageBar do begin
TopLeft := ParentChart.GraphToImage(graphBar.a);
BottomRight := ParentChart.GraphToImage(graphBar.b);
NormalizeRect(imageBar);
TAGeometry.NormalizeRect(imageBar);
// Draw a line instead of an empty rectangle.
if Bottom = Top then Dec(Top);

View File

@ -69,6 +69,7 @@ type
procedure MouseUp(APoint: TPoint); virtual;
procedure MouseWheelDown(APoint: TPoint); virtual;
procedure MouseWheelUp(APoint: TPoint); virtual;
function PopupMenuConflict: Boolean; override;
procedure PrepareDrawingModePen(ADrawer: IChartDrawer; APen: TFPCustomPen);
procedure RestoreCursor;
procedure SetCursor;
@ -835,6 +836,21 @@ begin
Unused(APoint);
end;
function TChartTool.PopupMenuConflict: Boolean;
var
P: TPoint;
begin
Result := false;
if Shift = [ssRight] then begin
P := Mouse.CursorPos;
if (P.X = FStartMousePos.X) then
exit;
if (P.Y = FStartMousePos.Y) then
exit;
Result := true;
end;
end;
procedure TChartTool.PrepareDrawingModePen(
ADrawer: IChartDrawer; APen: TFPCustomPen);
begin