Problems in CAD Editor demo

Discuss and ask questions about CAD VCL (Delphi and C++ Builder).

Moderators: SDS, support, admin

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 22 Jan 2007, 15:50

Hi, Sergey
Can you help me with my last questions?

Alex.

support
Posts: 3254
Joined: 30 Mar 2005, 11:36
Contact:

Post by support » 22 Jan 2007, 16:00

Hi Alex,

Please wait a little.

Sergey.

Please post questions to the forum or write to support@cadsofttools.com

support
Posts: 3254
Joined: 30 Mar 2005, 11:36
Contact:

Post by support » 26 Jan 2007, 11:30

Hi Alex,

<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">I want to make rectangle show exactly what i see in main image. If i make zoomout on sgImage1 - rectangle becomes bigger, if i make zoomin - rectangle becomes smaller.
And this rectangle shows borders of current visible part on sgImage1. If I move rectangle on NavImage - changes visible part on sgImage1, if I change visible part of sgImage1 (zoom or move) - rectangle on navImage resizes and moves according to that changes.<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
Please try the following code:

Code: Select all

<b>uses</b>
  ... SGImage, DXFImage, sgConsts, DXFConv;

<b>type</b>
  TForm1 = <b>class</b>(TForm)
    Panel2: TPanel;
    btnOpenFile: TButton;
    NavImage: TsgImage;
    OpenDialog1: TOpenDialog;
    ScrollBox1: TScrollBox;
    sgImage1: TsgImage;
    <b>procedure</b> btnOpenFileClick(Sender: TObject);
    <b>procedure</b> FormCreate(Sender: TObject);
    <b>procedure</b> FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; <b>var</b> Handled: Boolean);
    <b>procedure</b> FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; <b>var</b> Handled: Boolean);
    <b>procedure</b> sgImage1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    <b>procedure</b> NavImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  <b>private</b>
    <font color="blue"><i>{ Private declarations }</i></font id="blue">
    FImg: TsgDXFImage;
    OldNavRect: TRect;
    OldPoint: TPoint;
...
<b>var</b>
  Form1: TForm1;

<b>implementation</b>

<b>uses</b> Types;

{$R *.dfm}

<b>function</b> GetRealPointUsingsgImagePoint(AImage: TImage; X, Y: Integer): TFPoint;
<b>var</b>
  vRect: TRect;
  vXScaled, vYScaled: Extended;
<b>begin</b>
  vRect := TsgImage(AImage).PictureRect;
  <b>if</b> ((vRect.Right - vRect.Left) <= AImage.Width) <b>or</b> ((vRect.Bottom - vRect.Top) <= AImage.Height) <b>then
  begin</b>
    vXScaled := X / (vRect.Right - vRect.Left);
    vYScaled := (AImage.Height - Y) / (vRect.Bottom - vRect.Top);
  <b>end
  else
  begin</b>
    vXScaled := (-(vRect.Left  - AImage.Left) + X) / (vRect.Right - vRect.Left);
    vYScaled := 1 - (Y - (vRect.Top - AImage.Top)) / (vRect.Bottom - vRect.Top);
  <b>end</b>;
  Result := TsgDXFImage(AImage.Picture.Graphic).GetCADCoords(vXScaled, vYScaled);
<b>end</b>;

<b>function</b> DrawMarker(DXFImg: TsgDXFImage; sgImg: TsgImage; sgImgNav: TsgImage;
  ScrBox: TScrollBox; <b>var</b> OldNavRect: TRect): Integer;
<b>var</b>
  vPoint, vPoint2: TFPoint;
  OldPenMode: TPenMode;
  NewNavRect: TRect;
  vMPoint: TPoint;
  MarkRect: TPoint;

<b>begin
  if</b> DXFImg = <b>nil then</b>
    Exit;

  MarkRect.X :=  - sgImg.BoundsRect.Left;
  MarkRect.Y :=  - sgImg.BoundsRect.Top;

  sgImg.Align := alNone;
  vPoint := GetRealPointUsingsgImagePoint(sgImg,
    MarkRect.X , MarkRect.Y);
  vPoint2 := GetRealPointUsingsgImagePoint(sgImg,
    MarkRect.X + ScrBox.ClientWidth, MarkRect.Y + ScrBox.ClientHeight);

  NewNavRect.TopLeft := TsgDXFImage(sgImgNav.Picture.Graphic).GetPoint(vPoint);
  NewNavRect.BottomRight := TsgDXFImage(sgImgNav.Picture.Graphic).GetPoint(vPoint2);

  OldPenMode := sgImgNav.Canvas.Pen.Mode;

  sgImgNav.Canvas.Brush.Style := bsClear;
  sgImgNav.Canvas.Pen.Mode := pmXor;
  sgImgNav.Canvas.Pen.Color := not sgImgNav.Canvas.Brush.Color;
  sgImgNav.Canvas.Rectangle(OldNavRect);
  vMPoint.X := (OldNavRect.Left + OldNavRect.Right) <b>div</b> <font color="blue">2</font id="blue">;
  vMPoint.Y := (OldNavRect.Top + OldNavRect.Bottom) <b>div</b> <font color="blue">2</font id="blue">;
  
  sgImgNav.Canvas.Rectangle(NewNavRect);
  vMPoint.X := (NewNavRect.Left + NewNavRect.Right) <b>div</b> <font color="blue">2</font id="blue">;
  vMPoint.Y := (NewNavRect.Top + NewNavRect.Bottom) <b>div</b> <font color="blue">2</font id="blue">;

  OldNavRect := NewNavRect;

  sgImgNav.Canvas.Pen.Mode := OldPenMode;
<b>end</b>;

<b>procedure</b> TForm1.btnOpenFileClick(Sender: TObject);
<b>var</b>
  vGraph: TGraphic;
  vCenter: TPoint;
  ScaleSizes: Boolean;
<b>begin
  if not</b> OpenDialog1.Execute <b>then</b>
    Exit;
  sgImage1.LoadFromFile(OpenDialog1.FileName);
  vGraph := TGraphicClass(sgImage1.Picture.Graphic.ClassType).Create;
  vGraph.Assign(sgImage1.Picture.Graphic);
  <b>if</b> sgImage1.Picture.Graphic <b>is</b> TsgDXFImage <b>then
  begin</b>
    sgImage1.Align := alNone;
    NavImage.Picture.Graphic := vGraph;
    NavImage.Align := alClient;
    ScaleSizes := true;
    vCenter.X := sgImage1.Width <b>shr</b> <font color="blue">1</font id="blue">;
    vCenter.Y := sgImage1.Height <b>shr</b> <font color="blue">1</font id="blue">;
    sgImage1.ChangeScale(ScaleSizes, NavImage.Scale * <font color="blue">8</font id="blue">, vCenter);

    FImg := TsgDXFImage(sgImage1.Picture.Graphic);
  <b>end
  else
  begin</b>
    FImg := <b>nil</b>;   
  <b>end</b>;
  vGraph.Free;
<b>end</b>;

<b>procedure</b> TForm1.FormCreate(Sender: TObject);
<b>begin</b>
  OldNavRect := cnstBad2DRect;
  OldPoint := Point(<font color="blue">0</font id="blue">,<font color="blue">0</font id="blue">);
  Self.OnMouseWheelDown := FormMouseWheelDown;
  Self.OnMouseWheelUp := FormMouseWheelUp;
<b>end</b>;

<b>procedure</b> TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; <b>var</b> Handled: Boolean);
<b>begin
  if </b>sgImage1.Empty <b>then</b>
    Exit;
  sgImage1.ChangeScale(False, <font color="blue">0.8</font id="blue">, MousePos);

  DrawMarker(FImg, sgImage1, NavImage, ScrollBox1, OldNavRect);
<b>end</b>;

<b>procedure</b> TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; <b>var</b> Handled: Boolean);
<b>begin
  if</b> sgImage1.Empty <b>then</b>
    Exit;
  sgImage1.ChangeScale(False, <font color="blue">1.2</font id="blue">, MousePos);

  DrawMarker(FImg, sgImage1, NavImage, ScrollBox1, OldNavRect);
<b>end</b>;

<b>procedure</b> TForm1.sgImage1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
<b>begin</b>
  DrawMarker(FImg, sgImage1, NavImage, ScrollBox1, OldNavRect);
<b>end</b>;

