Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Problem mit hpgl Komponente (https://www.delphipraxis.net/211909-problem-mit-hpgl-komponente.html)

mdadali 24. Nov 2022 12:01

AW: Problem mit hpgl Komponente
 
Hallo iphi,

Ich arbeite mit LiteCad von Kolbasoft.
Hier gibt es mehrere Plugins mit Sourcode (DXF, SVG, HPGL.. in C++).

Ich habe deine test file geöffnet. Es wird leider nichts angezeigt.
Du kannst LiteCad SDK (LiteCAD-Demo Anwendung und Plugins) herunterladen.
Oder einfach Oleg kontaktieren.

Grüsse,
Mustafa.

DaCoda 24. Nov 2022 16:46

AW: Problem mit hpgl Komponente
 
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.

himitsu 24. Nov 2022 17:09

AW: Problem mit hpgl Komponente
 
Zitat:

Delphi-Quellcode:
Copy(F, 0, P - F);

Strings fangen bei 1 an mit Zählen ... wenn es bei 0 falsch Zählt, dann hat man eben Pech.



Statt LeftStr würde ich ein StartsStr benutzen
oder ein MatchStrin, wenn mehreres verglichen wird.

Delphi-Quellcode:
(LeftStr(sDummy, 2) = 'SP')
StartsStr('SP', sDummy)
Delphi-Quellcode:
(xxxx = 'SP') or (xxxx = 'PU') or (xxx = 'PD') or ...
MatchStr(xxxx, ['SP', 'PU', 'PD', ...])
StrEnd kann man sich auch sparen, da bei #0 eh abgeschnitten wird und somit Copy garnicht mehr bekommt.
Delphi-Quellcode:
********F := P;
********P := AnsiStrPos(P, ';');
********if (P = nil) then
************P := StrEnd(F);
********sDummy := Copy(F, 0, P - F);
Delphi-Quellcode:
********sDummy := P;
        i := Pos(';', sDummy);
        if i > 0 then
          sDummy := LeftStr(sDummy, i-1); // sDummy := Copy(sDummy, 1, i-1); ODER Delete(sDummy, i-1+1, MaxInt); //  eventuell auch i statt i-1 (inkl. oder exkl. dem ; )

DaCoda 24. Nov 2022 17:55

AW: Problem mit hpgl Komponente
 
Hi Himitsu,

sicher gibt es einiges zum optimieren, der Code sollte auch nur ein Beispiel sein um aufzuzeigen, das es gar nicht so schwer ist HPGL/2 zu verarbeiten.
Ich benötigte diese Unit vor 10 Jahren :-) Und da war es eben gut :-)

Aber ich werde bei Gelegenheit das ganze mal verbessern, Danke für deine Anmerkungen, finde ich sehr gut!


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:47 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz