aboutsummaryrefslogtreecommitdiff
path: root/Scripting/Perl/FormSpy.pl
blob: f4d2a190afe8fc3a333218d35d0e2d41167b8e98 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
#!/usr/bin/perl -w
########################################################################
#
#	File:			FormSpy.pl
#
#	Purpose:		Examine the current active form.
#
#	Description:	This script gets the current active form, iterates
#					over its contents, and prints out information on
#					all of the form objects.  For each object, it prints
#
#					* The object's index number (starting from zero)
#					* The object's type (frmTitleObj, etc.)
#					* Text associated with the object (only for title,
#					  label, and control objects)
#					* The object's bounds
#
########################################################################

use EmRPC;			# EmRPC::OpenConnection, CloseConnection
use EmFunctions;

EmRPC::OpenConnection(6415, "localhost");

	#=====================================================================
	# Get the current form and the number objects on that form.
	#=====================================================================

	my ($form) = FrmGetActiveForm();
	my ($num_objects) = FrmGetNumberOfObjects($form);

	#=====================================================================
	# Iterate over all the objects on the form.
	#=====================================================================

	for $ii (0..$num_objects - 1)
	{
		#=====================================================================
		# Start generating the line to print.  Start with the object's index.
		#=====================================================================

		my ($line) = "$ii. ";

		#=====================================================================
		# Add the object's type (frmTitleObj, etc.) to the line.
		#=====================================================================

		my ($object_type) = FrmGetObjectType($form, $ii);

		my ($type) = ("frmFieldObj", "frmControlObj", "frmListObj", "frmTableObj",
					  "frmBitmapObj", "frmLineObj", "frmFrameObj", "frmRectangleObj",
					  "frmLabelObj", "frmTitleObj", "frmPopupObj", "frmGraffitiStateObj",
					  "frmGadgetObj", "frmScrollBarObj")[$object_type];

		$line .= " $type";

		#=====================================================================
		# If the object is a frmControlObj, frmLabelObj, or frmTitleObj,
		# get the text associated with the object and add it to our line.
		#=====================================================================

		if ($object_type == frmControlObj)
		{
			my ($obj_ptr) = FrmGetObjectPtr ($form, $ii);
			my ($address, $label) = CtlGetLabel($obj_ptr);
			$line .= " \"$label\"";
		}
		elsif ($object_type == frmLabelObj)
		{
			my ($label_id) = FrmGetObjectId ($form, $ii);
			my ($address, $label) = FrmGetLabel($form, $label_id);
			$line .= " \"$label\"";
		}
		elsif ($object_type == frmTitleObj)
		{
			my ($address, $title) = FrmGetTitle($form,);
			$line .= " \"$title\"";
		}
		else
		{
			$line .= " <no label>";
		}

		#=====================================================================
		# Add the object's bounds to the line.
		#=====================================================================

		my (%bounds) = FrmGetObjectBounds($form, $ii);
		$line .= " ($bounds{left}, $bounds{top}, $bounds{right}, $bounds{bottom})";

		#=====================================================================
		# Print out the result.
		#=====================================================================

		print "$line\n";
	}

EmRPC::CloseConnection();