<b>procedure</b> TForm1.NavImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
<b>var</b>
  vPoint, vPoint2: TFPoint;
  FRect: TFRect;
  OldPenMode: TPenMode;
  NewNavRect: TRect;
  Ratio: Double;

  <b>procedure</b> CalcParamsForShowPoint(<b>var</b> Location: TFPoint;
      AsgImage: TsgImage; <b>var</b> APoint: TFPoint; <b>var</b> ARect: TFRect);
  <b>var</b>
    vPoint: TPoint;
    vRect: TRect;
    R: Double;
  <b>begin</b>
    vPoint := FImg.GetPoint(Location);
    APoint := MakeFPoint(vPoint.X, vPoint.Y, <font color="blue">0</font id="blue">);
    vRect := AsgImage.PictureRect;
    <b>if</b> AsgImage.UsePictureRect <b>then
      begin</b>
        vRect.Left := vRect.Left - AsgImage.Left;
        vRect.Right := vRect.Right - AsgImage.Left;
        vRect.Top := vRect.Top - AsgImage.Top;
        vRect.Bottom := vRect.Bottom - AsgImage.Top;
      <b>end</b>;
      ARect := MakeFRect(vRect.Left, vRect.Top, <font color="blue">0</font id="blue">, vRect.Right, vRect.Bottom, <font color="blue">0</font id="blue">);
      <b>if not</b> AsgImage.UsePictureRect <b>then
      begin</b>
        APoint.X := APoint.X + ARect.Left;
        APoint.Y := APoint.Y + ARect.Top;
      <b>end</b>;
  <font color="blue"><i>//The TFRect top must be greater than bottom</i></font id="blue">
    R := ARect.Top;
    ARect.Top := ARect.Bottom;
    ARect.Bottom := R;
  <b>end</b>;

<b>begin
  if</b> FImg = <b>nil then</b>
    Exit;

  sgImage1.Align := alNone;
  vPoint := GetRealPointUsingsgImagePoint(NavImage, X ,Y);

  NewNavRect.Left := X - (OldNavRect.Right - OldNavRect.Left) <b>div</b> <font color="blue">2</font id="blue">;
  NewNavRect.Top := Y - (OldNavRect.Top - OldNavRect.Bottom) <b>div</b> <font color="blue">2</font id="blue">;
  NewNavRect.Right := X + (OldNavRect.Right - OldNavRect.Left) <b>div</b> <font color="blue">2</font id="blue">;
  NewNavRect.Bottom := Y + (OldNavRect.Top - OldNavRect.Bottom) <b>div</b> <font color="blue">2</font id="blue">;

  Ratio := NavImage.Width / (OldNavRect.Right - OldNavRect.Left);
  CalcParamsForShowPoint(vPoint, sgImage1, vPoint2, FRect);
  sgImage1.ShowPoint(vPoint2, Ratio * NavImage.Scale * <font color="blue">100</font id="blue">, FRect);

  OldPenMode := NavImage.Canvas.Pen.Mode;

  NavImage.Canvas.Brush.Style := bsClear;
  NavImage.Canvas.Pen.Mode := pmXor;
  NavImage.Canvas.Pen.Color := <b>not</b> NavImage.Canvas.Brush.Color;

  NavImage.Canvas.Rectangle(OldNavRect);

  NavImage.Canvas.Rectangle(NewNavRect);
  OldNavRect := NewNavRect;
  OldPoint.X := X;
  OldPoint.Y := Y;

  NavImage.Canvas.Pen.Mode := OldPenMode;
<b>end</b>;

<b>end</b>.
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">
About TsgDXFPoint: thank you but you forgot to tell me about what properties you reserved for changing it's form (point, cross, etc. )<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
We have made necessary changes and we can prepare a build for you, but this version will not be fully tested.

Sergey.

Please post questions to the forum or write to support@cadsofttools.com

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 29 Jan 2007, 13:52

Hello, Sergey
Thank you very much for last navigation image code. It has bugs but I've got the most important part with navigation rectangle and made working version compiled from 3 examples that you've made for me.
Thank you very much.
About buying of your component I've connected with your support but it's a pitty that you don't have full information about it in Russain language.
I have some more questions:

1. How can I make some Layer on image invisible? And how can I add create new Layer and place some entities on it?

2. If I want to make possibility to print image do I need any other components except DXF Import VCL?

3. Is it possible to repaint separate entity without calling of Image repaint?

Alex

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 30 Jan 2007, 18:25

Hi, Sergey
How to convert TsgImage into bmp image that is placed on the form?
I want to make the same navigation that i've already done but to use NavImage : TImage. I hope that it will make DrawMarker in navigation work better. Because i have some problems, for example I've made buttons that change BackGroundColor of NavImage :

Code: Select all

procedure TfmMain.btnWhiteBackNavClick(Sender: TObject);
begin
  if btnWhiteBackNav.Down then
  begin
    TsgDXFImage(NavImage.Picture.Graphic).BackgroundColor:=clWhite;
    TsgDXFImage(NavImage.Picture.Graphic).DefaultColor := clBlack;
  end
  else
  begin
    TsgDXFImage(NavImage.Picture.Graphic).BackgroundColor:=clBlack;
    TsgDXFImage(NavImage.Picture.Graphic).DefaultColor := clWhite;
  end;
  NavImage.Repaint;
 // TsgDXFImage(NavImage.Picture.Graphic).
  DrawMarker(FManager.FImg, FManager.sgImage, NavImage, sbxImageBox, OldNavRect);
end;
But after it I don't see DrawMarker because NavImage draws itself over NavigationMarker

So, how to convert TsgImage into bmp ?

Alex

support
Posts: 3254
Joined: 30 Mar 2005, 11:36
Contact:

Post by support » 31 Jan 2007, 09:52

Hello, Alex.

<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">Thank you very much for last navigation image code. It has bugs but I've got the most important part with navigation rectangle and made working version compiled from 3 examples that you've made for me.<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
Can you please share with us what bugs have you found, may be this info will be useful for all others without exception?
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">About buying of your component I've connected with your support but it's a pitty that you don't have full information about it in Russain language.<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
What exactly info do you need?
Any questions according to purchasing and licensing are accepted at: info@cadsofttools.com.
Any technical questions are accepted at: support@cadsofttools.com.
BTW: you may use Russian free - it is our native language.

Downwards goes full text of the demo which answers all your questions.
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">1. How can I make some Layer on image invisible? <hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">

Code: Select all

<b>procedure</b> TForm1.btnSwitchLayerClick(Sender: TObject);
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">And how can I add create new Layer and place some entities on it?<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">

Code: Select all

<b>procedure</b> TForm1.btnAddLayerClick(Sender: TObject);
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">2. If I want to make possibility to print image do I need any other components except DXF Import VCL?<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">

Code: Select all

<b>procedure</b> TForm1.btnPrintClick(Sender: TObject);
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">3. Is it possible to repaint separate entity without calling of Image repaint?<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">

Code: Select all

<b>procedure</b> TForm1.btnSwitchLayerClick(Sender: TObject);
<b>Demo</b>:

Code: Select all

<b>uses</b>
  ... SGImage, DXFImage, DXFConv, sgConsts, Printers;

<b>type</b>
  TForm1 = <b>class</b>(TForm)
    Panel1: TPanel;
    btnLoad: TButton;
    btnAddLayer: TButton;
    btnSwitchLayer: TButton;
    btnPrint: TButton;
    sgImage1: TsgImage;
    <b>procedure</b> btnLoadClick(Sender: TObject);
    <b>procedure</b> btnAddLayerClick(Sender: TObject);
    <b>procedure</b> btnSwitchLayerClick(Sender: TObject);
    <b>procedure</b> btnPrintClick(Sender: TObject);
  <b>private</b>
    <font color="blue"><i>{ Private declarations }</i></font id="blue">
    FImg: TsgDXFImage;
  <b>public</b>
...

<b>var</b>
  Form1: TForm1;

<b>implementation</b>

<b>uses</b> Types;

{$R *.dfm}

<b>procedure</b> ExpandRect(<b>var</b> Rect: TRect; <b>const</b> P: TPoint);
<b>begin
  if</b> Rect.Left > P.X <b>then</b>
    Rect.Left := P.X;
  <b>if</b> Rect.Top > P.Y <b>then</b>
    Rect.Top := P.Y;
  <b>if</b> Rect.Right < P.X <b>then</b>
    Rect.Right := P.X;
  <b>if</b> Rect.Bottom < P.Y <b>then</b>
    Rect.Bottom := P.Y;
<b>end</b>;

<b>function</b> GetRect(<b>const</b> AImg: TsgDXFImage; <b>const</b> ARect: TFRect): TRect;
  <b>procedure</b> ExpRect(<b>const</b> X, Y, Z: TsgFloat);
  <b>begin</b>
    ExpandRect(Result, AImg.GetPoint(MakeFPoint(X, Y, Z)));
  <b>end</b>;
<b>begin</b>
  Result := Classes.Rect(MaxInt, MaxInt, -MaxInt, -MaxInt);
  ExpRect(ARect.Left, ARect.Top, ARect.Z1);
  ExpRect(ARect.Left, ARect.Top, ARect.Z2);
  ExpRect(ARect.Left, ARect.Bottom, ARect.Z1);
  ExpRect(ARect.Left, ARect.Bottom, ARect.Z2);
  ExpRect(ARect.Right, ARect.Top, ARect.Z1);
  ExpRect(ARect.Right, ARect.Top, ARect.Z2);
  ExpRect(ARect.Right, ARect.Bottom, ARect.Z1);
  ExpRect(ARect.Right, ARect.Bottom, ARect.Z2);
<b>end</b>;

<b>procedure</b> TForm1.btnLoadClick(Sender: TObject);
<b>begin</b>
  sgImage1.LoadFromFile(<font color="blue">'c:\Test.dxf'</font id="blue">);
  <b>if</b> sgImage1.Picture.Graphic <b>is</b> TsgDXFImage <b>then
  begin</b>
    FImg := TsgDXFImage(sgImage1.Picture.Graphic);
    sgImage1.Align := alClient;
  <b>end
  else</b>
    FImg := <b>nil</b>;
<b>end</b>;

<b>procedure</b> TForm1.btnAddLayerClick(Sender: TObject);
<b>var</b>
  vName: string;
  vLayer: TsgDXFLayer;
  vLayers: TsgDXFGroup;
  vText: TsgDXFText;
<b>begin
  if</b> FImg = <b>nil then</b>
    Exit;
  vLayers := FImg.Converter.Sections[csLayers];
  vLayer := TsgDXFLayer.Create;
  vLayer.Name := vName;
  vLayer.Visible := false;
  FImg.Converter.Loads(vLayer);
  vLayers.AddEntity(vLayer);

  vText := TsgDXFText.Create;
  vText.Point := MakeFPoint(<font color="blue">200</font id="blue">, <font color="blue">200</font id="blue">, <font color="blue">0</font id="blue">);
  vText.Height := <font color="blue">20</font id="blue">;
  vText.Text := <font color="blue">'New Text Line'</font id="blue">;
  vText.Layer := FImg.Converter.LayerByName(<font color="blue">'TestLayer'</font id="blue">);

  FImg.Converter.Layouts[<font color="blue">0</font id="blue">].AddEntity(vText);
  <b>if</b> Assigned(FImg.Converter.OnCreate) <b>then</b>
    FImg.Converter.OnCreate(vText);
  FImg.Converter.Loads(vText);
  FImg.GetExtents;
<b>end</b>;

<b>procedure</b> TForm1.btnSwitchLayerClick(Sender: TObject);
<b>var</b>
  J, Cnt: Integer;
  vLayer: TsgDXFLayer;
  vEnt: TsgDXFEntity;
  vRect: TRect;
  vFind: Boolean;
<b>begin
  if</b> FImg = <b>nil then</b>
    Exit;
  vLayer := FImg.Converter.LayerByName('TestLayer');
  <b>if</b> vLayer = <b>nil then</b> 
    Exit;
  vLayer.Frozen := <b>not</b> vLayer.Frozen;
  vFind := False;
  vRect := cnstBad2DRect;
  Cnt := FImg.Converter.Counts[csEntities] - <font color="blue">1</font id="blue">;
  <b>for</b> J := <font color="blue">0</font id="blue"> <b>to</b> Cnt <b>do
  begin</b>
    vEnt := FImg.Converter.Sections[csEntities].Entities[J];
    <b>if</b> (vEnt.Layer = vLayer) <b>and</b> (vEnt <b>is</b> TsgDXFText) <b>then
    begin</b>
      vFind := True;
      UnionRect(vRect, vRect, GetRect(FImg, vEnt.Box));
    <b>end</b>;
  <b>end</b>;
  <b>if</b> vFind <b>then
  begin</b>
    OffsetRect(vRect, sgImage1.Left, sgImage1.Top);
    InvalidateRect(sgImage1.Parent.Handle, @vRect, True);
    UpdateWindow(sgImage1.Parent.Handle);
  <b>end</b>;
<b>end</b>;

