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

TAChart: Extract TADrawUtils unit

Browse Source 
git-svn-id: trunk@26686 -
This commit is contained in:
ask 2010-07-16 14:12:55 +00:00
parent 6085c465cd
commit be405ec70a
14 changed files with 175 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -2200,6 +2200,7 @@ components/tachart/tachartlazaruspkg.pas svneol=native#text/plain
components/tachart/tachartutils.pas svneol=native#text/plain
components/tachart/tacustomseries.pas svneol=native#text/plain
components/tachart/tadbsource.pas svneol=native#text/pascal
components/tachart/tadrawutils.pas svneol=native#text/pascal
components/tachart/tagraph.lrs svneol=native#text/pascal
components/tachart/tagraph.pas svneol=native#text/plain
components/tachart/talegend.pas svneol=native#text/plain

10
components/tachart/demo/axis/axisdemo.lpi
View File

@ -54,11 +54,16 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="9"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)\"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
</CodeGeneration>
@ -72,6 +77,9 @@
</Linking>
<Other>
<WriteFPCLogo Value="False"/>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>

2
components/tachart/tachartaxis.pas
View File

@ -202,7 +202,7 @@ type
implementation
uses
LResources, Math;
LResources, Math, TADrawUtils;
const
FONT_SLOPE_VERTICAL = 45 * 10;

6
components/tachart/tachartlazaruspkg.lpk
View File

@ -25,7 +25,7 @@
for details about the copyright.
"/>
<Version Major="1"/>
<Files Count="12">
<Files Count="13">
<Item1>
<Filename Value="tachartaxis.pas"/>
<UnitName Value="TAChartAxis"/>
@ -80,6 +80,10 @@
<Filename Value="tatypes.pas"/>
<UnitName Value="TATypes"/>
</Item12>
<Item13>
<Filename Value="tadrawutils.pas"/>
<UnitName Value="TADrawUtils"/>
</Item13>
</Files>
<LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc\"/>
<Type Value="RunAndDesignTime"/>

2
components/tachart/tachartlazaruspkg.pas
View File

@ -9,7 +9,7 @@ interface
uses
TAChartAxis, TAChartUtils, TACustomSeries, TADbSource, TAGraph, TASeries,
TASeriesEditor, TASources, TASubcomponentsEditor, TATools,
TATransformations, TATypes, LazarusPackageIntf;
TATransformations, TATypes, TADrawUtils, LazarusPackageIntf;
implementation

117
components/tachart/tachartutils.pas
View File

@ -29,13 +29,9 @@ unit TAChartUtils;
interface
uses
Classes, Graphics, Math, Types, SysUtils;
Classes, Math, Types, SysUtils;
const
Colors: array [1..15] of TColor = (
clRed, clGreen, clYellow, clBlue, clWhite, clGray, clFuchsia,
clTeal, clNavy, clMaroon, clLime, clOlive, clPurple, clSilver, clAqua);
clTAColor = clScrollBar;
CHART_COMPONENT_IDE_PAGE = 'Chart';
PERCENT = 0.01;
@ -64,8 +60,6 @@ type
TAxisScale = (asIncreasing, asDecreasing, asLogIncreasing, asLogDecreasing);
TPenBrushFont = set of (pbfPen, pbfBrush, pbfFont);
TSeriesMarksStyle = (
smsCustom, { user-defined }
smsNone, { no labels }
@ -83,20 +77,6 @@ type
psNone, psRectangle, psCircle, psCross, psDiagCross, psStar,
psLowBracket, psHighBracket, psLeftBracket, psRightBracket, psDiamond);
{ TPenBrushFontRecall }
TPenBrushFontRecall = class
private
FBrush: TBrush;
FCanvas: TCanvas;
FFont: TFont;
FPen: TPen;
public
constructor Create(ACanvas: TCanvas; AParams: TPenBrushFont);
destructor Destroy; override;
procedure Recall;
end;
TDoubleInterval = record
FStart, FEnd: Double;
end;
@ -195,9 +175,6 @@ function BoundsSize(ALeft, ATop: Integer; ASize: TSize): TRect; inline;
function DoublePoint(AX, AY: Double): TDoublePoint; inline;
function DoubleRect(AX1, AY1, AX2, AY2: Double): TDoubleRect; inline;
procedure DrawLineDepth(ACanvas: TCanvas; AX1, AY1, AX2, AY2, ADepth: Integer);
procedure DrawLineDepth(ACanvas: TCanvas; const AP1, AP2: TPoint; ADepth: Integer);
procedure EnsureOrder(var A, B: Integer); overload; inline;
procedure EnsureOrder(var A, B: Double); overload; inline;
@ -221,16 +198,11 @@ function PointDist(const A, B: TPoint): Integer; inline;
function PointDistX(const A, B: TPoint): Integer; inline;
function PointDistY(const A, B: TPoint): Integer; inline;
procedure PrepareSimplePen(ACanvas: TCanvas; AColor: TColor);
procedure PrepareXorPen(ACanvas: TCanvas);
function RectIntersectsRect(
var ARect: TDoubleRect; const AFixed: TDoubleRect): Boolean;
function RoundChecked(A: Double): Integer; inline;
function TypicalTextHeight(ACanvas: TCanvas): Integer;
// Call this to silence 'parameter is unused' hint
procedure Unused(const A1);
procedure Unused(const A1, A2);
@ -246,9 +218,6 @@ operator =(const A, B: TMethod): Boolean; overload; inline;
implementation
uses
LCLIntf;
function BoundsSize(ALeft, ATop: Integer; ASize: TSize): TRect; inline;
begin
Result := Bounds(ALeft, ATop, ASize.cx, ASize.cy);
@ -338,20 +307,6 @@ begin
Result.b.Y := AY2;
end;
procedure DrawLineDepth(ACanvas: TCanvas; AX1, AY1, AX2, AY2, ADepth: Integer);
begin
DrawLineDepth(ACanvas, Point(AX1, AY1), Point(AX2, AY2), ADepth);
end;
procedure DrawLineDepth(
ACanvas: TCanvas; const AP1, AP2: TPoint; ADepth: Integer);
var
d: TSize;
begin
d := Size(ADepth, -ADepth);
ACanvas.Polygon([AP1, AP1 + d, AP2 + d, AP2]);
end;
procedure EnsureOrder(var A, B: Integer); overload; inline;
begin
if A > B then
@ -532,27 +487,6 @@ begin
Result := Abs(A.Y - B.Y);
end;
procedure PrepareSimplePen(ACanvas: TCanvas; AColor: TColor);
begin
with ACanvas.Pen do begin
Color := AColor;
Style := psSolid;
Mode := pmCopy;
Width := 1;
end;
end;
procedure PrepareXorPen(ACanvas: TCanvas);
begin
with ACanvas do begin
Brush.Style := bsClear;
Pen.Style := psSolid;
Pen.Mode := pmXor;
Pen.Color := clWhite;
Pen.Width := 1;
end;
end;
function RectIntersectsRect(
var ARect: TDoubleRect; const AFixed: TDoubleRect): Boolean;
@ -577,13 +511,6 @@ begin
Result := Round(EnsureRange(A, -MaxInt, MaxInt));
end;
function TypicalTextHeight(ACanvas: TCanvas): Integer;
const
TYPICAL_TEXT = 'Iy';
begin
Result := ACanvas.TextHeight(TYPICAL_TEXT);
end;
{$HINTS OFF}
procedure Unused(const A1);
begin
@ -637,48 +564,6 @@ begin
Result := (A.Code = B.Code) and (A.Data = B.Data);
end;
{ TPenBrushFontRecall }
constructor TPenBrushFontRecall.Create(ACanvas: TCanvas; AParams: TPenBrushFont);
begin
inherited Create;
FCanvas := ACanvas;
if pbfPen in AParams then begin
FPen := TPen.Create;
FPen.Assign(FCanvas.Pen);
end;
if pbfBrush in AParams then begin
FBrush := TBrush.Create;
FBrush.Assign(FCanvas.Brush);
end;
if pbfFont in AParams then begin
FFont := TFont.Create;
FFont.Assign(FCanvas.Font);
end;
end;
destructor TPenBrushFontRecall.Destroy;
begin
Recall;
inherited;
end;
procedure TPenBrushFontRecall.Recall;
begin
if FPen <> nil then begin
FCanvas.Pen.Assign(FPen);
FreeAndNil(FPen);
end;
if FBrush <> nil then begin
FCanvas.Brush.Assign(FBrush);
FreeAndNil(FBrush);
end;
if FFont <> nil then begin
FCanvas.Font.Assign(FFont);
FreeAndNil(FFont);
end;
end;
{ TIntervalList }
procedure TIntervalList.AddPoint(APoint: Double); inline;

2
components/tachart/tacustomseries.pas
View File

@ -24,7 +24,7 @@ interface
uses
Classes, Graphics, SysUtils,
TAChartUtils, TAGraph, TASources, TATypes;
TAChartUtils, TADrawUtils, TAGraph, TASources, TATypes;
const
DEF_AXIS_INDEX = -1;

147
components/tachart/tadrawutils.pas Normal file
View File

