mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-20 12:19:31 +02:00
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:
parent
d1fb44a761
commit
b7a6b2c951
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user