<b>procedure</b> TForm1.btnPrintClick(Sender: TObject);
<b>var</b>
  vGraphic: TGraphic;
  W, H: double;
  PW, PH: Integer;

  <b>function</b> GetActualGraphic: TGraphic;
  <b>var</b>
    vCoeffW, vCoeffH, BX, BY: Double;
    vClipRect, vExts: TFRect;
    vNewImg: TsgDXFImage;
    R: TRect;
  <b>begin
    if</b> FImg <> <b>nil then
    begin</b>
      Result := TGraphicClass(sgImage1.Picture.Graphic.ClassType).Create;
      vNewImg := TsgDXFImage(Result);
      vNewImg.Assign(FImg);

      R := sgImage1.Parent.ClientRect;

      vNewImg.IsWithoutBorder := True;
      vExts := FImg.Extents;
      <font color="blue"><i>// Borders</i></font id="blue">
      BX := <font color="blue">0.5</font id="blue"> * (vExts.Right - vExts.Left - vNewImg.Extents.Right + vNewImg.Extents.Left);
      BY := <font color="blue">0.5</font id="blue"> * (vExts.Top - vExts.Bottom - vNewImg.Extents.Top + vNewImg.Extents.Bottom);
      <font color="blue"><i>// Scaling coefficients</i></font id="blue">
      vCoeffW := (vExts.Right - vExts.Left)/ (sgImage1.PictureRect.Right - sgImage1.PictureRect.Left);
      vCoeffH := (vExts.Top - vExts.Bottom)/ (sgImage1.PictureRect.Bottom - sgImage1.PictureRect.Top);
      <font color="blue"><i>// Clipping rectangle (ignoring Z-coordinate)</i></font id="blue">
      vClipRect.Left := (R.Left - sgImage1.PictureRect.Left)* vCoeffW - BX;
      vClipRect.Top := (R.Top - sgImage1.PictureRect.Top)* vCoeffH - BY;
      vClipRect.Right := vClipRect.Left + (R.Right - R.Left) * vCoeffW;
      vClipRect.Bottom := vClipRect.Top + (R.Bottom - R.Top) * vCoeffH;
      vNewImg.SetClippingRect(@vClipRect);
      <b>end</b>;
  <b>end</b>;
<b>begin
  if</b> FImg = <b>nil then</b>
    Exit;

    vGraphic := GetActualGraphic;
    <b>with</b> Printer <b>do
    begin</b>
      W := PageWidth / vGraphic.Width;
      H := PageHeight / vGraphic.Height;
      <b>if</b> W > H <b>then</b> W := H;
      PW := Round(W * vGraphic.Width);
      PH := Round(W * vGraphic.Height);
      BeginDoc;
      Canvas.StretchDraw(Bounds((PageWidth-PW) <b>div</b> <font color="blue">2</font id="blue">, (PageHeight-PH) <b>div</b> <font color="blue">2</font id="blue">, PW, PH), vGraphic);
      EndDoc;
    <b>end</b>;
    sgImage1.Repaint;
<b>end</b>;

<b>end</b>.
Sergey.

Please post questions to the forum or write to support@cadsofttools.com

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 31 Jan 2007, 14:36

Hi, Sergey
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">Can you please share with us what bugs have you found, may be this info will be useful for all others without exception?<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
Yes, I'll send you my version of navigation marker, but i have to cut it out from my project and it will take some time.
Thank you for code about layers and printing. It works perfectly.
How can I get number of layers on image? I want to count them and get their names:

Code: Select all

  i:= 0;
  while i< ...LayersCount do
    begin
      showmessage (fmMain.Fmanager.FImg.Converter.Layers[i].Name);
      i:= i+1;
    end;
I can't find in help how to get their number. Doesn't DXFConverter have such property?

Alex

support
Posts: 3254
Joined: 30 Mar 2005, 11:36
Contact:

Post by support » 31 Jan 2007, 14:52

Hi, Alex.

Use the following line:

Code: Select all

FImg.Converter.Counts[csLayers]
Sergey.

Please post questions to the forum or write to support@cadsofttools.com

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 03 Feb 2007, 20:54

Hi Sergey.
Is it possible to add layer to TsgDXFImage under all other layers?

