Problem mit hpgl Komponente

[DaCoda]

Vielleicht hilft dir das ein bisschen weiter, habe ich mal gemacht zu Testzwecken...

Delphi-Quellcode:

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.