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.