Printing part of a TsgImage to a metafile

gnl · Post by **gnl** » 28 Nov 2006, 17:42

Dear Sergey,

I am using a TsgImage in order to draw upon it a list of user defined instruments. This TsgImage is not shown on screen so is not contained in a ScrollBox but rather it is used as an "offline" buffer for the drawing and when this is finished I need to copy and print to a metafile a specific part of the image. The coordinates that I know are those of the drawing itself i.e. CadCoords. I am using the ActualGraphic method of your Viewer demo application but I am not able to calculate the vrect, that is to transform the CadCoords to screen coordinates for the vMC.StrechDraw to work.

I would appreciate your help on this matter.

Kind regards,
George

gnl · Post by **gnl** » 29 Nov 2006, 16:43

Dear Sergey,

I want to kindly ask you to have a look at this matter since it is of vital importance in my application and I need to have it done by this Friday the latest.

Once again, thank you in advance for your prompt reply.

Kind regards,
George

Post by **support** » 29 Nov 2006, 17:01

Hello George,

Your question is currently in processing. We will answer you soon.

Sergey.

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

gnl · Post by **gnl** » 29 Nov 2006, 17:19

Thank you. I will be waiting

George

Post by **support** » 30 Nov 2006, 11:45

Hello George,

The following example searches text 'Hello World' in the loaded CAD file and prints a part of the drawing limited by the text's rectangle.

Code: Select all

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

<b>type</b>
  TForm1 = <b>class</b>(TForm)
    btnPrint: TButton;
    btnOpen: TButton;
    OpenDialog1: TOpenDialog;
    PrintDialog1: TPrintDialog;
    <b>procedure</b> btnOpenClick(Sender: TObject);
    <b>procedure</b> btnPrintClick(Sender: TObject);
    <b>procedure</b> FormCreate(Sender: TObject);
    <b>procedure</b> FormDestroy(Sender: TObject);
  <b>private</b>
    <font color="blue">{ Private declarations }</font id="blue">
    sgImage1: TsgImage;
    procedure ActualGraphic(<b>var</b> vResult: TGraphic);
...

<b>procedure</b> TForm1.btnOpenClick(Sender: TObject);
<b>begin
  if</b> (sgImage1 = <b>nil</b>) <b>or</b> (<b>not</b> OpenDialog1.Execute) <b>then</b>
    Exit;
  sgImage1.LoadFromFile(OpenDialog1.FileName);
  btnPrint.Enabled := true;
<b>end</b>;

<b>procedure</b> TForm1.btnPrintClick(Sender: TObject);
<b>const</b> PO: <b>array</b>[Boolean] <b>of</b> TPrinterOrientation = (poPortrait,poLandscape);
<b>var</b>
  W,H: Double;
  PW,PH: Integer;
  J: Integer;
  vGr: TGraphic;
  FImg: TsgDXFImage;
  vText: TsgDXFText;
<b>begin

  if</b> sgImage1.Picture.Graphic <b>is</b> TsgDXFImage <b>then
  begin</b>
    FImg := TsgDXFImage(sgImage1.Picture.Graphic);
    <b>for</b> J := <font color="blue">0</font id="blue">  <b>to</b> FImg.Converter.Counts[csEntities] - <font color="blue">1</font id="blue"> <b>do
    begin
      if</b> FImg.Converter.Sections[csEntities].Entities[J] <b>is</b> TsgDXFText <b>then
      begin</b>
        vText := TsgDXFText(FImg.Converter.Sections[csEntities].Entities[J]);
        <b>if</b> vText.Text = <font color="blue">'Hello World'</font id="blue"> <b>then
        begin</b>
          FImg.DrawingBox := vText.Box;
        <b>end</b>;
      <b>end</b>;
    <b>end</b>;
  <b>end</b>;

  <b>with</b> sgImage1.Picture <b>do</b>
    Printer.Orientation := PO[Width > Height];
  <b>if</b> PrintDialog1.Execute <b>then
  begin
    with</b> Printer <b>do
    begin</b>
      vGr := TMetafile.Create;
      <b>try</b>
        ActualGraphic(vGr);
        W := PageWidth / vGr.Width;
        H := PageHeight / vGr.Height;
        <b>if</b> W > H <b>then</b> W := H;
        PW := Round(W * vGr.Width);
        PH := Round(W * vGr.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), vGr);
        EndDoc;
      <b>finally</b>
        vGr.Free;
      <b>end</b>;
    <b>end</b>;
    sgImage1.Repaint;
  <b>end</b>;
<b>end</b>;

<b>procedure</b> TForm1.ActualGraphic(<b>var</b> vResult: TGraphic);
<b>const</b>
  KfWinNT = <font color="blue">1209</font id="blue">;
  MPerInch = <font color="blue">25.1</font id="blue">;

