home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 November / pcwk_11_98a.iso / Wtestowe / SOFTSRC / vtrial15.exe / DATA.1 / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-05-19  |  18.3 KB  |  492 lines
  1. { *****************************************************************************
  2. Module:         MAIN.PAS
  3.  
  4. Purpose:        Simple coding example that codes a dialog box allowing the
  5.                 user to work with blocks and attributes in a VDraft drawing.
  6.  
  7. Programmer(s):  SoftSource programming team
  8.                 Robert Cheek
  9.  
  10. History:        ~~~ 1997 ~~~
  11.                 Apr 01 - Created (ported from Visual Basic code developed by
  12.                          SoftSource).
  13.                 May 12 - Completed port.
  14.  
  15. ***************************************************************************** }
  16. unit Main;
  17. interface
  18.  
  19. { -----------------------------------------------------------------------------
  20. Other Pascal code units used by the program
  21. NOTE: The key clause is "OleAuto" which Delphi requires for working with
  22.       other OLE Automation Servers.
  23. ----------------------------------------------------------------------------- }
  24. uses
  25.    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  26.    StdCtrls, OleAuto;
  27.  
  28. { -----------------------------------------------------------------------------
  29. Types and class definitions
  30. ----------------------------------------------------------------------------- }
  31. type
  32.    TfrmAttributes = class( TForm )
  33.       // Controls on the form
  34.       btnGetBlocks: TButton;
  35.       btnQuit: TButton;
  36.       lblFileName: TLabel;
  37.       btnSelect: TButton;
  38.       lstBlocks: TListBox;
  39.       btnGetAttributes: TButton;
  40.       btnOutput: TButton;
  41.       btnEditAttributes: TButton;
  42.       btnZoom: TButton;
  43.       lstAttributes: TListBox;
  44.       lblInsertCount: TLabel;
  45.  
  46.       // Methods for the controls
  47.       procedure FormCreate( Sender: TObject );
  48.       procedure FormClose( Sender: TObject; var Action: TCloseAction );
  49.       procedure btnGetBlocksClick( Sender: TObject );
  50.       procedure btnSelectClick( Sender: TObject );
  51.       procedure lstBlocksClick( Sender: TObject );
  52.       procedure btnGetAttributesClick( Sender: TObject );
  53.       procedure btnOutputClick( Sender: TObject );
  54.       procedure lstAttributesClick( Sender: TObject );
  55.       procedure btnEditAttributesClick( Sender: TObject );
  56.       procedure btnZoomClick( Sender: TObject );
  57.       procedure btnQuitClick( Sender: TObject );
  58.  
  59.    private
  60.       // Private declarations
  61.       vDraft:   Variant;               // Handle to VDraft
  62.       vDrawing: Variant;               // Handle to active drawing
  63.  
  64.    public
  65.       // Public declarations
  66.  
  67.    end;
  68.  
  69. { -----------------------------------------------------------------------------
  70. Global variables
  71. ----------------------------------------------------------------------------- }
  72. var
  73.    frmAttributes: TfrmAttributes;      // Instance of the form
  74.  
  75. implementation
  76. {$R *.DFM}
  77.  
  78. { -----------------------------------------------------------------------------
  79. Method:         FormCreate( Sender: TObject )
  80.  
  81. Parameters:     Object or control that triggered the event
  82.  
  83. Returns:        Nothing
  84.  
  85. Purpose:        Event method called by Windows when the form is being created.
  86. ----------------------------------------------------------------------------- }
  87. procedure TfrmAttributes.FormCreate( Sender: TObject );
  88. begin
  89.    // Set the size of the form
  90.    ClientHeight := lblInsertCount.Top + lblInsertCount.Height + 8;
  91.    ClientWidth := btnZoom.Left + btnZoom.Width + 4;
  92.  
  93.    // Clear the labels and disable some of the controls
  94.    lblFileName.Caption := '';
  95.    lblInsertCount.Caption := '';
  96.    btnSelect.Enabled := False;
  97.    btnGetAttributes.Enabled := False;
  98.    btnOutput.Enabled := False;
  99.    btnEditAttributes.Enabled := False;
  100.    btnZoom.Enabled := False;
  101.  
  102.    // Start an instance of VDraft
  103.    try
  104.       VDraft := CreateOleObject( 'Vdraft.Application' );
  105.    except
  106.       on EOleError do begin
  107.          // Give an error message and abort
  108.          MessageDlg( 'Unable to establish communications with VDraft.  Application cannot continue ...', mtError, [mbOK], 0 );
  109.          Close;
  110.       end;
  111.    end;
  112. end;
  113.  
  114. { -----------------------------------------------------------------------------
  115. Method:         FormClose( Sender: TObject )
  116.  
  117. Parameters:     Object or control that triggered the event
  118.  
  119. Returns:        Nothing
  120.  
  121. Purpose:        Event method called by Windows when the form is being closed.
  122. ----------------------------------------------------------------------------- }
  123. procedure TfrmAttributes.FormClose( Sender: TObject; var Action: TCloseAction );
  124. begin
  125.    // Shut down VDraft and free all memory
  126.    VDraft := UnAssigned;
  127.    Action := caFree;
  128. end;
  129.  
  130. { -----------------------------------------------------------------------------
  131. Method:         btnGetBlocksClick( Sender: TObject )
  132.  
  133. Parameters:     Object or control that triggered the event
  134.  
  135. Returns:        Nothing
  136.  
  137. Purpose:        Event method triggered when the user has clicked on the forms
  138.                 Get Blocks in Current Drawing button.
  139. ----------------------------------------------------------------------------- }
  140. procedure TfrmAttributes.btnGetBlocksClick( Sender: TObject );
  141. var
  142.    crCursor:    TCursor;               // Handle to current (saved) cursor
  143.    vBlocks:     Variant;               // Handle to block table
  144.    iCount:      Integer;               // Generic loop counter
  145.    iBlockCount: Integer;               // Number of blocks in drawing
  146. begin
  147.    // Let user know that we're working and clear block list
  148.    crCursor := Screen.Cursor;
  149.    Screen.Cursor := crHourglass;
  150.    lstBlocks.Items.Clear;
  151.  
  152.    // Are there any active documents?
  153.    if vDraft.Documents.Count = 0 then begin
  154.       // Restore the cursor and exit the procedure
  155.       Screen.Cursor := crCursor;
  156.       Exit;
  157.    end;
  158.  
  159.    // Get current drawing and display its name
  160.    vDrawing := vDraft.ActiveDocument;
  161.    lblFileName.Caption := vDrawing.FullName;
  162.  
  163.    // List all the blocks in the drawing
  164.    vBlocks := vDrawing.Blocks;
  165.    iBlockCount := vBlocks.Count;
  166.    for iCount := 1 to iBlockCount do begin
  167.       // CANNOT DO THIS IN DELPHI - Compiler thinks this is
  168.       //    a function call!
  169.       // vBlock := vBlocks( iCount );
  170.  
  171.       // Don't list dimensions or hatches
  172.       if vBlocks.Item( iCount ).IsAnonymous = False then
  173.          lstBlocks.Items.Add( vBlocks.Item( iCount ) );
  174.    end;
  175.  
  176.    // Restore the mouse pointer to normal
  177.    Screen.Cursor := crCursor;
  178. end;
  179.  
  180. { -----------------------------------------------------------------------------
  181. Method:         btnSelectClick( Sender: TObject )
  182.  
  183. Parameters:     Object or control that triggered the event
  184.  
  185. Returns:        Nothing
  186.  
  187. Purpose:        Event method triggered when the user has clicked on the forms
  188.                 Select All Inserts of Block button.
  189. ----------------------------------------------------------------------------- }
  190. procedure TfrmAttributes.btnSelectClick( Sender: TObject );
  191. var
  192.    crCursor:    TCursor;               // Handle to current (saved) cursor
  193.    vBlock:      Variant;               // Handle to specified block
  194.    vInserts:    Variant;               // Handle to specific block insertion
  195.    vCommands:   Variant;               // Handle to commands
  196.    vSelection:  Variant;               // Handle to selection set
  197.    psBlockName: String;                // Name of selected block
  198.    iCount:      Integer;               // Generic counter
  199. begin
  200.    // Set the cursor to an hourglass
  201.    crCursor := Screen.Cursor;
  202.    Screen.Cursor := crHourglass;
  203.  
  204.    // Get associated list of inserts from VDraft
  205.    psBlockName := lstBlocks.Items.Strings[lstBlocks.ItemIndex];
  206.    vBlock := vDrawing.Blocks.Item( psBlockName );
  207.    vInserts := vBlock.Inserts;
  208.  
  209.    // Group all selections under one command
  210.    vCommands := vDrawing.Commands;
  211.    vCommands.Group( 'select.inserts' + psBlockName );
  212.  
  213.    // Select all the inserts
  214.    vSelection := vDrawing.Selection;
  215.    for iCount := 1 to vInserts.Count do
  216.       vSelection.Add( vInserts.Item( iCount ) );
  217.  
  218.    // Restore the starting cursor
  219.    Screen.Cursor := crCursor;
  220. end;
  221.  
  222. { -----------------------------------------------------------------------------
  223. Method:         lstBlocksClick( Sender: TObject )
  224.  
  225. Parameters:     Object or control that triggered the event
  226.  
  227. Returns:        Nothing
  228.  
  229. Purpose:        Event method triggered when the user has clicked the mouse
  230.                 pointer in the forms block names list box.
  231. ----------------------------------------------------------------------------- }
  232. procedure TfrmAttributes.lstBlocksClick( Sender: TObject );
  233. var
  234.    vBlock: Variant;                    // Handle to specified block
  235.    iCount: Integer;                    // Number of block insertions
  236. begin
  237.    // Tell the user how many inserts of selected block there are
  238.    vBlock := vDrawing.Blocks.Item( lstBlocks.Items.Strings[lstBlocks.ItemIndex] );
  239.    iCount := vBlock.Inserts.Count;
  240.    lblInsertCount.Caption := Format( '%d inserts of block %s in this drawing',
  241.          [iCount, lstBlocks.Items.Strings[lstBlocks.ItemIndex]] );
  242.  
  243.    // Once they select a block, the buttons will do something
  244.    btnSelect.Enabled := True;
  245.    btnGetAttributes.Enabled := vBlock.HasAttributes;
  246.    btnOutput.Enabled := False;
  247.    lstAttributes.Items.Clear;
  248.    btnEditAttributes.Enabled := False;
  249.    btnZoom.Enabled := False;
  250. end;
  251.  
  252. { -----------------------------------------------------------------------------
  253. Method:         btnGetAttributesClick( Sender: TObject )
  254.  
  255. Parameters:     Object or control that triggered the event
  256.  
  257. Returns:        Nothing
  258.  
  259. Purpose:        Event method triggered when the user has clicked on the forms
  260.                 Get Attributes button.
  261. ----------------------------------------------------------------------------- }
  262. procedure TfrmAttributes.btnGetAttributesClick( Sender: TObject );
  263. var
  264.    crCursor:     TCursor;              // Handle to current (saved) cursor
  265.    psBlockName:  String;               // Name of block
  266.    psOutput:     String;               // Attribute names to display
  267.    vInserts:     Variant;              // Handle to specific block insertion
  268.    vAttribs:     Variant;              // Handle to specific attribute set
  269.    iAttribCount: Integer;              // Count of associated attributes
  270.    iCount1:      Integer;              // Generic counters
  271.    iCount2:      Integer;
  272. begin
  273.    // Set the cursor to an hourglass
  274.    crCursor := Screen.Cursor;
  275.    Screen.Cursor := crHourglass;
  276.  
  277.    // Clear the attribute list box
  278.    lstAttributes.Items.Clear;
  279.    btnEditAttributes.Enabled := False;
  280.    btnZoom.Enabled := False;
  281.  
  282.    // Get associated list of inserts from VDraft
  283.    psBlockName := lstBlocks.Items.Strings[lstBlocks.ItemIndex];
  284.    vInserts := vDrawing.Blocks.Item( psBlockName ).Inserts;
  285.    if vInserts.Count = 0 then
  286.       Exit;
  287.  
  288.    // Build up attribute list
  289.    iAttribCount := vInserts.Item( 1 ).Attributes.Count;
  290.    for iCount1 := 1 to vInserts.Count do begin
  291.       vAttribs := vInserts.Item( iCount1 ).Attributes;
  292.       psOutput := vAttribs.Item( 1 ).Text;
  293.       for iCount2 := 2 to iAttribCount do
  294.          psOutput := psOutput + ', ' + vAttribs.Item( iCount2 ).Text;
  295.       lstAttributes.Items.Add( psOutput );
  296.    end;
  297.  
  298.    // Allow output and restore the starting cursor
  299.    btnOutput.Enabled := True;
  300.    Screen.Cursor := crCursor;
  301. end;
  302.  
  303. { -----------------------------------------------------------------------------
  304. Method:         btnOutputClick( Sender: TObject )
  305.  
  306. Parameters:     Object or control that triggered the event
  307.  
  308. Returns:        Nothing
  309.  
  310. Purpose:        Event method triggered when the user has clicked on the forms
  311.                 Output button.
  312. ----------------------------------------------------------------------------- }
  313. procedure TfrmAttributes.btnOutputClick( Sender: TObject );
  314. //   Dim inserts, attribs As Object
  315. var
  316.    cdOpen:       TOpenDialog;          // Open file class
  317.    crCursor:     TCursor;              // Handle to current (saved) cursor
  318.    vInserts:     Variant;              // Handle to block insertions
  319.    vAttribs:     Variant;              // Handle to blocks attributes
  320.    psBlockName:  String;               // Name of specified block
  321.    psOutput:     String;               // Attribute data to write to file
  322.    hFile:        TextFile;             // Handle to the output file
  323.    iAttribCount: Integer;              // Count of attributes associated with block
  324.    iCount1:      Integer;              // Generic loop counter
  325.    iCount2:      Integer;
  326. begin
  327.    // Set the cursor to an hourglass
  328.    crCursor := Screen.Cursor;
  329.    Screen.Cursor := crHourglass;
  330.  
  331.    // Get associated list of inserts from Vdraft
  332.    psBlockName := lstBlocks.Items.Strings[lstBlocks.ItemIndex];
  333.    vInserts := vDrawing.Blocks.Item( psBlockName ).Inserts;
  334.  
  335.    // Ask the user for a file name
  336.    try
  337.       cdOpen := TOpenDialog.Create( Application );
  338.  
  339.       // Set specific properties of the dialog
  340.       cdOpen.Filter := 'All Files (*.*)|*.*|' +
  341.             'Attributes (*.att)|*.att|';
  342.       cdOpen.Options := [ofPathMustExist, ofOverwritePrompt];
  343.  
  344.       // Did the user cancel?
  345.       if cdOpen.Execute then begin
  346.          try
  347.             // Open the file for writing
  348.             AssignFile( hFile, cdOpen.Filename );
  349.             Rewrite( hFile );
  350.  
  351.             // Build up attribute list
  352.             iAttribCount := vInserts.Item( 1 ).Attributes.Count;
  353.             for iCount1 := 1 to vInserts.Count do begin
  354.                vAttribs := vInserts.Item( iCount1 ).Attributes;
  355.                psOutput := vAttribs.Item( 1 ).Text;
  356.                for iCount2 := 2 to iAttribCount do
  357.                   psOutput := psOutput + ', ' + vAttribs.Item( iCount2 ).Text;
  358.  
  359.                // Write the complete attribute definition to the file
  360.                WriteLn( hFile, psOutput );
  361.             end;
  362.  
  363.             // Close the file when done
  364.             CloseFile( hFile );
  365.  
  366.          except
  367.             on Exception do
  368.                MessageDlg( 'Unable to create ' + cdOpen.Filename, mtError, [mbOK], 0 );
  369.          end;
  370.       end;
  371.  
  372.    except
  373.       on Exception do
  374.          MessageDlg( 'Unable to initialize Windows Common Dialog...', mtError, [mbOK], 0 );
  375.    end;
  376.  
  377.    // Free the dialog instance and restore starting cursor
  378.    cdOpen.Free;
  379.    Screen.Cursor := crCursor;
  380. end;
  381.  
  382. { -----------------------------------------------------------------------------
  383. Method:         lstAttributesClick( Sender: TObject )
  384.  
  385. Parameters:     Object or control that triggered the event
  386.  
  387. Returns:        Nothing
  388.  
  389. Purpose:        Event method triggered when the user has clicked the mouse
  390.                 pointer in the forms attribute list box.
  391. ----------------------------------------------------------------------------- }
  392. procedure TfrmAttributes.lstAttributesClick( Sender: TObject );
  393. begin
  394.    // Enable the edit and zoom buttons
  395.    btnEditAttributes.Enabled := True;
  396.    btnZoom.Enabled := True;
  397. end;
  398.  
  399. { -----------------------------------------------------------------------------
  400. Method:         btnEditAttributesClick( Sender: TObject )
  401.  
  402. Parameters:     Object or control that triggered the event
  403.  
  404. Returns:        Nothing
  405.  
  406. Purpose:        Event method triggered when the user has clicked on the forms
  407.                 Edit Attributes button.
  408. ----------------------------------------------------------------------------- }
  409. procedure TfrmAttributes.btnEditAttributesClick( Sender: TObject );
  410. var
  411.    vInserts:    Variant;               // Handle to specific block insertion
  412.    psBlockName: String;                // Name of specified block
  413. begin
  414.    // Find the selected insert of the block name
  415.    psBlockName := lstBlocks.Items.Strings[lstBlocks.ItemIndex];
  416.    vInserts := vDrawing.Blocks.Item( psBlockName ).Inserts;
  417.  
  418.    // Display the properties for the selected insert
  419.    vInserts.Item( lstAttributes.ItemIndex + 1 ).Dialog;
  420. end;
  421.  
  422. { -----------------------------------------------------------------------------
  423. Method:         btnZoomClick( Sender: TObject )
  424.  
  425. Parameters:     Object or control that triggered the event
  426.  
  427. Returns:        Nothing
  428.  
  429. Purpose:        Event method triggered when the user has clicked on the forms
  430.                 Zoom to Insert button.
  431. ----------------------------------------------------------------------------- }
  432. procedure TfrmAttributes.btnZoomClick( Sender: TObject );
  433. var
  434.    vBlock:      Variant;               // Handle to specific block
  435.    vInsert:     Variant;               // Handle to specific block insertion
  436.    vOffset:     Variant;               // Handle to vector of block's basepoint
  437.    vCorner1:    Variant;               // Handles to corners of block extents
  438.    vCorner2:    Variant;
  439.    vCenter:     Variant;               // Handle to center of view
  440.    vView:       Variant;               // Handle to active view
  441.    psBlockName: String;                // Name of specific block
  442.    fWidth:      Double;                // Sizes of view
  443.    fHeight:     Double;
  444. begin
  445.    // Find the selected block
  446.    psBlockName := lstBlocks.Items.Strings[lstBlocks.ItemIndex];
  447.    vBlock := vDrawing.Blocks.Item( psBlockName );
  448.    vInsert := vBlock.Inserts.Item( lstAttributes.ItemIndex + 1 );
  449.  
  450.    // Start out with the extents of the block
  451.    vCorner1 := vBlock.ExtentsMin;
  452.    vCorner2 := vBlock.ExtentsMax;
  453.  
  454.    // Adjust the insert point by the block's basepoint
  455.    //    so we know how much to offset the block extents by
  456.    vOffset := vBlock.Where;
  457.    vOffset.Detach;                     // We want to change the vector but not the basepoint
  458.    vOffset.SubtractAway( vInsert.Where );
  459.    vCorner1.SubtractAway( vOffset );
  460.    vCorner2.SubtractAway( vOffset );
  461.  
  462.    // F.find the center and height/width of insert area
  463.    fWidth := vCorner2.x -vCorner1.x;
  464.    fHeight := vCorner2.y - vCorner1.y;
  465.    vCenter := vDraft.NewVector( vCorner1.x + fWidth / 2, vCorner1.y + fHeight / 2 );
  466.  
  467.    // Change the current view so it just shows the insert
  468.    vView := vDrawing.Views.ActiveView;
  469.    vView.Center( vCenter );
  470.    vView.Width := 2 * fWidth;
  471.    vView.Height := 2 * fHeight;
  472. end;
  473.  
  474. { -----------------------------------------------------------------------------
  475. Method:         btnQuitClick( Sender: TObject )
  476.  
  477. Parameters:     Object or control that triggered the event
  478.  
  479. Returns:        Nothing
  480.  
  481. Purpose:        Event method triggered when the user has clicked on the forms
  482.                 Quit button.
  483. ----------------------------------------------------------------------------- }
  484. procedure TfrmAttributes.btnQuitClick( Sender: TObject );
  485. begin
  486.    // Close the application
  487.    Close;
  488. end;
  489.  
  490. end.
  491.  
  492.