SCAR Code:
program Grapher;
procedure Text_Alpha(Bitmap, Color, tx, ty: Integer; Alpha: Single; Size: Integer; Face, Text: string);
var
w, h, x, y,
r1, g1, b1,
r2, g2, b2: Integer;
b, c: Integer;
begin
ColorToRGB(Color, r1, g1, b1);
b := BitmapFromString(Round(Size * Length(Text) * 1.5), Size * 3, '');
with GetBitmapCanvas(b) do
begin
Font.Size := Size;
Font.Name := Face;
w := TextWidth(Text);
h := TextHeight(Text);
end;
FreeBitmap(b);
b := BitmapFromString(w, h, '');
c := (Color + 1) mod clWhite;
with GetBitmapCanvas(b) do
begin
Font.Size := Size;
Font.Name := Face;
Font.Color := c;
TextOut(0, 0, Text);
end;
for x := x to w - 1 do
for y := 0 to h - 1 do
begin
if (FastGetPixel(b, x, y) <> c) then Continue;
try
ColorToRGB(FastGetPixel(Bitmap, x + tx, y + ty), r2, g2, b2);
FastSetPixel(Bitmap, x + tx, y + ty, RGBtoColor(
Round(r1 * (1.0 - Alpha) + r2 * Alpha),
Round(g1 * (1.0 - Alpha) + g2 * Alpha),
Round(b1 * (1.0 - Alpha) + b2 * Alpha)));
except end;
end;
FreeBitmap(b);
end;
procedure LineTo_Alpha(Bitmap, Color, FromX, FromY, ToX, ToY: Integer; Alpha: Single);
var
w, h, i,
r1, g1, b1,
r2, g2, b2,
x, y: Integer;
dx, dy, d: Extended;
begin
ColorToRGB(Color, r1, g1, b1);
GetBitmapSize(Bitmap, w, h);
FromX := Max(Min(FromX, w), 0);
ToX := Max(Min(ToX, w), 0);
FromY := Max(Min(FromY, h), 0);
ToY := Max(Min(ToY, h), 0);
Alpha := MaxE(MinE(1.0, Alpha), 0);
d := Sqrt(Sqr(FromX - ToX) + Sqr(FromY - ToY));
dx := (ToX - FromX) / d;
dy := (ToY - FromY) / d;
for i := 0 to Ceil(d) do
begin
x := Round(i * dx) + FromX;
y := Round(i * dy) + FromY;
ColorToRGB(FastGetPixel(Bitmap, x, y), r2, g2, b2);
FastSetPixel(Bitmap, x, y, RGBtoColor(
Round(r1 * (1.0 - Alpha) + r2 * Alpha),
Round(g1 * (1.0 - Alpha) + g2 * Alpha),
Round(b1 * (1.0 - Alpha) + b2 * Alpha)));
end;
end;
{*******************************************************************************
function GraphPtsEx( ... ): integer;
By: Smartzkid
Description: Graphs points stored in TPA 'pts', returns handle to a bitmap
Parameters:
GraphPxlsX, GraphPxlsY: integer; Size of the graph
zoom: integer; Zoom
pts: TPointArray; Graph points
GraphBCGColor, Background color
GraphAxisColor, Axis color
GraphLineColor: integer; Line color
Axis_ForceVisible: boolean; Force origin to be visible
connectPoints: boolean; Draws lines connecting points
pointSize: integer; Draws circles for each point (1 = disabled)
gridlines: boolean; Draw gridlines
GridlineXS\pacing, GridlineYSpacing, Spacing between gridlines
GridlineColor: integer): integer; Gridline color
*******************************************************************************}
function GraphPtsEx(GraphPxlsX, GraphPxlsY: integer; zoom: integer; pts: TPointArray; GraphBCGColor, GraphAxisColor, GraphLineColor: integer; Axis_ForceVisible: boolean; connectPoints: boolean; pointSize: integer; gridlines: boolean; GridlineXSpacing, GridlineYSpacing, GridlineColor: integer): integer;
var
x_min, x_max, y_min, y_max: integer;
i, temp: integer;
scaleX, scaleY: extended;
Graph_BMP, Result_BMP: integer;
graphPoints: TPointArray;
canvas: TCanvas;
begin
//Param-error catching
if(GraphPxlsX < 1)then
Exit;
if(GraphPxlsY < 1)then
Exit;
if(zoom < 1)then
zoom := 1;
if(Gridlines)then
begin
if(GridlineXSpacing < 1)then
GridlineXSpacing := 5;
if(GridlineYSpacing < 1)then
GridlineYSpacing := 5;
end;
//Create the bitmap that the graph will be displayed on and fill with a given color
Graph_BMP := BitmapFromString(GraphPxlsX, GraphPxlsY, '');
FastDrawClear(Graph_BMP, GraphBCGColor);
if(Axis_ForceVisible = false)then
begin
x_min := pts[0].x;
y_min := pts[0].y;
end;
//Find lowest and highest points
for i := 0 to high(pts) do
begin
if(pts[i].x < x_min)then
x_min := pts[i].x;
if(pts[i].x > x_max)then
x_max := pts[i].x;
if(pts[i].y < y_min)then
y_min := pts[i].y;
if(pts[i].y > y_max)then
y_max := pts[i].y;
end;
//add a 10% 'buffer' to the x axis
temp := round((abs(x_max) - x_min) / 10);
x_min := x_min - temp;
x_max := x_max + temp;
//add a 10% 'buffer' to the y axis
temp := round((abs(y_max) - y_min) / 10);
y_min := y_min - temp;
y_max := y_max + temp;
//Determine Graph-point to pixel scale
scaleX := GraphPxlsX / round(x_max - x_min);
scaleY := GraphPxlsY / round(y_max - y_min);
if(Gridlines)then
begin
//Draw vertical gridlines
for temp := 0 to floor(GraphPxlsX / (GridlineXSpacing * ScaleX)) do
begin
i := Round(GridlineXSpacing * temp * ScaleX) + (round(abs(x_min) * scaleX) mod GridlineXSpacing);
LineTo_Alpha(Graph_BMP, GridlineColor, i, 0, i, GraphPxlsY - 1, 0.3);
if ((temp mod 2) = 0) then
Text_Alpha(Graph_BMP, clRed, i, Round(((GraphPxlsY / ScaleY) - abs(y_min)) * scaleY), 0.5, 7, 'arial', IntToStr(Round((i - Round(abs(x_min) * scaleX)) / scaleX)));
end;
//Draw horizontal gridlines
for temp := 0 to round(GraphPxlsY / (GridlineYSpacing * ScaleY)) - 1 do
begin
i := Round(GridlineYSpacing * temp * ScaleY) + (round(((GraphPxlsY / ScaleY) + abs(y_min)) * scaleY) mod GridlineYSpacing);
LineTo_Alpha(Graph_BMP, GridlineColor, 0, i, GraphPxlsX - 1, i, 0.3);
if ((temp mod 2) = 0) and not InRange(Round((i - Round(((GraphPxlsY / ScaleY) - abs(y_min)) * scaleY)) / scaleY), -3, 3) then
Text_Alpha(Graph_BMP, clRed, Round(((GraphPxlsX / ScaleX) - abs(x_min)) * scaleX) + 9, i, 0.5, 7, 'arial', IntToStr(Round((i - Round(((GraphPxlsY / ScaleY) - abs(y_min)) * scaleY)) / scaleY)));
end;
end;
//Draw vertical axis
if(x_min < 0)then
begin
i := Round(abs(x_min) * scaleX);
LineTo_Alpha(Graph_BMP, GraphAxisColor, i, 0, i, GraphPxlsY - 1, 0.4);
end;
//Draw horizontal axis
if(y_min < 0)then
begin
i := Round(((GraphPxlsY / ScaleY) - abs(y_min)) * scaleY);
LineTo_Alpha(Graph_BMP, GraphAxisColor, 0, i, GraphPxlsX - 1, i, 0.4);
end;
//Calculate the points
SetLength(graphPoints, Length(pts));
for i := 0 to high(pts) do
begin
graphPoints[i].X := round((pts[i].x - x_min) * scaleX);
graphPoints[i].Y := round(GraphPxlsY - ((pts[i].y - y_min) * scaleY));
end;
//Graph the points
for i := 0 to High(graphPoints) do
try
FastSetPixel(Graph_BMP, graphPoints[i].X, GraphPoints[i].Y, GraphLineColor);
except
writeln('Error at pt ' + inttostr(i + 1));
writeln(inttostr(graphPoints[i].X) + ', ' + inttostr(graphPoints[i].Y));
end;
if(connectPoints) or (pointSize > 1)then
canvas := GetBitmapCanvas(Graph_BMP);
if(connectPoints)then
canvas.Pen.Color := GraphLineColor; //Sets line color
if(pointSize > 1)then
canvas.Brush.Color := GraphLineColor; //Fills elipses with line color
if(connectPoints)then
for i := 0 to High(graphPoints) - 1 do
try
LineTo_Alpha(Graph_BMP, GraphLineColor, graphPoints[i].X, graphPoints[i].Y, graphPoints[i + 1].X, graphPoints[i + 1].Y, 0.35);
except
writeln('Error drawing line between pts ' + inttostr(i) + ' and ' + inttostr(i + 1));
end;
if(pointSize > 1)then
for i := 0 to High(graphPoints) do
canvas.Ellipse(graphPoints[i].X - pointSize, graphPoints[i].Y - pointSize, graphPoints[i].X + pointSize, graphPoints[i].Y + pointSize);
Result_BMP := BitmapFromString(GraphPxlsX * zoom, GraphPxlsY * zoom, '');
SafeCopyCanvas(canvas, GetBitmapCanvas(Result_BMP), 0, 0, GraphPxlsX, GraphPxlsY, 0, 0, GraphPxlsX * zoom, GraphPxlsY * zoom)
FreeBitmap(Graph_BMP);
result := Result_BMP;
end;
{*******************************************************************************
function GraphPts(GraphPxlsX, GraphPxlsY: integer; pts: TPointArray): integer;
By: Smartzkid
Description: Graphs points stored in TPA 'pts', returns handle to a bitmap
Parameters:
GraphPxlsX, GraphPxlsY: integer; Size of the graph
pts: TPointArray; Graph points
*******************************************************************************}
function GraphPts(GraphPxlsX, GraphPxlsY: integer; pts: TPointArray): integer;
begin
result := GraphPtsEx(GraphPxlsX, GraphPxlsY, 1, pts, 16777215, 5018076, 0, false, true, 2, true, 10, 10, 16701619);
end;
var
data: TPointArray;
graph, i: integer;
begin
SetLength(data, 50);
for i := 0 to High(data) do
data [i] := Point((i - 25) * 2, RandomRange(-50, 50));
graph := GraphPtsEx(400, 400, 1, data, 16777215, 5018076, 0, false, true, 2, true, 5, 5, 16701619);
DisplayDebugImgWindow(400, 400);
SafeDrawBitmap(graph, GetDebugCanvas, 0, 0);
FreeBitmap(Graph);
end.