?? winplot.pas
字號:
CheckPoint := not(XOutOfBounds(Xp) or YOutOfBounds(Yp));
end;
procedure PlotSymbol(Canvas : TCanvas;
Xp, Yp : Integer;
Symbol, Size : Integer);
{ Plots a symbol at pixel coordinates (Xp, Yp)
with the current canvas settings }
var
Xp1, Xp2, Yp1, Yp2 : Integer;
begin
if (Symbol < 0) or (Symbol > MAXSYMBOL) then Exit;
Size := Size * SymbolSizeUnit;
Xp1 := Xp - Size;
Yp1 := Yp - Size;
Xp2 := Xp + Size + 1;
Yp2 := Yp + Size + 1;
with Canvas do
case Symbol of
0 : Pixels[Xp, Yp] := Brush.Color;
1, 2 : Ellipse(Xp1, Yp1, Xp2, Yp2); { Circle }
3, 4 : Rectangle(Xp1, Yp1, Xp2, Yp2); { Square }
5, 6 : Polygon([Point(Xp1, Yp2 - 1),
Point(Xp2, Yp2 - 1),
Point(Xp, Yp1 - 1)]); { Triangle }
7 : begin { + }
MoveTo(Xp, Yp1);
LineTo(Xp, Yp2);
MoveTo(Xp1, Yp);
LineTo(Xp2, Yp);
end;
8 : begin { x }
MoveTo(Xp1, Yp1);
LineTo(Xp2, Yp2);
MoveTo(Xp1, Yp2 - 1);
LineTo(Xp2, Yp1 - 1);
end;
9 : begin { * }
MoveTo(Xp, Yp1);
LineTo(Xp, Yp2);
MoveTo(Xp1, Yp);
LineTo(Xp2, Yp);
MoveTo(Xp1, Yp1);
LineTo(Xp2, Yp2);
MoveTo(Xp1, Yp2 - 1);
LineTo(Xp2, Yp1 - 1);
end;
end;
end;
procedure PlotLine(Canvas : TCanvas;
Xp1, Yp1, Xp2, Yp2 : Integer);
{ Plots a line with the current canvas settings }
begin
Canvas.MoveTo(Xp1, Yp1);
Canvas.LineTo(Xp2, Yp2);
end;
procedure PlotPoint(Canvas : TCanvas;
X, Y : Float;
PointParam : TPointParam);
var
Xp, Yp : Integer;
BrushStyle : TBrushStyle;
PenColor, BrushColor : TColor;
begin
if XAxis.Scale = LOG_SCALE then X := Log10(X);
if YAxis.Scale = LOG_SCALE then Y := Log10(Y);
if not CheckPoint(X, Y, Xp, Yp) then Exit;
with Canvas do
begin
{ Save current settings }
PenColor := Pen.Color;
BrushColor := Brush.Color;
BrushStyle := Brush.Style;
Pen.Color := PointParam.Color;
Brush.Color := PointParam.Color;
if PointParam.Symbol in [0, 1, 3, 5] then
Brush.Style := bsSolid
else
Brush.Style := bsClear;
PlotSymbol(Canvas, Xp, Yp, PointParam.Symbol, PointParam.Size);
{ Restore settings }
Pen.Color := PenColor;
Brush.Color := BrushColor;
Brush.Style := BrushStyle;
end;
end;
procedure PlotErrorBar(Canvas : TCanvas;
Y, S : Float;
Ns : Integer;
Xp, Yp, Size : Integer);
{ Plots an error bar with the current canvas settings }
var
Delta, Y1 : Float;
Yp1 : Integer;
begin
Size := Size * SymbolSizeUnit;
Delta := Ns * S;
Y1 := Y - Delta;
if YAxis.Scale = LOG_SCALE then Y1 := Log10(Y1);
Yp1 := Ypixel(Y1);
if Yp1 <= YmaxPixel then
begin
PlotLine(Canvas, Xp - Size, Yp1, Xp + Size + 1, Yp1);
PlotLine(Canvas, Xp, Yp, Xp, Yp1);
end
else
PlotLine(Canvas, Xp, Yp, Xp, YmaxPixel);
Y1 := Y + Delta;
if YAxis.Scale = LOG_SCALE then Y1 := Log10(Y1);
Yp1 := Ypixel(Y1);
if Yp1 >= YminPixel then
begin
PlotLine(Canvas, Xp - Size, Yp1, Xp + Size + 1, Yp1);
PlotLine(Canvas, Xp, Yp, Xp, Yp1);
end
else
PlotLine(Canvas, Xp, Yp, Xp, YminPixel);
end;
procedure GenPlotCurve(Canvas : TCanvas;
X, Y, S : TVector;
Ns : Integer;
Lbound, Ubound : Integer;
CurvParam : TCurvParam;
ErrorBars : Boolean);
{ General curve plotting routine }
var
X1, Y1, X2, Y2 : Float;
Xp1, Yp1, Xp2, Yp2 : Integer;
I : Integer;
Flag1, Flag2 : Boolean;
PenWidth : Integer;
PenStyle : TpenStyle;
PenColor, BrushColor : TColor;
BrushStyle : TBrushStyle;
begin
with Canvas do
begin
{ Save current settings }
PenColor := Pen.Color;
PenStyle := Pen.Style;
PenWidth := Pen.Width;
BrushColor := Brush.Color;
BrushStyle := Brush.Style;
Pen.Color := CurvParam.LineParam.Color;
Pen.Style := CurvParam.LineParam.Style;
Pen.Width := CurvParam.LineParam.Width;
Brush.Color := CurvParam.PointParam.Color;
if CurvParam.PointParam.Symbol in [0, 1, 3, 5] then
Brush.Style := bsSolid
else
Brush.Style := bsClear;
{ Plot first point }
X1 := X[Lbound]; if XAxis.Scale = LOG_SCALE then X1 := Log10(X1);
Y1 := Y[Lbound]; if YAxis.Scale = LOG_SCALE then Y1 := Log10(Y1);
Flag1 := CheckPoint(X1, Y1, Xp1, Yp1);
if Flag1 then
begin
PlotSymbol(Canvas, Xp1, Yp1, CurvParam.PointParam.Symbol,
CurvParam.PointParam.Size);
if ErrorBars and (S[Lbound] > 0.0) then
PlotErrorBar(Canvas, Y[Lbound], S[Lbound], Ns, Xp1, Yp1,
CurvParam.PointParam.Size);
end;
{ Plot other points and connect them by lines if necessary }
I := Lbound + CurvParam.Step;
while I <= Ubound do
begin
X2 := X[I]; if XAxis.Scale = LOG_SCALE then X2 := Log10(X2);
Y2 := Y[I]; if YAxis.Scale = LOG_SCALE then Y2 := Log10(Y2);
Flag2 := CheckPoint(X2, Y2, Xp2, Yp2);
if Flag2 then
begin
PlotSymbol(Canvas, Xp2, Yp2, CurvParam.PointParam.Symbol,
CurvParam.PointParam.Size);
if ErrorBars and (S[I] > 0.0) then
PlotErrorBar(Canvas, Y[I], S[I], Ns, Xp2, Yp2,
CurvParam.PointParam.Size);
if CurvParam.Connect and Flag1 then
PlotLine(Canvas, Xp1, Yp1, Xp2, Yp2);
end;
Xp1 := Xp2;
Yp1 := Yp2;
Flag1 := Flag2;
Inc(I, CurvParam.Step);
end;
{ Restore settings }
Pen.Color := PenColor;
Pen.Style := PenStyle;
Pen.Width := PenWidth;
Brush.Color := BrushColor;
Brush.Style := BrushStyle;
end;
end;
procedure PlotCurve(Canvas : TCanvas;
X, Y : TVector;
Lbound, Ubound : Integer;
CurvParam : TCurvParam);
const
Ns = 0; { Dummy variables }
S = nil;
begin
GenPlotCurve(Canvas, X, Y, S, Ns, Lbound, Ubound, CurvParam, False);
end;
procedure PlotCurveWithErrorBars(Canvas : TCanvas;
X, Y, S : TVector;
Ns : Integer;
Lbound, Ubound : Integer;
CurvParam : TCurvParam);
begin
GenPlotCurve(Canvas, X, Y, S, Ns, Lbound, Ubound, CurvParam, True);
end;
procedure PlotFunc(Canvas : TCanvas;
Func : TFunc;
Xmin, Xmax : Float;
Npt : Integer;
LineParam : TLineParam);
var
PenColor : TColor;
PenStyle : TpenStyle;
PenWidth : Integer;
X1, Y1, X2, Y2, H : Float;
Xp1, Yp1, Xp2, Yp2 : Integer;
Flag1, Flag2 : Boolean;
I : Integer;
begin
if (Npt < 2) or (LineParam.Style = psClear) then Exit;
if Xmin >= Xmax then
begin
Xmin := XAxis.Min;
Xmax := XAxis.Max;
end;
H := (Xmax - Xmin) / Npt;
with Canvas do
begin
{ Save current settings }
PenColor := Pen.Color;
PenStyle := Pen.Style;
PenWidth := Pen.Width;
Pen.Color := LineParam.Color;
Pen.Style := LineParam.Style;
Pen.Width := LineParam.Width;
{ Check first point }
X1 := Xmin;
if XAxis.Scale = LIN_SCALE then
Y1 := Func(X1)
else
Y1 := Func(Exp10(X1));
if YAxis.Scale = LOG_SCALE then Y1 := Log10(Y1);
Flag1 := CheckPoint(X1, Y1, Xp1, Yp1);
{ Check other points and plot lines if possible }
for I := 1 to Npt do
begin
X2 := X1 + H;
if XAxis.Scale = LIN_SCALE then
Y2 := Func(X2)
else
Y2 := Func(Exp10(X2));
if YAxis.Scale = LOG_SCALE then Y2 := Log10(Y2);
Flag2 := CheckPoint(X2, Y2, Xp2, Yp2);
if Flag1 and Flag2 then
PlotLine(Canvas, Xp1, Yp1, Xp2, Yp2);
X1 := X2;
Xp1 := Xp2;
Yp1 := Yp2;
Flag1 := Flag2;
end;
{ Restore settings }
Pen.Color := PenColor;
Pen.Style := PenStyle;
Pen.Width := PenWidth;
end;
end;
procedure DimCurvParamVector(var CurvParam : TCurvParamVector;
Ubound : Integer);
var
I : Integer;
begin
{ Check bounds }
if Ubound < 0 then
begin
CurvParam := nil;
Exit;
end;
{ Allocate vector }
SetLength(CurvParam, Succ(Ubound));
if CurvParam = nil then Exit;
{ Initialize curve parameters }
for I := 0 to Ubound do
with CurvParam[I] do
begin
if I = 0 then
begin
PointParam.Symbol := 0;
PointParam.Size := 0;
PointParam.Color := clBlack;
Legend := '';
end
else
begin
PointParam.Symbol := (I - 1) mod MAXSYMBOL + 1;
PointParam.Size := 1;
PointParam.Color := CurvColor[(I - 1) mod MAXCOLOR + 1];
Legend := 'Y' + IntToStr(I);
end;
LineParam.Width := 1;
LineParam.Style := psSolid;
LineParam.Color := PointParam.Color;
Connect := False;
Step := 1;
end;
end;
procedure WriteLegend(Canvas : TCanvas;
NCurv : Integer;
CurvParam : TCurvParamVector;
ShowPoints,
ShowLines : Boolean);
var
CharHeight, I, L, Lmax, N, Nmax, Xp, Xl, Y : Integer;
PenWidth : Integer;
PenStyle : TpenStyle;
PenColor, BrushColor : TColor;
BrushStyle : TBrushStyle;
begin
N := 0; { Nb of legends to be plotted }
Lmax := 0; { Length of the longest legend }
for I := 1 to NCurv do
if CurvParam[I].Legend <> '' then
begin
Inc(N);
L := Canvas.TextWidth(CurvParam[I].Legend);
if L > Lmax then Lmax := L;
end;
if (N = 0) or (Lmax = 0) then Exit;
{ Character height }
CharHeight := Canvas.TextHeight('M');
{ Max. number of legends which may be plotted }
Nmax := Round((YmaxPixel - YminPixel) / CharHeight) - 1;
if N > Nmax then N := Nmax;
{ Draw rectangle around the legends }
Canvas.Rectangle(XmaxPixel + Round(0.02 * GraphWidth), YminPixel,
XmaxPixel + Round(0.12 * GraphWidth) + Lmax,
YminPixel + (N + 1) * CharHeight);
L := Round(0.02 * GraphWidth); { Half-length of line }
Xp := XmaxPixel + 3 * L; { Position of symbol }
Xl := XmaxPixel + 5 * L; { Position of legend }
{ Save current settings }
with Canvas do
begin
PenColor := Pen.Color;
PenStyle := Pen.Style;
PenWidth := Pen.Width;
BrushColor := Brush.Color;
BrushStyle := Brush.Style;
end;
for I := 0 to Min(NCurv, Nmax) do
with Canvas do
begin
Pen.Color := CurvParam[I].LineParam.Color;
Pen.Style := CurvParam[I].LineParam.Style;
Pen.Width := CurvParam[I].LineParam.Width;
Brush.Color := CurvParam[I].PointParam.Color;
if CurvParam[I].PointParam.Symbol in [0, 1, 3, 5] then
Brush.Style := bsSolid
else
Brush.Style := bsClear;
{ Plot point and line }
Y := YminPixel + I * CharHeight;
if ShowPoints then
PlotSymbol(Canvas, Xp, Y, CurvParam[I].PointParam.Symbol,
CurvParam[I].PointParam.Size);
if ShowLines then
PlotLine(Canvas, Xp - L, Y, Xp + L, Y);
{ Write legend }
Brush.Style := bsClear;
Canvas.TextOut(Xl, Y - CharHeight div 2, CurvParam[I].Legend);
end;
{ Restore settings }
with Canvas do
begin
Pen.Color := PenColor;
Pen.Style := PenStyle;
Pen.Width := PenWidth;
Brush.Color := BrushColor;
Brush.Style := BrushStyle;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -