The DataCAD Developer Network (DDN) is an online resource for information and support for DCAL® (DataCAD Applications Language) developers as well as anyone interested in creating fonts, toolbars, hatch patterns, or linetypes for use in DataCAD.
#72327 by Jsosnowski
Sun Sep 17, 2017 7:26 pm
PART FIVE - A DCAL FOR DELPHI PRIMER - _MACRO TEMPLATES & EXAMPLES

This Topic will provide macro templates configured for different common conditions. Each template library will be published as a separate reply in this posting along with specific units required. Note that Delphi and Datacad units included in the 'uses' declaration can are provided by Delphi and Datacad respectively. Each macro has been tested. Please report any anomalies you uncover.

Macro templates include

1. GetEsc Example. A simple macro with a single menu loop using the getesc() procedure to gain user input. This example includes an example of the callnone() procedure to notify thedispatcher of a non interface action in the EXECUTE STEP.
2. GetPnt Example. A simple macro with a single menu loop using getpoint() to read function keys and get points. It collects two points and draws a line. It also toggles several datarecord values and uses them to display menu titles and toggles which is useful if the macro changes thename of a menu item on the fly.
Last edited by Jsosnowski on Tue Dec 26, 2017 3:09 pm, edited 3 times in total.
#72328 by Jsosnowski
Sun Sep 17, 2017 7:27 pm
Getesc Macro Example

Edit: 12/24/17 added EXIT STEP

A simple macro with a single menu loop using the getesc() procedure to obtain user input. This example includes an example of the callnone() procedure to notify the Datacad dispatcher of a non interface action in the EXECUTE STEP. All code for this macro is provided in a single file.

Code: Select alllibrary geteTemplate;
uses
  System.SysUtils,
  System.Classes,
  dialogs, //for showmessage
  //Datacad units
  UConstants in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UConstants.pas',
  UDCLibrary in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UDCLibrary.pas',
  UInterfaces in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UInterfaces.pas',
  UInterfacesRecords in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UInterfacesRecords.pas',
  URecords in 'C:\DataCAD 19\DCAL for Delphi\Header Files\URecords.pas',
  UVariables in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UVariables.pas';

//Delphi compiler instructions {3}
{$E dmx}  //dmx is the extension for DCAL Dll's
{$R *.res}

const {5}
//dcalstate constants
   XMain = XDcalStateBegin;  {Currently set as 8100 by uconstants.pas}
  //add an incremented dcalstate constant for each Name _doMenu or Datacad menu call function included inthe 'Main' function below.
  //   X<name> = XMain +1;

type
tMain_LR = record  //looprecord
  state: asint;
  case byte of  // typical options included
  0: (getp: getpointArg);
  1: (gete: getescarg);
  3: (getd: getdisarg);
  4: (geta: getangarg);
  5: (geti: getintarg);
  6: (getc: getclrarg);
  7: (gets: DgetstrArg);
  8: (getr: getrealArg);
end;
pMain_LR = ^tMain_LR;

tName_DR = record  //datarecord
    str : shortstring;
end;
pName_DR = ^tName_DR;

var
  theData : tName_DR;  //actual data record instance at unit level

function Main_doMenu(act : action; p_LR, p_DR : Pointer) : wantType;
var
   i, retval : asint;
   lr : pMain_LR;
   dr : pName_DR;
begin
   lr := pMain_LR(p_LR);

   dr := addr(theData); //use in first menu
//above or below
//   dr := PTestDataRecord(p_DR);  /for secondary menus where data is passed through p_DR.

                                              //START SECTION:
   case act of
                                                  //SIZING STEP
     alsize:
       begin
         SetLocalSize(sizeof(lr^));
       end;
                                                  //INITIALIZE MACRO STEP
     afirst:
       begin
         lr.state := 1;
         theData.str := 'This is a test string.';
       end;
                                                  //ROUTER STEP
     aagain:
       begin
         case lr.state of
         1 :
           begin

             case lr.gete.key of
               f1 : lr.state := 2; //2
//               f2 : lr.state := ; //
//               f3 : lr.state := ; //
//               f4 : lr.state := ; //
//               f5 : lr.state := ; //
//               f6 : lr.state := ; //
//               f7 : lr.state := ; //
//               f8 : lr.state := ; //
//               f9 : lr.state := ; //
//               f0 : lr.state := ; //
//               s1 : lr.state := ; //
//               s2 : lr.state := ; //
//               s3 : lr.state := ; //
//               s4 : lr.state := ; //
//               s5 : lr.state := ; //
//               s6 : lr.state := ; //
//               s7 : lr.state := ; //
//               s8 : lr.state := ; //
//               s9 : lr.state := ; //
               s0 : lr.state :=  0; //
             end
           end;
         2 : lr.state := 1; //add cases to match function key assignments
         else
           lr.state := 0;
         end;
       end;
                                                  //SPECIAL EXIT STEP
     alast:
       begin
           retval := Xdone;
       end;
   end;
                                              //EXECUTE SECTION
   if act <> alsize then begin
      case lr.state of
         1 :                                      //DISPLAY STEP
         begin
            wrtlvl('Getesc');
            lblsinit;
            lblset (1, 'Show Msg');   //2
            lblmsg (1, 'Display the showmessage box.');
//            lblset (2, '');
//            lblmsg (2, '');
//            lblset (3, '');
//            lblmsg (3, '');
//            lblset (4, '');
//            lblmsg (4, '');
//            lblset (5, '');
//            lblmsg (5, '');
//            lblset (6, '');
//            lblmsg (6, '');
//            lblset (7, '');
//            lblmsg (7, '');
//            lblset (8, '');
//            lblmsg (8, '');
//            lblset (9, '');
//            lblmsg (9, '');
//            lblset (10, '');
//            lblmsg (10, '');
//            lblset (11, '');
//            lblmsg (11, '');
//            lblset (12, '');
//            lblmsg (12, '');
//            lblset (13, '');
//            lblmsg (13, '');
//            lblset (14, '');
//            lblmsg (14, '');
//            lblset (15, '');
//            lblmsg (15, '');
//            lblset (16, '');
//            lblmsg (16, '');
//            lblset (17, '');
//            lblmsg (17, '');
//            lblset (18, '');
//            lblmsg (18, '');
//            lblset (19, '');
//            lblmsg (19, '');
            lblset (20, 'Exit');   //0
            lblson;

            wrtmsg ('Select Function key.');
            getesc (lr.gete, retval);             //INPUT STEP
         end;
                                                  //EXECUTE STEPS
         2 :  //enter action for each case as required
         begin
           showmessage (dr.str);
           callNone (retval); //notify dispatcher
         end;
{         3:  add other lr.state cases to match action states in macro
         begin

         end;
}
         else
            retval := XDone;
      end;
   end;
   Result := retval;

   if retval = Xdone then begin                       //EXIT STEP                     
      //add function finalization actions
   end;
end; //Lvl2_doMenu


function Main(dcalstate : asint; act : action; p_LR, p_DR : Pointer) : wantType; stdcall;
begin
   case dcalstate of
      XMain : Result := Main_doMenu(act, p_LR, p_DR);
      //add dcalstate cases with menu calls as required
      else
         Result := XDone;//Necessary/
   end;
end;

exports
  Main;{This is the entry function that will be called by DataCAD. All DCAL Dlls
  will have this function.}

begin
end.
Last edited by Jsosnowski on Wed Dec 27, 2017 6:56 pm, edited 5 times in total.
#72329 by Jsosnowski
Sun Sep 17, 2017 8:02 pm
GetPnt Example

[i]Edit: 12/24/17 Added EXIT STEP

A single file macro with a single menu loop using getpoint() to read function keys and get points. It collects two points and draws a line. It also toggles several datarecord values and uses them to display menu titles and toggles which is useful if the macro changes the name of a menu item on the fly.This is a one level menu template using getpoint() for user input.

Getting multiple points

This macro gathers points used to create a line. Although only two are used here, additional points can be gathered with minor changes to the code. The first step is to define the number of points required by defining a constant 'maxPnt' set to the number of points desired. The actual point values are held in an array field, 'Pnts', in the loop record argument p_LR and sized to match the 'maxpnt' value. The user inputs individual points in each iteration of the menu procedure with the count field 'PntCount' keeping track. Once all the points are gathered, the procedure Addline is called and the NumCount is reset to 1 and lr.state is returned to 1 starting the process over again.


Code: Select alllibrary GetP1LevelTemplate;
uses
  Dialogs,
  Forms,
  Windows,
  UConstants in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UConstants.pas',
  UInterfaces in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UInterfaces.pas',
  UInterfacesRecords in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UInterfacesRecords.pas',
  URecords in 'C:\DataCAD 19\DCAL for Delphi\Header Files\URecords.pas',
  UVariables in 'C:\DataCAD 19\DCAL for Delphi\Header Files\UVariables.pas';

{$E dmx}
{$R *.res}

const
   MacroVersion = '2.0.0.3';
   maxPnt = 3;

type