<b>var</b>
  vMC: TMetafileCanvas;
  vRect: TRect;
  vRGN: HRGN;
  OSVersionInfo: TOSVersionInfo;
  DC: HDC;
  mmToPixelX, mmToPixelY: Double;
  imgRectangle: TRect;
<b>begin</b>
  imgRectangle := sgImage1.ClientRect;

  DC := GetDC(0);
  <b>try</b>
    mmToPixelX := GetDeviceCaps(DC,HORZSIZE) /
      GetDeviceCaps(DC,HORZRES);
    mmToPixelY := GetDeviceCaps(DC,VERTSIZE) /
      GetDeviceCaps(DC,VERTRES);
  <b>finally</b>
    ReleaseDC(Handle, DC);
  <b>end</b>;

  vRect := sgImage1.PictureRect;
  vRect.Left := vRect.Left - imgRectangle.Left;
  vRect.Top := vRect.Top - imgRectangle.Top;
  vRect.Right := vRect.Right - imgRectangle.Left;
  vRect.Bottom := vRect.Bottom - imgRectangle.Top;

  OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
  GetVersionEx(OSVersionInfo);
  <b>if</b> OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT <b>then
  begin</b>
    TMetafile(vResult).MMWidth := Round((imgRectangle.Right - imgRectangle.Left) * <font color="blue">1000</font id="blue"> * mmToPixelX);
    TMetafile(vResult).MMHeight := Round((imgRectangle.Bottom - imgRectangle.Top) * <font color="blue">1000</font id="blue"> * mmToPixelY);
    vRect.Left := vRect.Left * <font color="blue">10</font id="blue">;
    vRect.Top := vRect.Top * <font color="blue">10</font id="blue">;
    vRect.Right := vRect.Right * <font color="blue">10</font id="blue">;
    vRect.Bottom := vRect.Bottom * <font color="blue">10</font id="blue">;
  <b>end
  else</b> <font color="blue"><i>// win98</i></font id="blue">
  <b>begin</b>
    TMetafile(vResult).MMWidth := Round((imgRectangle.Right - imgRectangle.Left) * <font color="blue">500</font id="blue"> * mmToPixelX);
      TMetafile(vResult).MMHeight := Round((imgRectangle.Bottom - imgRectangle.Top) * <font color="blue">500</font id="blue"> * mmToPixelY);
      vRect.Left := vRect.Left * <font color="blue">5</font id="blue">;
      vRect.Top := vRect.Top * <font color="blue">5</font id="blue">;
      vRect.Right := vRect.Right * <font color="blue">5</font id="blue">;
      vRect.Bottom := vRect.Bottom * <font color="blue">5</font id="blue">;
    <b>end</b>;
    vMC := TMetafileCanvas.Create(TMetafile(vResult), <font color="blue">0</font id="blue">);
    <b>try
      if</b> OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT <b>then</b>
        vRGN := CreateRectRgn(<font color="blue">0</font id="blue">, <font color="blue">0</font id="blue">, (imgRectangle.Right - imgRectangle.Left) * <font color="blue">10</font id="blue">, (imgRectangle.Bottom - imgRectangle.Top) * <font color="blue">10</font id="blue">)
      <b>else</b>
        vRGN := CreateRectRgn(<font color="blue">0</font id="blue">, <font color="blue">0</font id="blue">, (imgRectangle.Right - imgRectangle.Left) * <font color="blue">5</font id="blue">, (imgRectangle.Bottom - imgRectangle.Top) * <font color="blue">5</font id="blue">);

      SelectClipRgn(vMC.Handle, vRGN);
      vMC.StretchDraw(vRect, sgImage1.Picture.Graphic);
      DeleteObject(vRGN);
    <b>finally</b>
      vMC.Free;

    <b>if</b> sgImage1.Picture.Graphic <b>is</b> TsgDXFImage <b>then</b>
      TsgDXFImage(sgImage1.Picture.Graphic).IsWithoutBorder := True;
    <b>end</b>;
<b>end</b>;

<b>procedure</b> TForm1.FormCreate(Sender: TObject);
<b>begin</b>
  sgImage1 := TsgImage.Create(<b>nil</b>);
<b>end</b>;

<b>procedure</b> TForm1.FormDestroy(Sender: TObject);
<b>begin</b>
  sgImage1.Free;
<b>end</b>;

<b>end</b>.

Sergey

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

gnl · Post by **gnl** » 30 Nov 2006, 22:19

Hello Sergey,

For once more, your help has proven to be invaluable.

Thank you once again.
George

Post by **support** » 01 Dec 2006, 08:53

Thank you George,

We are always ready to help.

Sergey.

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