Skip to content
Navigation Menu
{{ message }}
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathhtmldesigner.pls
More file actions
409 lines (368 loc) · 14.2 KB
/
htmldesigner.pls
File metadata and controls
409 lines (368 loc) · 14.2 KB
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
*---------------------------------------------------------------
.
. Program Name: htmldesigner
. Description: Designer for HTMLCONTROL
.
. Revision History:
.
. 21 Jun 19 W Keech
. Original code
.
*---------------------------------------------------------------
INCLUDE plbequ.inc
INCLUDE plbmeth.inc
.
HtmlCtl HTMLCONTROL
.
EditForm PLFORM "designerf1.pwf"
HtmlForm PLFORM "designerf2.pwf"
SaveForm PLFORM "designerf3.pwf"
Client CLIENT
CliInfo DIM 1024
.
FullHtml DIM 64000
DataUni DIM 64000
JsonData DIM 200
JsonEvent XDATA
.
Result FORM 5
CurIndex FORM 5
Info DIM 30
.
SnipData DIM 32000
SnipFileName DIM 270
SnipFile FILE
Seq FORM "-1"
Zero FORM "0"
Rep7F INIT "|",0x7F
.
FileName DIM 270
D1 DIM 1
Right FORM 5
Bottom FORM 5
IsWin FORM "0"
IsUtf8 FORM "0"
HtmlPageBlank INIT "<html><head>",0xD,0xA:
"<meta http-equiv='X-UA-Compatible' content='IE=edge' />",0xD,0xA:
"<style>",0xD,0xA:
"</style>",0xD,0xA:
"</head>",0xD,0xA:
"<body>",0xD,0xA:
"</body>",0xD,0xA:
"</html>",0xD,0xA
*................................................................
.
. Code start
.
CALL Main
STOP
*................................................................
.
. FetchJsonStringValue - Fetch string data for String 'label'
.
. Only update the result if the label is found
.
FetchJsonStringValue LFUNCTION
pXData XDATA ^
xLabel DIM 50
dReturn DIM ^
ENTRY
.
xString DIM 200
x200 DIM 200
xError DIM 100
nvar FORM 2
.
. Find the specified JSON label node
.
PACK s$cmdlin, "label='",xLabel,"'"
pXData.FindNode GIVING nvar:
USING *FILTER=S$cmdlin: //Locate specified JSON label!
*POSITION=START_DOCUMENT_NODE //Start at the beginning of the document!
IF ( nvar == 0 )
...
. Move to the child node of the 'orient' JSON label.
.
pXData.MoveToNode GIVING nvar USING *POSITION=MOVE_FIRST_CHILD
.
IF ( nvar == 0 )
...
. Fetch the data for the JSON label.
.
pXData.GetText GIVING xString
PACK s$cmdlin, xLabel,"= '",xString,"'"
ELSE
MOVE "Error Move Node:", s$cmdlin
ENDIF
ELSE
PACK s$cmdlin, "Error Find Node:",nvar
ENDIF
TYPE xString
IF NOT EOS
MOVE xString, dReturn
ENDIF
FUNCTIONEND
*................................................................
.
. SaveIt - Handle the Save button on the Save Dialog
.
SaveIt LFUNCTION
ENTRY
CLEAR SnipData
GETPROP EditText2,Text=SnipFileName
SCAN ".snip" Into SnipFileName
IF Equal
LENSET SnipFileName
ELSE
ENDSET SnipFileName
APPEND "." To SnipFileName
ENDIF
GETPROP CheckBox1, Value=IsUtf8
IF (IsUtf8 == 0 )
GETPROP EditText1,Text=SnipData
APPEND "snip" To SnipFileName
ELSE
APPEND "snip8" To SnipFileName
IF (IsWin == 0 )
Client.SetUTF8Convert Using 0
GETPROP EditText1,Text=SnipData
Client.SetUTF8Convert Using 1
ELSE
EditText1.GetUnicode Giving DataUni
CONVERTUTF DataUni, SnipData, "8" ;Convert Unicode to UTF8
ENDIF
ENDIF
RESET SnipFileName
SETPROP EditText2,Text=SnipFileName
PREP SnipFile,SnipFileName
WEOF SnipFile,Zero
WRITE SnipFile,Seq;*LL,*ABSON, SnipData;
CLOSE SnipFile
DEACTIVATE SaveDialog
FUNCTIONEND
*................................................................
.
. CancelIt - Handle the Cancel button on the Save dialog
.
CancelIt LFUNCTION
ENTRY
DEACTIVATE SaveDialog
FUNCTIONEND
*................................................................
.
. SaveAs - Handle the Save As button
.
SaveAs LFUNCTION
ENTRY
ACTIVATE SaveDialog
FUNCTIONEND
*................................................................
.
. TemplateReset - Reset the template and snippet list
.
TemplateReset LFUNCTION
ENTRY
snipNames DIM 32000
FINDDIR "htmlsnippets\*.snip*", snipNames, MODE=3
ComboBox1.ResetContent
SETPROP EditText1,Text=HtmlPageBlank
PACK snipNames, snipNames, "|F"
LOOP
EXPLODE snipNames, "|", FileName
BREAK If Zero
UNPACK FileName Into D1,SnipFileName
TYPE SnipFileName
BREAK if EOS
ComboBox1.AddString Using SnipFileName
REPEAT
SETPROP FORM2, TITLE="HtmlControl Test" //ERB
SETPROP HtmlCtl, InnerHtml="" //ERB
SETPROP EditText2, TEXT="" //ERB
SETFOCUS ComboBox1 //ERB
FUNCTIONEND
*................................................................
.
. ResetIt - Reset the edit area
.
ResetIt LFUNCTION
ENTRY
SETPROP EditText1,Text=HtmlPageBlank
ListView1.DeleteAllItems
CALL TemplateReset
FUNCTIONEND
*................................................................
.
. LoadTemplate - Load a template from disk
.
LoadTemplate LFUNCTION
ENTRY
ListView1.DeleteAllItems
EVENTINFO 0,result=Result
SUB "1" From Result
ComboBox1.GetText Giving FileName Using Result
PACK SnipFileName Using "htmlsnippets\", FileName
CHOP SnipFileName
SETPROP EditText2,Text=SnipFileName
OPEN SnipFile,SnipFileName
READ SnipFile,Seq;*LL,*ABSON, SnipData;
CLOSE SnipFile
SCAN ".snip8" Into SnipFileName
IF Equal
MOVE "1" To IsUtf8
ELSE
MOVE "0" To IsUtf8
ENDIF
SETPROP CheckBox1, Value=IsUtf8
IF (IsUtf8 == 0 )
SETPROP EditText1,Text=SnipData
ELSE
IF (IsWin == 0 )
Client.SetUTF8Convert Using 0
SETPROP EditText1,Text=SnipData
Client.SetUTF8Convert Using 1
ELSE
CONVERTUTF SnipData, DataUni, "6" ;Convert input UTF8 to UTF16
EditText1.SetUnicode Using DataUni
ENDIF
ENDIF
PACK S$CMDLIN, "HtmlControl Template '",SnipFileName,"'" //ERB
SETPROP FORM2, TITLE=S$CMDLIN //ERB
FUNCTIONEND
*................................................................
.
. EnableIt - Test the enabled property
.
EnableIt LFUNCTION
ENTRY
SETPROP HtmlCtl,Enabled=1
FUNCTIONEND
*................................................................
.
. DisableIt - Test the disabled property
.
DisableIt LFUNCTION
ENTRY
SETPROP HtmlCtl,Enabled=0
FUNCTIONEND
*................................................................
.
. Test - Test the HTML
.
Test LFUNCTION
ENTRY
SETPROP Form2,Visible=0
GETPROP CheckBox1, Value=IsUtf8
IF (IsUtf8 == 0 )
SETPROP HtmlCtl,CodePage=1
GETPROP EditText1,Text=FullHtml
ELSE
SETPROP HtmlCtl,CodePage=0
IF (IsWin == 0 )
Client.SetUTF8Convert Using 0
GETPROP EditText1,Text=FullHtml
Client.SetUTF8Convert Using 1
ELSE
EditText1.GetUnicode Giving DataUni
CONVERTUTF DataUni, FullHtml, "8" ;Convert Unicode to UTF8
ENDIF
ENDIF
// Turn on context menu for debugging
HtmlCtl.ContextMenu Using 1
// Could have used HtmlCtl.InnerHtml Using FullHtml
SETPROP HtmlCtl,InnerHtml=FullHtml
SETPROP Form2,Visible=1
FUNCTIONEND
*................................................................
.
. HideTextWin - Hide ethe test window
.
HideTestWin LFUNCTION
ENTRY
SETPROP Form2,Visible=0
FUNCTIONEND
*................................................................
.
. FocusTesting - Set focus to the HTMLCONTROL
.
FocusTesting LFUNCTION
ENTRY
SETFOCUS HtmlCtl
FUNCTIONEND
*................................................................
.
. PrintIt - Show a print preview of the control
.
PrintIt LFUNCTION
ENTRY
PrtPict PICT
PrtFile PFILE
GETPROP EditText2,Text=SnipFileName
HtmlCtl.MakePict Giving PrtPict
SETPROP Form2,Units=$LOENGLISH
GETPROP HtmlCtl, Width=Right,Height=Bottom
ADD "30" To Bottom
ADD "10" TO Right
SETPROP Form2,Units=$PIXELS
PRTOPEN PrtFile,"@pdf:",""
PRTPAGE PrtFile;*Orient=*landscape, "File Name: ", SnipFileName:
*Units=*LOENGLISH,*PictRect=*Off,*Pict=30:Bottom:10:Right:PrtPict
PRTCLOSE PrtFile
FUNCTIONEND
*................................................................
.
. HtmlEvCtl - Display the HTMLCONTROL event information
.
HtmlEvCtl LFUNCTION
ENTRY
JsonEvent.LoadJson Using JsonData
CALL FetchJsonStringValue Using JsonEvent,"type",Info
ListView1.InsertItemEx Giving CurIndex Using Info
CALL FetchJsonStringValue Using JsonEvent,"id",Info
ListView1.SetItemText Using CurIndex, Info, 1
CALL FetchJsonStringValue Using JsonEvent,"pageX",Info
ListView1.SetItemText Using CurIndex, Info, 2
CALL FetchJsonStringValue Using JsonEvent,"pageY",Info
ListView1.SetItemText Using CurIndex, Info, 3
CALL FetchJsonStringValue Using JsonEvent,"metaKey",Info
ListView1.SetItemText Using CurIndex, Info, 4
CALL FetchJsonStringValue Using JsonEvent,"which",Info
ListView1.SetItemText Using CurIndex, Info, 5
CALL FetchJsonStringValue Using JsonEvent,"target",Info
ListView1.SetItemText Using CurIndex, Info, 6
FUNCTIONEND
*................................................................
.
. Main - Main entry point
.
Main LFUNCTION
ENTRY
WINHIDE
FORMLOAD HtmlForm
CREATE Panel1;HtmlCtl=0:0:100:100,DOCK=6,Visible=1,TABID=1
EVENTREG HtmlCtl,200,HtmlEvCtl,ARG1=JsonData
FORMLOAD EditForm
ListView1.DeleteAllContents
ListView1.InsertColumnEx Using "type", 100, 0
ListView1.InsertColumnEX Using "id", 160, 1
ListView1.InsertColumn Using "pageX", 80, 2
ListView1.InsertColumn Using "pageY", 80, 3
ListView1.InsertColumn Using "metaKey", 80, 4
ListView1.InsertColumn Using "which", 80, 5
ListView1.InsertColumn Using "targetId", 160, 6
FORMLOAD SaveForm
EVENTREG HtmlSave,200,SaveIt
EVENTREG HtmlCancel,200,CancelIt
CALL TemplateReset
Client.GetInfo Giving CliInfo
TYPE CliInfo
IF Eos
SETPROP PrtBtn,Visible=1
MOVE "1" To IsWin
ELSE
SETPROP Form2,Visible=0
ENDIF
SETFOCUS ComboBox1
LOOP
EVENTWAIT
REPEAT
FUNCTIONEND
You can’t perform that action at this time.