unit HpglUtils;
interface
uses
Windows,
System.Classes,
System.Types,
Vcl.Graphics,
Vcl.Forms,
System.SysUtils,
System.IOUtils;
const
PenColors:
array [1 .. 8]
of TColor = (clRed, clYellow, clLime, clAqua, clBlue, clFuchsia, clGray, clSilver);
clDrawArea = $00393431;
HpglScaleFactor = 40.0;
type
TOnDraw =
procedure(Point: TPoint; PenDown: Boolean; PenColor: TColor)
of object;
TOnPlot =
procedure(Point: TPoint)
of object;
THpgl =
class(TObject)
private
FOnDraw: TOnDraw;
FOnPlot: TOnPlot;
FPenDown: Boolean;
FPenColor: TColor;
slData: TStringList;
public
constructor Create;
destructor Destroy;
override;
function HpglToInteger(HpglValue: Integer): Integer;
function HpglToReal(HpglValue: Integer): Real;
function LoadFromFile(FileName: TFileName): Boolean;
procedure Plot;
property OnDraw: TOnDraw
read FOnDraw
write FOnDraw;
property OnPlot: TOnPlot
read FOnPlot
write FOnPlot;
end;
var
Hpgl: THpgl;
implementation
uses
System.StrUtils;
constructor THpgl.Create;
begin
inherited Create;
slData := TStringList.Create;
end;
destructor THpgl.Destroy;
begin
if Assigned(slData)
then
FreeANdNil(slData);
inherited Destroy;
end;
function THpgl.HpglToReal(HpglValue: Integer): Real;
begin
Result := HpglValue / HpglScaleFactor;
end;
function THpgl.HpglToInteger(HpglValue: Integer): Integer;
begin
Result := Round(HpglToReal(HpglValue));
end;
function THpgl.LoadFromFile(FileName: TFileName): Boolean;
var
slTemp: TStringList;
F, P: PChar;
sDummy:
string;
begin
slTemp := TStringList.Create;
try
try
slTemp.Delimiter := '
;';
slTemp.StrictDelimiter := True;
slTemp.LoadFromFile(FileName);
Result := True;
slData.Clear;
if (slTemp.DelimitedText = '
')
then
Exit;
P := PChar(slTemp.DelimitedText);
while P^ <> #0
do begin
F := P;
P := AnsiStrPos(P, '
;');
if (P =
nil)
then
P := StrEnd(F);
sDummy := Copy(F, 0, P - F);
if (LeftStr(sDummy, 2) = '
SP')
or (LeftStr(sDummy, 2) = '
PU')
or (LeftStr(sDummy, 2) = '
PD')
or (LeftStr(sDummy, 2) = '
PA')
then begin
if (LeftStr(sDummy, 2) = '
PU')
or (LeftStr(sDummy, 2) = '
PD')
then begin
slData.Add(LeftStr(sDummy, 2));
if RightStr(sDummy, Length(sDummy) - 2) <> '
'
then
slData.Add(RightStr(sDummy, Length(sDummy) - 2));
end else begin
slData.Add(sDummy);
end;
end;
if P^ <> #0
then
Inc(P);
end;
except
Result := False;
end;
finally
FreeANdNil(slTemp);
end;
end;
procedure THpgl.Plot;
var
Loop: Integer;
Point: TPoint;
begin
FPenDown := False;
for Loop := 0
to slData.Count - 1
do begin
if Application.Terminated
then
Exit;
if slData.Strings[Loop] = '
PU'
then begin
FPenDown := False;
end else if slData.Strings[Loop] = '
PD'
then begin
FPenDown := True;
end else if LeftStr(slData.Strings[Loop], 2) = '
PA'
then begin
Point.X := SplitString(RightStr(slData.Strings[Loop], Length(slData.Strings[Loop]) - 2), '
,')[0].ToInteger;
Point.Y := SplitString(RightStr(slData.Strings[Loop], Length(slData.Strings[Loop]) - 2), '
,')[1].ToInteger;
if Assigned(OnDraw)
then
OnDraw(Point, FPenDown, FPenColor);
end else if LeftStr(slData.Strings[Loop], 2) = '
SP'
then begin
if Length(slData.Strings[Loop]) > 2
then begin
FPenColor := PenColors[(RightStr(slData.Strings[Loop], Length(slData.Strings[Loop]) - 2)).ToInteger];
end;
end;
end;
end;
end.