tMain_LR = record
  state: asint; {1}
  pnt:      array [1..maxPnt] of point;
  pntCount:   asint;
  case byte of
  0: (getp: getpointArg);
  1: (gete: getescarg);
  3: (getd: getdisarg);
  4: (geta: getangarg);
  5: (geti: getintarg);
  6: (getc: getclrarg);

end;
pMain_LR = ^tMain_LR;
tTest_DR = record
  lbl1, lbl2, lbl3 :shortstring;
  lbl1bool, lbl2Bool, lbl3bool : boolean;
end;
PTest_DR = ^tTest_DR;

var
  AData : tTest_DR;


procedure init_data;
begin
  Adata.lbl1 := 'Label 1';
  Adata.lbl2 := 'Label 2';
  Adata.lbl3 := 'Label 3';
  Adata.lbl1bool := true;
  Adata.lbl2bool := false;
  Adata.lbl3bool := true;
end;

   procedure addLine(pnt1, pnt2 : point);
   var
      ent :    entity;
   begin
      stopgroup;                    { make the entity into a group }
      ent_init (ent, entlin);
      ent.linpt1 :=  pnt1;
      ent.linpt2 := pnt2;
      ent_add (ent);
      ent_draw (ent, drmode_white);
      stopgroup;
   end;

   function Main_doMenu(act : action; p_LR, p_DR : Pointer) : wantType;
   var
      retval : asint;
      lr : pMain_LR;
      dr : pTest_DR;
   begin
      lr := pMain_LR(p_DR);
      dr := addr(AData);
                                                 //START SECTION:
      case act of
                                                     //SIZING STEP
        alsize:
          begin
            SetLocalSize(sizeof(lr^));
          end;
                                                     //INITIALIZE MACRO STEP
        afirst:
          begin
           init_data;
           lr.state     := 1;
           lr.pntCount    := 1;
          end;
                                                     //ROUTER STEP
        aagain:
          begin
            case lr.state of
            1 :
              begin
                if lr.getp.Result = res_escape then begin
                  case lr.getp.key of
                     f1 : lr.state  := 2;
                     f2 : lr.state := 3;
                     s0 : lr.state := 0;
                  end;
                end
                else if lr.getp.Result = res_normal then begin
                  lr.pnt[lr.pntCount] := lr.getp.curs;
                  if lr.pntCount < maxPnt then begin
                     lr.pntCount := lr.pntCount + 1;
                  end
                  else begin
                     addLine(lr.pnt[2], lr.pnt[3]);
                     lr.pntCount := 1;
                  end;
                end;
              end;
            2, 3 : lr.state := 1;
            else
               lr.state := 0;
            end;

          end;
                                                     //SPECIAL EXIT STEP
          alast:
            begin
              retval := Xdone;
          end;
      end;

                                                 //EXECUTE SECTION
      if act <> alsize then begin
         wrterr('DCAL Macro Arrow - Version ' + MacroVersion, true);
         case lr.state of
            1 :                                      //DISPLAY STEP
            begin
               wrtlvl('ATest 2');        { the 8 character identifier on the message line }
               lblsinit;               { initialize the function key labels }
               lblset(1, dr.lbl1);     { set the function key labels }
               lblsett(2, dr.lbl2, dr.lbl2Bool);
               lblset(20, 'Exit');
               lblson;                 { turn on the function keys }
               { prompt the user for what to do }
               if lr.pntCount = 1 then begin
                  wrtmsg('Enter first point of line.');

               end
               else begin
                  wrtmsg('Enter next point of line.');
                  rubln^ := true;
                end;
               getpoint(lr.getp, retval);             //INPUT STEP
            end;
                                                     //EXECUTE STEPS
            2 :
            begin
              wrterr ('F2 Selected');
            end;
            3:
            begin
              if dr.lbl2Bool then
                dr.lbl2Bool := false
              else
                dr.lbl2Bool := true;
            end
            else
               retval := XDone;
         end;
      end;
      Result := retval;
      if retval = Xdone then begin                           //EXIT STEP
        //add function finalization actions
     end;
 end;

   function Main(dcalstate : asint; act : action; pl, pargs : Pointer) : wantType; stdcall;
   begin
      case dcalstate of
         XDcalStateBegin : Result := Main_doMenu(act, pl, pargs);
         else
            Result := XDone;{Necessary}
      end;
   end;


exports
   Main;{This is the entry function that will be called by DataCAD. All DCAL Dlls
   will have this function.}

begin

end.

Who is online

Users browsing this forum: No registered users and 11 guests

About DataCAD Forum

The DataCAD Forum is a FREE online community we provide to enhance your experience with DataCAD.

We hope you'll visit often to get answers, share ideas, and interact with other DataCAD users around the world.

DataCAD

Software for Architects Since 1984