@ -0,0 +1,147 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Authors: Alexander Klenin
}
unit TADrawUtils;
{$mode objfpc}{$H+}
interface
uses
Classes, Graphics, SysUtils;
const
Colors: array [1..15] of TColor = (
clRed, clGreen, clYellow, clBlue, clWhite, clGray, clFuchsia,
clTeal, clNavy, clMaroon, clLime, clOlive, clPurple, clSilver, clAqua);
clTAColor = clScrollBar;
type
TPenBrushFont = set of (pbfPen, pbfBrush, pbfFont);
{ TPenBrushFontRecall }
TPenBrushFontRecall = class
private
FBrush: TBrush;
FCanvas: TCanvas;
FFont: TFont;
FPen: TPen;
public
constructor Create(ACanvas: TCanvas; AParams: TPenBrushFont);
destructor Destroy; override;
procedure Recall;
end;
procedure DrawLineDepth(ACanvas: TCanvas; AX1, AY1, AX2, AY2, ADepth: Integer);
procedure DrawLineDepth(ACanvas: TCanvas; const AP1, AP2: TPoint; ADepth: Integer);
procedure PrepareSimplePen(ACanvas: TCanvas; AColor: TColor);
procedure PrepareXorPen(ACanvas: TCanvas);
function TypicalTextHeight(ACanvas: TCanvas): Integer;
implementation
uses
Types, TAChartUtils;
procedure DrawLineDepth(ACanvas: TCanvas; AX1, AY1, AX2, AY2, ADepth: Integer);
begin
DrawLineDepth(ACanvas, Point(AX1, AY1), Point(AX2, AY2), ADepth);
end;
procedure DrawLineDepth(
ACanvas: TCanvas; const AP1, AP2: TPoint; ADepth: Integer);
var
d: TSize;
begin
d := Size(ADepth, -ADepth);
ACanvas.Polygon([AP1, AP1 + d, AP2 + d, AP2]);
end;
procedure PrepareSimplePen(ACanvas: TCanvas; AColor: TColor);
begin
with ACanvas.Pen do begin
Color := AColor;
Style := psSolid;
Mode := pmCopy;
Width := 1;
end;
end;
procedure PrepareXorPen(ACanvas: TCanvas);
begin
with ACanvas do begin
Brush.Style := bsClear;
Pen.Style := psSolid;
Pen.Mode := pmXor;
Pen.Color := clWhite;
Pen.Width := 1;
end;
end;
function TypicalTextHeight(ACanvas: TCanvas): Integer;
const
TYPICAL_TEXT = 'Iy';
begin
Result := ACanvas.TextHeight(TYPICAL_TEXT);
end;
{ TPenBrushFontRecall }
constructor TPenBrushFontRecall.Create(ACanvas: TCanvas; AParams: TPenBrushFont);
begin
inherited Create;
FCanvas := ACanvas;
if pbfPen in AParams then begin
FPen := TPen.Create;
FPen.Assign(FCanvas.Pen);
end;
if pbfBrush in AParams then begin
FBrush := TBrush.Create;
FBrush.Assign(FCanvas.Brush);
end;
if pbfFont in AParams then begin
FFont := TFont.Create;
FFont.Assign(FCanvas.Font);
end;
end;
destructor TPenBrushFontRecall.Destroy;
begin
Recall;
inherited;
end;
procedure TPenBrushFontRecall.Recall;
begin
if FPen <> nil then begin
FCanvas.Pen.Assign(FPen);
FreeAndNil(FPen);
end;
if FBrush <> nil then begin
FCanvas.Brush.Assign(FBrush);
FreeAndNil(FBrush);
end;
if FFont <> nil then begin
FCanvas.Font.Assign(FFont);
FreeAndNil(FFont);
end;
end;
end.

2
components/tachart/tagraph.pas
View File

@ -322,7 +322,7 @@ var
implementation
uses
Clipbrd, GraphMath, LCLProc, Math, Types;
Clipbrd, GraphMath, LCLProc, Math, Types, TADrawUtils;
{$IFOPT R+}{$DEFINE RangeChecking}{$ELSE}{$UNDEF RangeChecking}{$ENDIF}
{$IFOPT Q+}{$DEFINE OverflowChecking}{$ELSE}{$UNDEF OverflowChecking}{$ENDIF}

2
components/tachart/talegend.pas
View File

@ -113,7 +113,7 @@ type
implementation
uses
Math, Types;
Math, Types, TADrawUtils;
const
SYMBOL_TEXT_SPACING = 4;

2
components/tachart/taseries.pas
View File

@ -30,7 +30,7 @@ interface
uses
Classes, Graphics,
TAChartUtils, TACustomSeries, TAGraph, TALegend, TATypes;
TAChartUtils, TADrawUtils, TACustomSeries, TAGraph, TALegend, TATypes;
const
DEF_BAR_WIDTH_PERCENT = 70;

2
components/tachart/tasources.pas
View File

@ -22,7 +22,7 @@ unit TASources;
interface
uses
Classes, Graphics, SysUtils, Types, TAChartUtils;
Classes, Graphics, SysUtils, Types, TAChartUtils, TADrawUtils;
type
EEditableSourceRequired = class(EChartError);

2
components/tachart/tatools.pas
View File

@ -219,7 +219,7 @@ implementation
uses
ComponentEditors, Forms, GraphMath, Math, PropEdits, SysUtils,
TAChartUtils, TASubcomponentsEditor;
TAChartUtils, TADrawUtils, TASubcomponentsEditor;
{$IFOPT R+}{$DEFINE RangeChecking}{$ELSE}{$UNDEF RangeChecking}{$ENDIF}
{$IFOPT Q+}{$DEFINE OverflowChecking}{$ELSE}{$UNDEF OverflowChecking}{$ENDIF}

5
components/tachart/test/test.lpr
View File

@ -22,9 +22,12 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, Interfaces,
Classes, SysUtils, CustApp,
FPCUnit, TestReport, TestRegistry, PlainTestReport, UtilsTest;
// This is deliberately a console application to also test a proper
// separation of logic and presentation in TAChart units.
type
{ TAChartTests }