Problems in CAD Editor demo
Moderators: SDS, support, admin
Hi Alex,
Please wait a little.
Sergey.
Please post questions to the forum or write to support@cadsofttools.com
Please wait a little.
Sergey.
Please post questions to the forum or write to support@cadsofttools.com
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:
<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
<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>.
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
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
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
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 :
But after it I don't see DrawMarker because NavImage draws itself over NavigationMarker
So, how to convert TsgImage into bmp ?
Alex
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;
So, how to convert TsgImage into bmp ?
Alex
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">
<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">
<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">
<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">
<b>Demo</b>:
Sergey.
Please post questions to the forum or write to support@cadsofttools.com
<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);
Code: Select all
<b>procedure</b> TForm1.btnAddLayerClick(Sender: TObject);
Code: Select all
<b>procedure</b> TForm1.btnPrintClick(Sender: TObject);
Code: Select all
<b>procedure</b> TForm1.btnSwitchLayerClick(Sender: TObject);
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>.
Please post questions to the forum or write to support@cadsofttools.com
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:
I can't find in help how to get their number. Doesn't DXFConverter have such property?
Alex
<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;
Alex
Hi, Alex.
Use the following line:
Sergey.
Please post questions to the forum or write to support@cadsofttools.com
Use the following line:
Code: Select all
FImg.Converter.Counts[csLayers]
Please post questions to the forum or write to support@cadsofttools.com
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.
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.
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:
<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">
<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">
<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>:
It gives you "pure" box of image without additional border around.
Here goes the demo:
Sergey.
Please post questions to the forum or write to support@cadsofttools.com
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);
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);
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);
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;
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>.
Please post questions to the forum or write to support@cadsofttools.com
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
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
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
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