And I have a problem with TsgDXFImage:
For example, I have the image where two rectangles are placed on different layers (they are placed separately - they don't have any intersections ). If I set the property Frozen = True of one layer and then refresh of TsgDXFImage the image gets size of visible rectangle with added extra space on all sides of image. Then if I set the property Frozen=False of invisible layer - it I can't see it because TsgImage doesn't refresh it's size according to visible layers.

The problem is how to set size of TsgDXFImage independently of placement of Entities on it? How to forbid size changing of TsgDXFImage after it's opened?
If I add Entity near the border of TsgDXFImage - it gets bigger size and then if I delete this entity image doesn't refresh it's size back.

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 08 Feb 2007, 12:12

Hi Sergey
I've just sent you my code of navigation image that i promised you to send. Hope it will be useful for you.

Alex

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 09 Feb 2007, 15:21

Hello
How to set property line type of any entity into dotted or others? TsgDXFEntity has such method SetLType but as parameter it needs TsgDXFEntity. Can you show an Example?

Alex

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 12 Feb 2007, 14:15

Hi, Sergey
What is the height and width of additional space around the TsgDXFImage when it is opened?
I want to get real box of TsgDXFImage from TsgDXFImage.Extents.

Alex

support
Posts: 3254
Joined: 30 Mar 2005, 11:36
Contact:

Post by support » 13 Feb 2007, 10:52

Hi Alex,

Downward goes a demo which have to give the answers on your posts. As income parameter it takes <b>Layers.dxf</b> file which contains two layers: '<font color="blue">0</font id="blue">' and '<font color="blue">1</font id="blue">'. Every layer contains one polyline and one hatch. Entities on the '<font color="blue">0</font id="blue">' layer have red color and entities on the '<font color="blue">1</font id="blue">' layer have green color. Entities on the '<font color="blue">0</font id="blue">' layer are overlapped by entities on the '<font color="blue">1</font id="blue">' layer. It is necessary to ensure that sorting occurs correctly.
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">Is it possible to add layer to TsgDXFImage under all other layers?<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
Moving entities on the layer '<font color="blue">1</font id="blue">' under all the others:

Code: Select all

<b>procedure</b> TForm1.btnSortLayersClick(Sender: TObject);
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">And I have a problem with TsgDXFImage:
For example, I have the image where two rectangles are placed on different layers (they are placed separately - they don't have any intersections ). If I set the property Frozen = True of one layer and then refresh of TsgDXFImage the image gets size of visible rectangle with added extra space on all sides of image. Then if I set the property Frozen=False of invisible layer - it I can't see it because TsgImage doesn't refresh it's size according to visible layers.<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">

Code: Select all

<b>procedure</b> TForm1.btnLayerOff_OnClick(Sender: TObject);
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">The problem is how to set size of TsgDXFImage independently of placement of Entities on it? How to forbid size changing of TsgDXFImage after it's opened?<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
There is no way to forbid size changing.
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">If I add Entity near the border of TsgDXFImage - it gets bigger size and then if I delete this entity image doesn't refresh it's size back.<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
We need to see your code.
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote"> Hi Sergey
I've just sent you my code of navigation image that i promised you to send. Hope it will be useful for you.

Alex<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
Thank you. We will study your code.
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">How to set property line type of any entity into dotted or others? TsgDXFEntity has such method SetLType but as parameter it needs TsgDXFEntity. Can you show an Example?<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">

Code: Select all

<b>procedure</b> TForm1.btnCngLTypeClick(Sender: TObject);
<blockquote id="quote"><font size="2" face="Verdana, Arial, Helvetica" id="quote">quote:<hr height="1" noshade id="quote">What is the height and width of additional space around the TsgDXFImage when it is opened?
I want to get real box of TsgDXFImage from TsgDXFImage.Extents.<hr height="1" noshade id="quote"></font id="quote"></blockquote id="quote">
It is necesary to use property <b>TsgDXFImage.IsWithoutBorder</b>:

Code: Select all

TsgDXFImage(sgImage1.Picture.Graphic).IsWithoutBorder := true;
It gives you "pure" box of image without additional border around.

Here goes the demo:

Code: Select all

<b>uses</b>
  ... SGImage, DXFImage, DXFConv, sgConsts;

<b>type</b>
  TForm1 = <b>class</b>(TForm)
    Panel1: TPanel;
    btnOpen: TButton;
    sgImage1: TsgImage;
    btnSortLayers: TButton;
    btnLayerOff_On: TButton;
    btnCngLType: TButton;
    procedure btnOpenClick(Sender: TObject);
    procedure btnSortLayersClick(Sender: TObject);
    procedure btnLayerOff_OnClick(Sender: TObject);
    procedure btnCngLTypeClick(Sender: TObject);
  <b>private</b>
    <font color="blue"><i>{ Private declarations }</i></font id="blue">
    FImg: TsgDXFImage;

...

<b>procedure</b> TForm1.btnOpenClick(Sender: TObject);
<b>begin</b>
  sgImage1.LoadFromFile(<font color="blue">'c:\Layers.dxf'</font id="blue">);
  sgImage1.Align := alClient;
  FImg := TsgDXFImage(sgImage1.Picture.Graphic);
  FImg.IsWithoutBorder := true;
<b>end</b>;

<b>procedure</b> TForm1.btnSortLayersClick(Sender: TObject);
<b>var</b>
  vList1, vList2: TList;
  vEnt: TsgDXFEntity;
  I: Integer;
  vEntities: TsgDXFGroup;
<b>begin</b>
  vEntities := FImg.Converter.Sections[csEntities];
  vList1 := TList.Create;
  vList2 := TList.Create;
  <b>try</b>
    vList1.Capacity := vEntities.Count;
    vList2.Capacity := vList1.Capacity;
    <b>for</b> I := <font color="blue">0</font id="blue"> <b>to</b> vEntities.Count - <font color="blue">1</font id="blue"> <b>do
    begin</b>
      vEnt := vEntities.Entities[I];
      <b>if</b> vEnt.Layer.Name = <font color="blue">'1'</font id="blue"> <b>then</b>
        vList1.Add(vEnt)
      <b>else</b>
        vList2.Add(vEnt);
    <b>end</b>;
    <b>while</b> vEntities.Count > <font color="blue">0</font id="blue"> <b>do</b>
      FImg.Converter.DeleteEntity(vEntities.Entities[<font color="blue">0</font id="blue">], False);
    <b>for</b> I := <font color="blue">0</font id="blue"> <b>to</b> vList1.Count - <font color="blue">1</font id="blue"> <b>do</b>
      vEntities.AddEntity(TsgDXFEntity(vList1[I]));
    <b>for</b> I := <font color="blue">0</font id="blue"> <b>to</b> vList2.Count - <font color="blue">1</font id="blue"> <b>do</b>
      vEntities.AddEntity(TsgDXFEntity(vList2[I]));
  <b>finally</b>
    vList1.Free;
    vList2.Free;
  <b>end</b>;
  FImg.GetExtents;
  sgImage1.Invalidate;
<b>end</b>;

<b>procedure</b> TForm1.btnLayerOff_OnClick(Sender: TObject);
<b>var</b>
  vLayer: TsgDXFLayer;
<b>begin</b>
  vLayer := FImg.Converter.LayerByName(<font color="blue">'0'</font id="blue">);
  vLayer.Frozen := <b>not</b> vLayer.Frozen;
  sgImage1.Invalidate;
<b>end</b>;

<b>procedure</b> TForm1.btnCngLTypeClick(Sender: TObject);
<b>var</b>
  vLType: TsgDXFLineType;
  I, Cnt: Integer;
  vPoly: TsgDXFPolyline;
<b>begin</b>  
  I := 0;
  Cnt := FImg.Converter.Counts[csEntities];
  <b>while</b> (I < Cnt) <b>and</b> (FImg.Converter.Sections[csEntities].Entities[I].ClassType <> TsgDXFPolyline) <b>do</b>
    Inc(I);
  <b>if</b> I < Cnt <b>then
  begin</b>
    vPoly := TsgDXFPolyline(FImg.Converter.Sections[csEntities].Entities[I]);
    vLType := FImg.Converter.LTypeByName('ISO dash');
    <b>if</b> vLType = <b>nil then
    begin</b>
      vLType := TsgDXFLineType.Create;
      vLType.Name := <font color="blue">'ISO dash'</font id="blue">;
      vLType.Lines.AddTick(<font color="blue">1.2</font id="blue">); 
      vLType.Lines.AddTick(<font color="blue">-0.3</font id="blue">);
      FImg.Converter.LinesByName(<font color="blue">'ISO dash'</font id="blue">);
      FImg.Converter.Sections[csLTypes].AddEntity(vLType);
    <b>end</b>;
    vPoly.SetLType(vLType);
    FImg.Converter.Loads(vPoly);
    sgImage1.Invalidate;
  <b>end</b>;
<b>end</b>;

<b>end</b>.
Sergey.


Please post questions to the forum or write to support@cadsofttools.com

AlexUS
Posts: 53
Joined: 05 Dec 2006, 14:44

Post by AlexUS » 13 Mar 2007, 11:48

Hi, Sergey
Thank you for your supporting in using your component.
My company that I work on has payed for DXF Import VCL. Now we are waiting for it's delivery.
When do you plan to release new version of component (6.0) and will there be the supporting of full work with HATCH? I mean not only creating of flooded polygon but also selecting and deleting it. I still have problems with that Entity (I wrote about it in "CADImportVCL + DXFExportVCL\Flooded figure")

Alex

support
Posts: 3254
Joined: 30 Mar 2005, 11:36
Contact:

Post by support » 19 Mar 2007, 15:26

Hello Alex,

We would like you to study updated library available at: http://www.cadsofttools.com/download/cadimportvcl.zip

In need to get updated version of DXF Import VCL please contact us on info@cadsofttools.com with a reference to this topic.

Sergey.

Please post questions to the forum or write to support@cadsofttools.com

Post Reply