"SfR Fresh" - the SfR Freeware/Shareware Archive 
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 '
2 ' ####################
3 ' ##### PROLOG #####
4 ' ####################
5 '
6 PROGRAM "ADrawing"
7 VERSION "0.1000"
8 '
9 'This demo program provides examples on using various graphic drawing functions
10 'and altering various graphic settings such as color, line width, line style,
11 'and arrow direction. Various functions used in this program include:
12 ' XgrDrawArc()
13 ' XgrDrawBorder()
14 ' XgrDrawBox()
15 ' XgrDrawCircle()
16 ' XgrDrawLine()
17 ' XgrDrawPoint()
18 ' XgrDrawText()
19 ' XgrDrawTextFill()
20 ' XgrFillBox()
21 ' XgrFillTriangle()
22 '
23 'This program is in the public domain.
24 'David SZAFRANSKI
25 'June 1999
26 'digital_paris@csi.com
27 '
28 ' You can stop the PDE from inserting the following PROLOG comment lines
29 ' by removing them from the gprolog.xxx file in your \xb\xxx directory.
30 '
31 ' Programs contain: 1: PROLOG - no executable code - see below
32 ' 2: Entry function - start execution at 1st declared func
33 ' * = optional 3: Other functions - everything else - all other functions
34 '
35 ' The PROLOG contains (in this order):
36 ' * 1. Program name statement PROGRAM "progname"
37 ' * 2. Version number statement VERSION "0.0000"
38 ' * 3. Import library statements IMPORT "libName"
39 ' * 4. Composite type definitions TYPE <typename> ... END TYPE
40 ' 5. Internal function declarations DECLARE/INTERNAL FUNCTION Func (args)
41 ' * 6. External function declarations EXTERNAL FUNCTION FuncName (args)
42 ' * 7. Shared constant definitions $$ConstantName = literal or constant
43 ' * 8. Shared variable declarations SHARED variable
44 '
45 ' ****** Comment libraries in/out as needed *****
46 '
47 IMPORT "xma" ' Math library : SIN/ASIN/SINH/ASINH/LOG/EXP/SQRT...
48 ' IMPORT "xcm" ' Complex library : complex number library (trig, etc)
49 IMPORT "xst" ' Standard library : required by most programs
50 IMPORT "xgr" ' GraphicsDesigner : required by GuiDesigner programs
51 IMPORT "xui" ' GuiDesigner : required by GuiDesigner programs
52 '
53 INTERNAL FUNCTION Entry ()
54 INTERNAL FUNCTION InitGui ()
55 INTERNAL FUNCTION InitProgram ()
56 INTERNAL FUNCTION CreateWindows ()
57 INTERNAL FUNCTION InitWindows ()
58 INTERNAL FUNCTION ADrawing (grid, message, v0, v1, v2, v3, r0, ANY)
59 INTERNAL FUNCTION ADrawingCode (grid, message, v0, v1, v2, v3, kid, ANY)
60 INTERNAL FUNCTION RandomN (@RandomNReturn#)
61 '
62 '
63 ' ######################
64 ' ##### Entry () #####
65 ' ######################
66 '
67 FUNCTION Entry ()
68 SHARED terminateProgram
69 STATIC entry
70 '
71 IF entry THEN RETURN ' enter once
72 entry = $$TRUE ' enter occured
73 '
74 InitGui () ' initialize messages
75 InitProgram () ' initialize this program
76 CreateWindows () ' create main window and others
77 InitWindows () ' initialize windows and grids
78 '
79 IF LIBRARY(0) THEN RETURN ' main program executes message loop
80 '
81 DO ' the message loop
82 XgrProcessMessages (1) ' process one message
83 LOOP UNTIL terminateProgram ' and repeat until program is terminated
84 END FUNCTION
85 '
86 '
87 ' ########################
88 ' ##### InitGui () #####
89 ' ########################
90 '
91 ' InitGui() initializes cursor, icon, message, and display variables.
92 ' Programs can reference these variables, but must never change them.
93 '
94 FUNCTION InitGui ()
95 '
96 ' need to set program name so grid properties
97 ' can be set from the grid property database.
98 '
99 program$ = PROGRAM$(0)
100 XstSetProgramName (@program$)
101 '
102 ' ***************************************
103 ' ***** Register Standard Cursors *****
104 ' ***************************************
105 '
106 XgrRegisterCursor (@"default", @#cursorDefault)
107 XgrRegisterCursor (@"arrow", @#cursorArrow)
108 XgrRegisterCursor (@"n", @#cursorN)
109 XgrRegisterCursor (@"s", @#cursorS)
110 XgrRegisterCursor (@"e", @#cursorE)
111 XgrRegisterCursor (@"w", @#cursorW)
112 XgrRegisterCursor (@"ns", @#cursorArrowsNS)
113 XgrRegisterCursor (@"ns", @#cursorArrowsSN)
114 XgrRegisterCursor (@"ew", @#cursorArrowsEW)
115 XgrRegisterCursor (@"ew", @#cursorArrowsWE)
116 XgrRegisterCursor (@"nwse", @#cursorArrowsNWSE)
117 XgrRegisterCursor (@"nesw", @#cursorArrowsNESW)
118 XgrRegisterCursor (@"all", @#cursorArrowsAll)
119 XgrRegisterCursor (@"plus", @#cursorPlus)
120 XgrRegisterCursor (@"wait", @#cursorWait)
121 XgrRegisterCursor (@"insert", @#cursorInsert)
122 XgrRegisterCursor (@"crosshair", @#cursorCrosshair)
123 XgrRegisterCursor (@"hourglass", @#cursorHourglass)
124 '
125 #defaultCursor = #cursorDefault
126 '
127 '
128 ' ********************************************
129 ' ***** Register Standard Window Icons *****
130 ' ********************************************
131 '
132 XgrRegisterIcon (@"hand", @#iconHand)
133 XgrRegisterIcon (@"asterisk", @#iconAsterisk)
134 XgrRegisterIcon (@"question", @#iconQuestion)
135 XgrRegisterIcon (@"exclamation", @#iconExclamation)
136 XgrRegisterIcon (@"application", @#iconApplication)
137 '
138 XgrRegisterIcon (@"hand", @#iconStop) ' alias
139 XgrRegisterIcon (@"asterisk", @#iconInformation) ' alias
140 XgrRegisterIcon (@"application", @#iconBlank) ' alias
141 '
142 XgrRegisterIcon (@"window", @#iconWindow) ' custom
143 '
144 '
145 ' ******************************
146 ' ***** Register Messages ***** Create message numbers for message names
147 ' ******************************
148 '
149 XgrRegisterMessage (@"Blowback", @#Blowback)
150 XgrRegisterMessage (@"Callback", @#Callback)
151 XgrRegisterMessage (@"Cancel", @#Cancel)
152 XgrRegisterMessage (@"Change", @#Change)
153 XgrRegisterMessage (@"CloseWindow", @#CloseWindow)
154 XgrRegisterMessage (@"ContextChange", @#ContextChange)
155 XgrRegisterMessage (@"Create", @#Create)
156 XgrRegisterMessage (@"CreateValueArray", @#CreateValueArray)
157 XgrRegisterMessage (@"CreateWindow", @#CreateWindow)
158 XgrRegisterMessage (@"CursorH", @#CursorH)
159 XgrRegisterMessage (@"CursorV", @#CursorV)
160 XgrRegisterMessage (@"Deselected", @#Deselected)
161 XgrRegisterMessage (@"Destroy", @#Destroy)
162 XgrRegisterMessage (@"Destroyed", @#Destroyed)
163 XgrRegisterMessage (@"DestroyWindow", @#DestroyWindow)
164 XgrRegisterMessage (@"Disable", @#Disable)
165 XgrRegisterMessage (@"Disabled", @#Disabled)
166 XgrRegisterMessage (@"Displayed", @#Displayed)
167 XgrRegisterMessage (@"DisplayWindow", @#DisplayWindow)
168 XgrRegisterMessage (@"Enable", @#Enable)
169 XgrRegisterMessage (@"Enabled", @#Enabled)
170 XgrRegisterMessage (@"Enter", @#Enter)
171 XgrRegisterMessage (@"ExitMessageLoop", @#ExitMessageLoop)
172 XgrRegisterMessage (@"Find", @#Find)
173 XgrRegisterMessage (@"FindForward", @#FindForward)
174 XgrRegisterMessage (@"FindReverse", @#FindReverse)
175 XgrRegisterMessage (@"Forward", @#Forward)
176 XgrRegisterMessage (@"GetAlign", @#GetAlign)
177 XgrRegisterMessage (@"GetBorder", @#GetBorder)
178 XgrRegisterMessage (@"GetBorderOffset", @#GetBorderOffset)
179 XgrRegisterMessage (@"GetCallback", @#GetCallback)
180 XgrRegisterMessage (@"GetCallbackArgs", @#GetCallbackArgs)
181 XgrRegisterMessage (@"GetCan", @#GetCan)
182 XgrRegisterMessage (@"GetCharacterMapArray", @#GetCharacterMapArray)
183 XgrRegisterMessage (@"GetClipGrid", @#GetClipGrid)
184 XgrRegisterMessage (@"GetColor", @#GetColor)
185 XgrRegisterMessage (@"GetColorExtra", @#GetColorExtra)
186 XgrRegisterMessage (@"GetCursor", @#GetCursor)
187 XgrRegisterMessage (@"GetCursorXY", @#GetCursorXY)
188 XgrRegisterMessage (@"GetDisplay", @#GetDisplay)
189 XgrRegisterMessage (@"GetEnclosedGrids", @#GetEnclosedGrids)
190 XgrRegisterMessage (@"GetEnclosingGrid", @#GetEnclosingGrid)
191 XgrRegisterMessage (@"GetFocusColor", @#GetFocusColor)
192 XgrRegisterMessage (@"GetFocusColorExtra", @#GetFocusColorExtra)
193 XgrRegisterMessage (@"GetFont", @#GetFont)
194 XgrRegisterMessage (@"GetFontMetrics", @#GetFontMetrics)
195 XgrRegisterMessage (@"GetFontNumber", @#GetFontNumber)
196 XgrRegisterMessage (@"GetGridFunction", @#GetGridFunction)
197 XgrRegisterMessage (@"GetGridFunctionName", @#GetGridFunctionName)
198 XgrRegisterMessage (@"GetGridName", @#GetGridName)
199 XgrRegisterMessage (@"GetGridNumber", @#GetGridNumber)
200 XgrRegisterMessage (@"GetGridProperties", @#GetGridProperties)
201 XgrRegisterMessage (@"GetGridType", @#GetGridType)
202 XgrRegisterMessage (@"GetGridTypeName", @#GetGridTypeName)
203 XgrRegisterMessage (@"GetGroup", @#GetGroup)
204 XgrRegisterMessage (@"GetHelp", @#GetHelp)
205 XgrRegisterMessage (@"GetHelpFile", @#GetHelpFile)
206 XgrRegisterMessage (@"GetHelpString", @#GetHelpString)
207 XgrRegisterMessage (@"GetHelpStrings", @#GetHelpStrings)
208 XgrRegisterMessage (@"GetHintString", @#GetHintString)
209 XgrRegisterMessage (@"GetImage", @#GetImage)
210 XgrRegisterMessage (@"GetImageCoords", @#GetImageCoords)
211 XgrRegisterMessage (@"GetIndent", @#GetIndent)
212 XgrRegisterMessage (@"GetInfo", @#GetInfo)
213 XgrRegisterMessage (@"GetJustify", @#GetJustify)
214 XgrRegisterMessage (@"GetKeyboardFocus", @#GetKeyboardFocus)
215 XgrRegisterMessage (@"GetKeyboardFocusGrid", @#GetKeyboardFocusGrid)
216 XgrRegisterMessage (@"GetKidNumber", @#GetKidNumber)
217 XgrRegisterMessage (@"GetKids", @#GetKids)
218 XgrRegisterMessage (@"GetKidArray", @#GetKidArray)
219 XgrRegisterMessage (@"GetKind", @#GetKind)
220 XgrRegisterMessage (@"GetMaxMinSize", @#GetMaxMinSize)
221 XgrRegisterMessage (@"GetMessageFunc", @#GetMessageFunc)
222 XgrRegisterMessage (@"GetMessageFuncArray", @#GetMessageFuncArray)
223 XgrRegisterMessage (@"GetMessageSub", @#GetMessageSub)
224 XgrRegisterMessage (@"GetMessageSubArray", @#GetMessageSubArray)
225 XgrRegisterMessage (@"GetModalInfo", @#GetModalInfo)
226 XgrRegisterMessage (@"GetModalWindow", @#GetModalWindow)
227 XgrRegisterMessage (@"GetParent", @#GetParent)
228 XgrRegisterMessage (@"GetPosition", @#GetPosition)
229 XgrRegisterMessage (@"GetProtoInfo", @#GetProtoInfo)
230 XgrRegisterMessage (@"GetRedrawFlags", @#GetRedrawFlags)
231 XgrRegisterMessage (@"GetSize", @#GetSize)
232 XgrRegisterMessage (@"GetSmallestSize", @#GetSmallestSize)
233 XgrRegisterMessage (@"GetState", @#GetState)
234 XgrRegisterMessage (@"GetStyle", @#GetStyle)
235 XgrRegisterMessage (@"GetTabArray", @#GetTabArray)
236 XgrRegisterMessage (@"GetTabWidth", @#GetTabWidth)
237 XgrRegisterMessage (@"GetTextArray", @#GetTextArray)
238 XgrRegisterMessage (@"GetTextArrayBounds", @#GetTextArrayBounds)
239 XgrRegisterMessage (@"GetTextArrayLine", @#GetTextArrayLine)
240 XgrRegisterMessage (@"GetTextArrayLines", @#GetTextArrayLines)
241 XgrRegisterMessage (@"GetTextCursor", @#GetTextCursor)
242 XgrRegisterMessage (@"GetTextFilename", @#GetTextFilename)
243 XgrRegisterMessage (@"GetTextPosition", @#GetTextPosition)
244 XgrRegisterMessage (@"GetTextSelection", @#GetTextSelection)
245 XgrRegisterMessage (@"GetTextString", @#GetTextString)
246 XgrRegisterMessage (@"GetTextStrings", @#GetTextStrings)
247 XgrRegisterMessage (@"GetTexture", @#GetTexture)
248 XgrRegisterMessage (@"GetTimer", @#GetTimer)
249 XgrRegisterMessage (@"GetValue", @#GetValue)
250 XgrRegisterMessage (@"GetValues", @#GetValues)
251 XgrRegisterMessage (@"GetValueArray", @#GetValueArray)
252 XgrRegisterMessage (@"GetWindow", @#GetWindow)
253 XgrRegisterMessage (@"GetWindowFunction", @#GetWindowFunction)
254 XgrRegisterMessage (@"GetWindowGrid", @#GetWindowGrid)
255 XgrRegisterMessage (@"GetWindowIcon", @#GetWindowIcon)
256 XgrRegisterMessage (@"GetWindowSize", @#GetWindowSize)
257 XgrRegisterMessage (@"GetWindowTitle", @#GetWindowTitle)
258 XgrRegisterMessage (@"GotKeyboardFocus", @#GotKeyboardFocus)
259 XgrRegisterMessage (@"GrabArray", @#GrabArray)
260 XgrRegisterMessage (@"GrabTextArray", @#GrabTextArray)
261 XgrRegisterMessage (@"GrabTextString", @#GrabTextString)
262 XgrRegisterMessage (@"GrabValueArray", @#GrabValueArray)
263 XgrRegisterMessage (@"Help", @#Help)
264 XgrRegisterMessage (@"Hidden", @#Hidden)
265 XgrRegisterMessage (@"HideTextCursor", @#HideTextCursor)
266 XgrRegisterMessage (@"HideWindow", @#HideWindow)
267 XgrRegisterMessage (@"Initialize", @#Initialize)
268 XgrRegisterMessage (@"Initialized", @#Initialized)
269 XgrRegisterMessage (@"Inline", @#Inline)
270 XgrRegisterMessage (@"InquireText", @#InquireText)
271 XgrRegisterMessage (@"KeyboardFocusBackward", @#KeyboardFocusBackward)
272 XgrRegisterMessage (@"KeyboardFocusForward", @#KeyboardFocusForward)
273 XgrRegisterMessage (@"KeyDown", @#KeyDown)
274 XgrRegisterMessage (@"KeyUp", @#KeyUp)
275 XgrRegisterMessage (@"LostKeyboardFocus", @#LostKeyboardFocus)
276 XgrRegisterMessage (@"LostTextSelection", @#LostTextSelection)
277 XgrRegisterMessage (@"Maximized", @#Maximized)
278 XgrRegisterMessage (@"MaximizeWindow", @#MaximizeWindow)
279 XgrRegisterMessage (@"Maximum", @#Maximum)
280 XgrRegisterMessage (@"Minimized", @#Minimized)
281 XgrRegisterMessage (@"MinimizeWindow", @#MinimizeWindow)
282 XgrRegisterMessage (@"Minimum", @#Minimum)
283 XgrRegisterMessage (@"MonitorContext", @#MonitorContext)
284 XgrRegisterMessage (@"MonitorHelp", @#MonitorHelp)
285 XgrRegisterMessage (@"MonitorKeyboard", @#MonitorKeyboard)
286 XgrRegisterMessage (@"MonitorMouse", @#MonitorMouse)
287 XgrRegisterMessage (@"MouseDown", @#MouseDown)
288 XgrRegisterMessage (@"MouseDrag", @#MouseDrag)
289 XgrRegisterMessage (@"MouseEnter", @#MouseEnter)
290 XgrRegisterMessage (@"MouseExit", @#MouseExit)
291 XgrRegisterMessage (@"MouseMove", @#MouseMove)
292 XgrRegisterMessage (@"MouseUp", @#MouseUp)
293 XgrRegisterMessage (@"MuchLess", @#MuchLess)
294 XgrRegisterMessage (@"MuchMore", @#MuchMore)
295 XgrRegisterMessage (@"OneLess", @#OneLess)
296 XgrRegisterMessage (@"OneMore", @#OneMore)
297 XgrRegisterMessage (@"PokeArray", @#PokeArray)
298 XgrRegisterMessage (@"PokeTextArray", @#PokeTextArray)
299 XgrRegisterMessage (@"PokeTextString", @#PokeTextString)
300 XgrRegisterMessage (@"PokeValueArray", @#PokeValueArray)
301 XgrRegisterMessage (@"Print", @#Print)
302 XgrRegisterMessage (@"Redraw", @#Redraw)
303 XgrRegisterMessage (@"RedrawGrid", @#RedrawGrid)
304 XgrRegisterMessage (@"RedrawLines", @#RedrawLines)
305 XgrRegisterMessage (@"RedrawText", @#RedrawText)
306 XgrRegisterMessage (@"RedrawWindow", @#RedrawWindow)
307 XgrRegisterMessage (@"Replace", @#Replace)
308 XgrRegisterMessage (@"ReplaceForward", @#ReplaceForward)
309 XgrRegisterMessage (@"ReplaceReverse", @#ReplaceReverse)
310 XgrRegisterMessage (@"Reset", @#Reset)
311 XgrRegisterMessage (@"Resize", @#Resize)
312 XgrRegisterMessage (@"Resized", @#Resized)
313 XgrRegisterMessage (@"ResizeNot", @#ResizeNot)
314 XgrRegisterMessage (@"ResizeWindow", @#ResizeWindow)
315 XgrRegisterMessage (@"ResizeWindowToGrid", @#ResizeWindowToGrid)
316 XgrRegisterMessage (@"Resized", @#Resized)
317 XgrRegisterMessage (@"Reverse", @#Reverse)
318 XgrRegisterMessage (@"ScrollH", @#ScrollH)
319 XgrRegisterMessage (@"ScrollV", @#ScrollV)
320 XgrRegisterMessage (@"Select", @#Select)
321 XgrRegisterMessage (@"Selected", @#Selected)
322 XgrRegisterMessage (@"Selection", @#Selection)
323 XgrRegisterMessage (@"SelectWindow", @#SelectWindow)
324 XgrRegisterMessage (@"SetAlign", @#SetAlign)
325 XgrRegisterMessage (@"SetBorder", @#SetBorder)
326 XgrRegisterMessage (@"SetBorderOffset", @#SetBorderOffset)
327 XgrRegisterMessage (@"SetCallback", @#SetCallback)
328 XgrRegisterMessage (@"SetCan", @#SetCan)
329 XgrRegisterMessage (@"SetCharacterMapArray", @#SetCharacterMapArray)
330 XgrRegisterMessage (@"SetClipGrid", @#SetClipGrid)
331 XgrRegisterMessage (@"SetColor", @#SetColor)
332 XgrRegisterMessage (@"SetColorAll", @#SetColorAll)
333 XgrRegisterMessage (@"SetColorExtra", @#SetColorExtra)
334 XgrRegisterMessage (@"SetColorExtraAll", @#SetColorExtraAll)
335 XgrRegisterMessage (@"SetCursor", @#SetCursor)
336 XgrRegisterMessage (@"SetCursorXY", @#SetCursorXY)
337 XgrRegisterMessage (@"SetDisplay", @#SetDisplay)
338 XgrRegisterMessage (@"SetFocusColor", @#SetFocusColor)
339 XgrRegisterMessage (@"SetFocusColorExtra", @#SetFocusColorExtra)
340 XgrRegisterMessage (@"SetFont", @#SetFont)
341 XgrRegisterMessage (@"SetFontNumber", @#SetFontNumber)
342 XgrRegisterMessage (@"SetGridFunction", @#SetGridFunction)
343 XgrRegisterMessage (@"SetGridFunctionName", @#SetGridFunctionName)
344 XgrRegisterMessage (@"SetGridName", @#SetGridName)
345 XgrRegisterMessage (@"SetGridProperties", @#SetGridProperties)
346 XgrRegisterMessage (@"SetGridType", @#SetGridType)
347 XgrRegisterMessage (@"SetGridTypeName", @#SetGridTypeName)
348 XgrRegisterMessage (@"SetGroup", @#SetGroup)
349 XgrRegisterMessage (@"SetHelp", @#SetHelp)
350 XgrRegisterMessage (@"SetHelpFile", @#SetHelpFile)
351 XgrRegisterMessage (@"SetHelpString", @#SetHelpString)
352 XgrRegisterMessage (@"SetHelpStrings", @#SetHelpStrings)
353 XgrRegisterMessage (@"SetHintString", @#SetHintString)
354 XgrRegisterMessage (@"SetImage", @#SetImage)
355 XgrRegisterMessage (@"SetImageCoords", @#SetImageCoords)
356 XgrRegisterMessage (@"SetIndent", @#SetIndent)
357 XgrRegisterMessage (@"SetInfo", @#SetInfo)
358 XgrRegisterMessage (@"SetJustify", @#SetJustify)
359 XgrRegisterMessage (@"SetKeyboardFocus", @#SetKeyboardFocus)
360 XgrRegisterMessage (@"SetKeyboardFocusGrid", @#SetKeyboardFocusGrid)
361 XgrRegisterMessage (@"SetMaxMinSize", @#SetMaxMinSize)
362 XgrRegisterMessage (@"SetMessageFunc", @#SetMessageFunc)
363 XgrRegisterMessage (@"SetMessageFuncArray", @#SetMessageFuncArray)
364 XgrRegisterMessage (@"SetMessageSub", @#SetMessageSub)
365 XgrRegisterMessage (@"SetMessageSubArray", @#SetMessageSubArray)
366 XgrRegisterMessage (@"SetModalWindow", @#SetModalWindow)
367 XgrRegisterMessage (@"SetParent", @#SetParent)
368 XgrRegisterMessage (@"SetPosition", @#SetPosition)
369 XgrRegisterMessage (@"SetRedrawFlags", @#SetRedrawFlags)
370 XgrRegisterMessage (@"SetSize", @#SetSize)
371 XgrRegisterMessage (@"SetState", @#SetState)
372 XgrRegisterMessage (@"SetStyle", @#SetStyle)
373 XgrRegisterMessage (@"SetTabArray", @#SetTabArray)
374 XgrRegisterMessage (@"SetTabWidth", @#SetTabWidth)
375 XgrRegisterMessage (@"SetTextArray", @#SetTextArray)
376 XgrRegisterMessage (@"SetTextArrayLine", @#SetTextArrayLine)
377 XgrRegisterMessage (@"SetTextArrayLines", @#SetTextArrayLines)
378 XgrRegisterMessage (@"SetTextCursor", @#SetTextCursor)
379 XgrRegisterMessage (@"SetTextFilename", @#SetTextFilename)
380 XgrRegisterMessage (@"SetTextSelection", @#SetTextSelection)
381 XgrRegisterMessage (@"SetTextString", @#SetTextString)
382 XgrRegisterMessage (@"SetTextStrings", @#SetTextStrings)
383 XgrRegisterMessage (@"SetTexture", @#SetTexture)
384 XgrRegisterMessage (@"SetTimer", @#SetTimer)
385 XgrRegisterMessage (@"SetValue", @#SetValue)
386 XgrRegisterMessage (@"SetValues", @#SetValues)
387 XgrRegisterMessage (@"SetValueArray", @#SetValueArray)
388 XgrRegisterMessage (@"SetWindowFunction", @#SetWindowFunction)
389 XgrRegisterMessage (@"SetWindowIcon", @#SetWindowIcon)
390 XgrRegisterMessage (@"SetWindowTitle", @#SetWindowTitle)
391 XgrRegisterMessage (@"ShowTextCursor", @#ShowTextCursor)
392 XgrRegisterMessage (@"ShowWindow", @#ShowWindow)
393 XgrRegisterMessage (@"SomeLess", @#SomeLess)
394 XgrRegisterMessage (@"SomeMore", @#SomeMore)
395 XgrRegisterMessage (@"StartTimer", @#StartTimer)
396 XgrRegisterMessage (@"SystemMessage", @#SystemMessage)
397 XgrRegisterMessage (@"TextDelete", @#TextDelete)
398 XgrRegisterMessage (@"TextEvent", @#TextEvent)
399 XgrRegisterMessage (@"TextInsert", @#TextInsert)
400 XgrRegisterMessage (@"TextModified", @#TextModified)
401 XgrRegisterMessage (@"TextReplace", @#TextReplace)
402 XgrRegisterMessage (@"TimeOut", @#TimeOut)
403 XgrRegisterMessage (@"Update", @#Update)
404 XgrRegisterMessage (@"WindowClose", @#WindowClose)
405 XgrRegisterMessage (@"WindowCreate", @#WindowCreate)
406 XgrRegisterMessage (@"WindowDeselected", @#WindowDeselected)
407 XgrRegisterMessage (@"WindowDestroy", @#WindowDestroy)
408 XgrRegisterMessage (@"WindowDestroyed", @#WindowDestroyed)
409 XgrRegisterMessage (@"WindowDisplay", @#WindowDisplay)
410 XgrRegisterMessage (@"WindowDisplayed", @#WindowDisplayed)
411 XgrRegisterMessage (@"WindowGetDisplay", @#WindowGetDisplay)
412 XgrRegisterMessage (@"WindowGetFunction", @#WindowGetFunction)
413 XgrRegisterMessage (@"WindowGetIcon", @#WindowGetIcon)
414 XgrRegisterMessage (@"WindowGetKeyboardFocusGrid", @#WindowGetKeyboardFocusGrid)
415 XgrRegisterMessage (@"WindowGetSelectedWindow", @#WindowGetSelectedWindow)
416 XgrRegisterMessage (@"WindowGetSize", @#WindowGetSize)
417 XgrRegisterMessage (@"WindowGetTitle", @#WindowGetTitle)
418 XgrRegisterMessage (@"WindowHelp", @#WindowHelp)
419 XgrRegisterMessage (@"WindowHide", @#WindowHide)
420 XgrRegisterMessage (@"WindowHidden", @#WindowHidden)
421 XgrRegisterMessage (@"WindowKeyDown", @#WindowKeyDown)
422 XgrRegisterMessage (@"WindowKeyUp", @#WindowKeyUp)
423 XgrRegisterMessage (@"WindowMaximize", @#WindowMaximize)
424 XgrRegisterMessage (@"WindowMaximized", @#WindowMaximized)
425 XgrRegisterMessage (@"WindowMinimize", @#WindowMinimize)
426 XgrRegisterMessage (@"WindowMinimized", @#WindowMinimized)
427 XgrRegisterMessage (@"WindowMonitorContext", @#WindowMonitorContext)
428 XgrRegisterMessage (@"WindowMonitorHelp", @#WindowMonitorHelp)
429 XgrRegisterMessage (@"WindowMonitorKeyboard", @#WindowMonitorKeyboard)
430 XgrRegisterMessage (@"WindowMonitorMouse", @#WindowMonitorMouse)
431 XgrRegisterMessage (@"WindowMouseDown", @#WindowMouseDown)
432 XgrRegisterMessage (@"WindowMouseDrag", @#WindowMouseDrag)
433 XgrRegisterMessage (@"WindowMouseEnter", @#WindowMouseEnter)
434 XgrRegisterMessage (@"WindowMouseExit", @#WindowMouseExit)
435 XgrRegisterMessage (@"WindowMouseMove", @#WindowMouseMove)
436 XgrRegisterMessage (@"WindowMouseUp", @#WindowMouseUp)
437 XgrRegisterMessage (@"WindowRedraw", @#WindowRedraw)
438 XgrRegisterMessage (@"WindowRegister", @#WindowRegister)
439 XgrRegisterMessage (@"WindowResize", @#WindowResize)
440 XgrRegisterMessage (@"WindowResized", @#WindowResized)
441 XgrRegisterMessage (@"WindowResizeToGrid", @#WindowResizeToGrid)
442 XgrRegisterMessage (@"WindowSelect", @#WindowSelect)
443 XgrRegisterMessage (@"WindowSelected", @#WindowSelected)
444 XgrRegisterMessage (@"WindowSetFunction", @#WindowSetFunction)
445 XgrRegisterMessage (@"WindowSetIcon", @#WindowSetIcon)
446 XgrRegisterMessage (@"WindowSetKeyboardFocusGrid", @#WindowSetKeyboardFocusGrid)
447 XgrRegisterMessage (@"WindowSetTitle", @#WindowSetTitle)
448 XgrRegisterMessage (@"WindowShow", @#WindowShow)
449 XgrRegisterMessage (@"WindowSystemMessage", @#WindowSystemMessage)
450 XgrRegisterMessage (@"LastMessage", @#LastMessage)
451 '
452 XgrGetDisplaySize ("", @#displayWidth, @#displayHeight, @#windowBorderWidth, @#windowTitleHeight)
453 END FUNCTION
454 '
455 '
456 ' ############################
457 ' ##### InitProgram () #####
458 ' ############################
459 '
460 ' Add code to this function to initialize anything your program needs
461 ' to initialize before CreateWindows() creates your programs windows.
462 ' For initialization after CreateWindows(), add code to InitWindows().
463 '
464 ' Do not delete this function, leave it empty if not needed.
465 '
466 FUNCTION InitProgram ()
467
468 END FUNCTION
469 '
470 '
471 ' ##############################
472 ' ##### CreateWindows () #####
473 ' ##############################
474 '
475 ' GuiDesigner puts code in CreateWindows() to create, initialize, display
476 ' every window you design graphically. Don't modify this function unless
477 ' absolutely necessary - GuiDesigner needs to read and update it at times.
478 '
479 ' CreateWindows() usually should not be executed when compiled as library.
480 ' Start CreateWindows() with "IF LIBRARY(0) THEN RETURN" to assure this.
481 '
482 FUNCTION CreateWindows ()
483 '
484 IF LIBRARY(0) THEN RETURN
485 '
486 ADrawing (@ADrawing, #CreateWindow, 0, 0, 0, 0, 0, 0)
487 XuiSendMessage ( ADrawing, #SetCallback, ADrawing, &ADrawingCode(), -1, -1, -1, 0)
488 XuiSendMessage ( ADrawing, #Initialize, 0, 0, 0, 0, 0, 0)
489 XuiSendMessage ( ADrawing, #DisplayWindow, 0, 0, 0, 0, 0, 0)
490 XuiSendMessage ( ADrawing, #SetGridProperties, -1, 0, 0, 0, 0, 0)
491 END FUNCTION
492 '
493 '
494 ' ############################
495 ' ##### InitWindows () #####
496 ' ############################
497 '
498 ' Add code to this function to initialize anything your program needs
499 ' to initialize after CreateWindows() creates your programs windows.
500 ' For initialization before CreateWindows(), add code to InitProgram().
501 '
502 ' Do not delete this function, leave it empty if not needed.
503 '
504 FUNCTION InitWindows ()
505 '
506 'XgrSetCEO (&ADrawingCode()) 'Send all mouse event messages to program code function for processing
507
508 '
509 END FUNCTION
510 '
511 '
512 ' #########################
513 ' ##### ADrawing () #####
514 ' #########################
515 '
516 ' "Anatomy of Grid Functions" in the GuiDesigner Programmer Guide
517 ' describes the operation and modification of grid functions in detail.
518 '
519 ' WindowFromFunction and/or WindowToFunction may not work, or may not generate the desired results if you:
520 ' * Modify the kid constant definition improperly.
521 ' * Modify the code in the Create subroutine improperly.
522 ' * Imbed blank or comment lines in the Create subroutine.
523 ' * Remove the GOSUB Resize line in the Create subroutine (comment out is okay).
524 ' * Imbed special purpose code in the Create subroutine before the GOSUB Resize line.
525 ' * Delete any of the four lines that assign values to designX, designY, designWidth, designHeight.
526 '
527 ' Note: Make sure that there are not any blank lines in this function or
528 ' the WindowFromFunction may not work properly
529 ' If any changes are made using the toolkit, some items may need to be replaced:
530 ' Under GOSUB Resize the following line must be present:
531 ' XuiSendMessage ( g, #SetMessageFunc, #RedrawGrid, &ADrawingCode(), 0, 0, 0, 0)
532 ' Under XuiRange create section the following line must be present:
533 ' XuiSendMessage ( g, #SetValues, 1, 1, 1, 10, 0, 0)
534 '
535 FUNCTION ADrawing (grid, message, v0, v1, v2, v3, r0, (r1, r1$, r1[], r1$[]))
536 STATIC designX, designY, designWidth, designHeight
537 STATIC SUBADDR sub[]
538 STATIC upperMessage
539 STATIC ADrawing
540 '
541 $ADrawing = 0 ' kid 0 grid type = ADrawing
542 $DrawingPad = 1 ' kid 1 grid type = XuiLabel
543 $LineStyleDropButton = 2 ' kid 2 grid type = XuiDropButton
544 $XuiLabel707 = 3 ' kid 3 grid type = XuiLabel
545 $LineWidthRange = 4 ' kid 4 grid type = XuiRange
546 $LineWidthLabel = 5 ' kid 5 grid type = XuiLabel
547 $DrawArcButton = 6 ' kid 6 grid type = XuiRadioButton
548 $DrawBorderButton = 7 ' kid 7 grid type = XuiRadioButton
549 $DrawBoxButton = 8 ' kid 8 grid type = XuiRadioButton
550 $DrawCircleButton = 9 ' kid 9 grid type = XuiRadioButton
551 $DrawLineButton = 10 ' kid 10 grid type = XuiRadioButton
552 $TriangleDirDropButton = 11 ' kid 11 grid type = XuiDropButton
553 $DrawPointButton = 12 ' kid 12 grid type = XuiRadioButton
554 $OptionsLabel = 13 ' kid 13 grid type = XuiLabel
555 $DrawTextButton = 14 ' kid 14 grid type = XuiRadioButton
556 $DrawTextFillButton = 15 ' kid 15 grid type = XuiRadioButton
557 $FillBoxButton = 16 ' kid 16 grid type = XuiRadioButton
558 $FillTriangleButton = 17 ' kid 17 grid type = XuiRadioButton
559 $UpperKid = 17 ' kid maximum
560 '
561 '
562 IFZ sub[] THEN GOSUB Initialize
563 ' XuiReportMessage (grid, message, v0, v1, v2, v3, r0, r1)
564 IF XuiProcessMessage (grid, message, @v0, @v1, @v2, @v3, @r0, @r1, ADrawing) THEN RETURN
565 IF (message <= upperMessage) THEN GOSUB @sub[message]
566 RETURN
567 '
568 '
569 ' ***** Callback ***** message = Callback : r1 = original message
570 '
571 SUB Callback
572 message = r1
573 callback = message
574 IF (message <= upperMessage) THEN GOSUB @sub[message]
575 END SUB
576 '
577 '
578 ' ***** Create ***** v0123 = xywh : r0 = window : r1 = parent
579 '
580 'NOTE: The label grid DrawingPad is sent a RedrawGrid message by using the following
581 'function XuiSendMessage ( g, #SetMessageFunc, #RedrawGrid, &ADrawingCode(), 0, 0, 0, 0)
582 'This sends the RedrawGrid message to the ADrawingCode function which then processes
583 'the message and redraws the grid DrawingPad whenever the grid is covered or
584 'or minimized.
585 '
586 '
587 SUB Create
588 IF (v0 <= 0) THEN v0 = 0
589 IF (v1 <= 0) THEN v1 = 0
590 IF (v2 <= 0) THEN v2 = designWidth
591 IF (v3 <= 0) THEN v3 = designHeight
592 XuiCreateGrid (@grid, ADrawing, @v0, @v1, @v2, @v3, r0, r1, &ADrawing())
593 XuiSendMessage ( grid, #SetGridName, 0, 0, 0, 0, 0, @"ADrawing")
594 XuiLabel (@g, #Create, 168, 4, 456, 504, r0, grid)
595 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawingPad")
596 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
597 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderNone, 0, 0, 0)
598 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
599 XuiDropButton (@g, #Create, 4, 436, 164, 36, r0, grid)
600 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $LineStyleDropButton, grid)
601 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"LineStyleDropButton")
602 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
603 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
604 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderNone, 0, 0, 0)
605 XuiSendMessage ( g, #SetHelpString, 0, 0, 0, 0, 0, @"[Line Style]\nSelect from list of 5 different line styles:\nSolid\nDash\nDot\nDashDot\nDashDotDot")
606 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
607 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Select Line Style")
608 DIM text$[4]
609 text$[0] = "Solid"
610 text$[1] = "Dash"
611 text$[2] = "Dot"
612 text$[3] = "DashDot"
613 text$[4] = "DashDotDot"
614 XuiSendMessage ( g, #SetTextArray, 0, 0, 0, 0, 0, @text$[])
615 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 1, @"PressButton")
616 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 1, 0)
617 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 1, @"Fixedsys")
618 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 1, @"Select Line Style")
619 XuiLabel (@g, #Create, 4, 472, 164, 36, r0, grid)
620 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"XuiLabel707")
621 XuiRange (@g, #Create, 108, 476, 44, 28, r0, grid)
622 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $LineWidthRange, grid)
623 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"LineWidthRange")
624 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
625 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
626 XuiSendMessage ( g, #SetAlign, $$AlignMiddleCenter, 0, -1, -1, 0, 0)
627 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderNone, 0, 0, 0)
628 XuiSendMessage ( g, #SetTexture, $$TextureLower1, 0, 0, 0, 0, 0)
629 XuiSendMessage ( g, #SetFont, 280, 400, 0, 0, 0, @"Fixedsys")
630 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 1, @"Label")
631 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 1, @"1")
632 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 2, @"Button0")
633 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 3, @"Button1")
634 XuiLabel (@g, #Create, 12, 476, 92, 28, r0, grid)
635 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"LineWidthLabel")
636 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
637 XuiSendMessage ( g, #SetBorder, $$BorderNone, $$BorderNone, $$BorderNone, 0, 0, 0)
638 XuiSendMessage ( g, #SetTexture, $$TextureLower1, 0, 0, 0, 0, 0)
639 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
640 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Line Width")
641 XuiRadioButton (@g, #Create, 4, 4, 164, 36, r0, grid)
642 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawArcButton, grid)
643 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawArcButton")
644 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
645 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
646 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
647 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
648 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Arc")
649 XuiRadioButton (@g, #Create, 4, 40, 164, 36, r0, grid)
650 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawBorderButton, grid)
651 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawBorderButton")
652 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
653 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
654 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
655 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
656 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Border")
657 XuiRadioButton (@g, #Create, 4, 76, 164, 36, r0, grid)
658 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawBoxButton, grid)
659 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawBoxButton")
660 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
661 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
662 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
663 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
664 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Box")
665 XuiRadioButton (@g, #Create, 4, 112, 164, 36, r0, grid)
666 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawCircleButton, grid)
667 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawCircleButton")
668 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
669 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
670 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
671 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
672 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Circle")
673 XuiRadioButton (@g, #Create, 4, 148, 164, 36, r0, grid)
674 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawLineButton, grid)
675 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawLineButton")
676 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
677 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
678 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
679 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
680 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Line")
681 XuiDropButton (@g, #Create, 4, 400, 164, 36, r0, grid)
682 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $TriangleDirDropButton, grid)
683 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"TriangleDirDropButton")
684 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
685 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
686 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
687 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Triangle Direction")
688 DIM text$[3]
689 text$[0] = "TriangleUp"
690 text$[1] = "TriangleRight"
691 text$[2] = "TriangleDown"
692 text$[3] = "TriangleLeft"
693 XuiSendMessage ( g, #SetTextArray, 0, 0, 0, 0, 0, @text$[])
694 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 1, @"PressButton")
695 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 1, 0)
696 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 1, @"Fixedsys")
697 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 1, @"Triangle Direction")
698 XuiRadioButton (@g, #Create, 4, 184, 164, 36, r0, grid)
699 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawPointButton, grid)
700 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawPointButton")
701 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
702 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
703 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
704 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
705 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Point")
706 XuiLabel (@g, #Create, 4, 364, 164, 36, r0, grid)
707 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"OptionsLabel")
708 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
709 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$LightRed, $$White, 0, 0)
710 XuiSendMessage ( g, #SetBorder, $$BorderRidge, $$BorderRidge, $$BorderNone, 0, 0, 0)
711 XuiSendMessage ( g, #SetTexture, $$TextureLower1, 0, 0, 0, 0, 0)
712 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
713 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Preferences")
714 XuiRadioButton (@g, #Create, 4, 220, 164, 36, r0, grid)
715 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawTextButton, grid)
716 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawTextButton")
717 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
718 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
719 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
720 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
721 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Text")
722 XuiRadioButton (@g, #Create, 4, 256, 164, 36, r0, grid)
723 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $DrawTextFillButton, grid)
724 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawTextFillButton")
725 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
726 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
727 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
728 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
729 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Draw Text Fill")
730 XuiRadioButton (@g, #Create, 4, 292, 164, 36, r0, grid)
731 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $FillBoxButton, grid)
732 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"FillBoxButton")
733 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
734 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
735 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
736 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
737 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Fill Box")
738 XuiRadioButton (@g, #Create, 4, 328, 164, 36, r0, grid)
739 XuiSendMessage ( g, #SetCallback, grid, &ADrawing(), -1, -1, $FillTriangleButton, grid)
740 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"FillTriangleButton")
741 XuiSendMessage ( g, #SetStyle, 0, 0, 0, 0, 0, 0)
742 XuiSendMessage ( g, #SetColorExtra, $$Grey, $$White, $$Black, $$White, 0, 0)
743 XuiSendMessage ( g, #SetBorder, $$BorderRaise1, $$BorderRaise1, $$BorderLower2, 0, 0, 0)
744 XuiSendMessage ( g, #SetFont, 240, 400, 0, 0, 0, @"Fixedsys")
745 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @"Fill Triangle")
746 GOSUB Resize
747 XuiSendMessage (grid, #GetGridNumber, @g, 0, 0, 0, $DrawingPad, 0)
748 XuiSendMessage ( g, #SetMessageFunc, #RedrawGrid, &ADrawingCode(), 0, 0, 0, 0)
749 XuiSendMessage (grid, #GetGridNumber, @g, 0, 0, 0, $LineWidthRange, 0)
750 XuiSendMessage ( g, #SetValues, 1, 1, 1, 10, 0, 0)
751 END SUB
752 '
753 '
754 ' ***** CreateWindow ***** v0123 = xywh : r0 = windowType : r1$ = display$
755 '
756 SUB CreateWindow
757 IF (v0 = 0) THEN v0 = designX
758 IF (v1 = 0) THEN v1 = designY
759 IF (v2 <= 0) THEN v2 = designWidth
760 IF (v3 <= 0) THEN v3 = designHeight
761 XuiWindow (@window, #WindowCreate, v0, v1, v2, v3, r0, @r1$)
762 v0 = 0 : v1 = 0 : r0 = window : ATTACH r1$ TO display$
763 GOSUB Create
764 r1 = 0 : ATTACH display$ TO r1$
765 XuiWindow (window, #WindowRegister, grid, -1, v2, v3, @r0, @"ADrawing")
766 END SUB
767 '
768 '
769 ' ***** GetSmallestSize ***** See "Anatomy of Grid Functions"
770 '
771 SUB GetSmallestSize
772 END SUB
773 '
774 '
775 ' ***** Resize ***** See "Anatomy of Grid Functions"
776 '
777 SUB Resize
778 END SUB
779 '
780 '
781 ' ***** Selection ***** See "Anatomy of Grid Functions"
782 '
783 SUB Selection
784 END SUB
785 '
786 '
787 ' ***** Initialize ***** ' see "Anatomy of Grid Functions"
788 '
789 SUB Initialize
790 XuiGetDefaultMessageFuncArray (@func[])
791 XgrMessageNameToNumber (@"LastMessage", @upperMessage)
792 '
793 func[#Callback] = &XuiCallback () ' disable to handle Callback messages internally
794 ' func[#GetSmallestSize] = 0 ' enable to add internal GetSmallestSize routine
795 ' func[#Resize] = 0 ' enable to add internal Resize routine
796 '
797 DIM sub[upperMessage]
798 ' sub[#Callback] = SUBADDRESS (Callback) ' enable to handle Callback messages internally
799 sub[#Create] = SUBADDRESS (Create) ' must be internal routine
800 sub[#CreateWindow] = SUBADDRESS (CreateWindow) ' must be internal routine
801 ' sub[#GetSmallestSize] = SUBADDRESS (GetSmallestSize) ' enable to add internal GetSmallestSize routine
802 ' sub[#Resize] = SUBADDRESS (Resize) ' enable to add internal Resize routine
803 sub[#Selection] = SUBADDRESS (Selection) ' routes Selection callbacks to subroutine
804 '
805 IF sub[0] THEN PRINT "ADrawing() : Initialize : error ::: (undefined message)"
806 IF func[0] THEN PRINT "ADrawing() : Initialize : error ::: (undefined message)"
807 XuiRegisterGridType (@ADrawing, "ADrawing", &ADrawing(), @func[], @sub[])
808 '
809 ' Don't remove the following 4 lines, or WindowFromFunction/WindowToFunction will not work
810 '
811 designX = 157
812 designY = 46
813 designWidth = 628
814 designHeight = 512
815 '
816 gridType = ADrawing
817 XuiSetGridTypeProperty (gridType, @"x", designX)
818 XuiSetGridTypeProperty (gridType, @"y", designY)
819 XuiSetGridTypeProperty (gridType, @"width", designWidth)
820 XuiSetGridTypeProperty (gridType, @"height", designHeight)
821 XuiSetGridTypeProperty (gridType, @"maxWidth", designWidth)
822 XuiSetGridTypeProperty (gridType, @"maxHeight", designHeight)
823 XuiSetGridTypeProperty (gridType, @"minWidth", designWidth)
824 XuiSetGridTypeProperty (gridType, @"minHeight", designHeight)
825 XuiSetGridTypeProperty (gridType, @"border", $$BorderFrame)
826 XuiSetGridTypeProperty (gridType, @"can", $$Focus OR $$Respond OR $$Callback OR $$TextSelection)
827 XuiSetGridTypeProperty (gridType, @"focusKid", $LineStyleDropButton)
828 XuiSetGridTypeProperty (gridType, @"inputTextString", $LineStyleDropButton)
829 IFZ message THEN RETURN
830 END SUB
831 END FUNCTION
832 '
833 '
834 ' #############################
835 ' ##### ADrawingCode () #####
836 ' #############################
837 '
838 ' You can stop GuiDesigner from putting the following comment
839 ' lines in callback functions by removing the comment lines in
840 ' the code.xxx file in your \xb\xxx directory.
841 '
842 ' This is a callback function that supports the grid function
843 ' of the same name less the last 4 letters (ADrawingCode).
844 '
845 ' When an important event occurs in the grid function created
846 ' from your design window, is sends a callback message to this
847 ' function, with the original message in r1.
848 '
849 ' Most callback functions process only Selection messages
850 ' because usually that's enough to perform their function.
851 '
852 ' When keystrokes are entered into a TextLine or TextArea grid,
853 ' this callback function receives a TextEvent callback message.
854 ' This function can prevent Keystrokes from inserting characters
855 ' in the TextLine or TextArea grid by returning a -1 in kid.
856 '
857 ' The first time GuiDesigner generates this function, it puts
858 ' a "SUB Selection" subroutine at the bottom of the function.
859 ' It contains a SELECT CASE block with kid constants named the
860 ' same as the grids you put in the design window. For grids
861 ' you didn't give a name (with the AppearanceWindow), a not
862 ' very useful default name is substituted, so be sure to enter
863 ' good GridNames in the Appearance window for every grid in
864 ' your design windows. If you change the GridNames later, the
865 ' names in the SELECT CASE block are NOT updated, and you'll
866 ' get "Undefined Constant" errors on lines with obsolete constant
867 ' names when you recompile the program. Then you'll have to
868 ' update the names in the SELECT CASE block by hand.
869 '
870 ' It's easy to find out what your code has to respond to...
871 ' just run your program! When you operate the grids in the
872 ' window, the XuiReportMessage() call in this function prints
873 ' the entry arguments in a ReportMessage window. You can
874 ' comment out this lines to disable this feature, but don't
875 ' remove them entirely - it might come in handy later.
876 '
877 '
878 FUNCTION ADrawingCode (grid, message, v0, v1, v2, v3, kid, r1)
879 '
880 STATIC drawingPad
881 STATIC func
882 '
883 $ADrawing = 0 ' kid 0 grid type = ADrawing
884 $DrawingPad = 1 ' kid 1 grid type = XuiLabel
885 $LineStyleDropButton = 2 ' kid 2 grid type = XuiDropButton
886 $XuiLabel707 = 3 ' kid 3 grid type = XuiLabel
887 $LineWidthRange = 4 ' kid 4 grid type = XuiRange
888 $LineWidthLabel = 5 ' kid 5 grid type = XuiLabel
889 $DrawArcButton = 6 ' kid 6 grid type = XuiRadioButton
890 $DrawBorderButton = 7 ' kid 7 grid type = XuiRadioButton
891 $DrawBoxButton = 8 ' kid 8 grid type = XuiRadioButton
892 $DrawCircleButton = 9 ' kid 9 grid type = XuiRadioButton
893 $DrawLineButton = 10 ' kid 10 grid type = XuiRadioButton
894 $TriangleDirDropButton = 11 ' kid 11 grid type = XuiDropButton
895 $DrawPointButton = 12 ' kid 12 grid type = XuiRadioButton
896 $OptionsLabel = 13 ' kid 13 grid type = XuiLabel
897 $DrawTextButton = 14 ' kid 14 grid type = XuiRadioButton
898 $DrawTextFillButton = 15 ' kid 15 grid type = XuiRadioButton
899 $FillBoxButton = 16 ' kid 16 grid type = XuiRadioButton
900 $FillTriangleButton = 17 ' kid 17 grid type = XuiRadioButton
901 $UpperKid = 17 ' kid maximum
902 '
903 IFZ drawingPad THEN GOSUB Initialize 'get grid number for grid $DrawingPad
904 '
905 '
906 ' XuiReportMessage (grid, message, v0, v1, v2, v3, kid, r1)
907 IF (message = #Callback) THEN message = r1
908 '
909 SELECT CASE message
910 CASE #Selection : GOSUB Selection ' Common callback message
911 CASE #CloseWindow : QUIT(0) ' CloseWindow message
912 CASE #RedrawGrid : GOSUB RedrawGrid ' RedrawGrid message occurs when grid is minimized or coverd by another window or grid
913 ' CASE #TextEvent : GOSUB TextEvent ' KeyDown in TextArea or TextLine
914 END SELECT
915 RETURN
916 '
917 '
918 ' ***** RedrawGrid *****
919
920 SUB RedrawGrid
921
922 XuiRedrawGrid (grid, #RedrawGrid, 0, 0, 0, 0, 0, 0 )
923 v0 = $$TRUE
924 kid = func
925 GOSUB Selection
926
927 END SUB
928
929 ' ***** Initialize *****
930
931 SUB Initialize
932 ' XuiGetGridNumber() gets the grid number for kid $DrawingPad
933
934 XuiSendMessage (grid, #GetGridNumber, @drawingPad, 0, 0, 0, $DrawingPad, 0)
935
936 ' XgrSetGridClip() will clip any part of drawings that try to draw past the
937 ' boundaries of the chosed grid/kid
938
939 XgrSetGridClip (drawingPad, drawingPad)
940
941 END SUB
942
943
944 ' ***** Selection *****
945
946 SUB Selection
947
948 SELECT CASE kid
949 ' Note: these DropButton grids rely on v0 for getting DropButton values
950
951 CASE $LineStyleDropButton : GOSUB LineStyle
952 CASE $TriangleDirDropButton : GOSUB TriangleDirection
953 END SELECT
954
955 IFZ v0 THEN EXIT SUB
956
957 SELECT CASE kid
958 CASE $ADrawing :
959 CASE $DrawingPad :
960 CASE $XuiLabel707 :
961 CASE $LineWidthRange : GOSUB WidthRange
962 CASE $LineWidthLabel :
963 CASE $DrawArcButton : GOSUB DrawArc
964 CASE $DrawBorderButton : GOSUB DrawBorder
965 CASE $DrawBoxButton : GOSUB DrawBox
966 CASE $DrawCircleButton : GOSUB DrawCircle
967 CASE $DrawLineButton : GOSUB DrawLine
968 CASE $DrawPointButton : GOSUB DrawPoint
969 CASE $DrawTextButton : GOSUB DrawText
970 CASE $DrawTextFillButton : GOSUB DrawTextFill
971 CASE $FillBoxButton : GOSUB FillBox
972 CASE $FillTriangleButton : GOSUB FillTriangle
973
974 END SELECT
975 func = kid
976
977 END SUB
978
979
980
981 ' ***** LineStyle *****
982 SUB LineStyle
983 ' XgrSetGridDrawingMode (grid, drawingMode, lineStyle, lineWidth)
984 ' drawingModes are values 0 to 3 , 0 = default
985 ' Line Style Options:
986 ' $$LineStyleSolid = 0
987 ' $$LineStyleDash = 1
988 ' $$LineStyleDot = 2
989 ' $$LineStyleDashDot = 3
990 ' $$LineStyleDashDotDot = 4
991 ' lineStyle only works when the lineWidth is set to 1
992 ' lineWidth = value in pixels SEE SUB WidthRange below
993
994 ' DropBox v0 : item - 0 is topmost item
995
996 #lineStyle = v0
997 PRINT "lineStyle ="; v0
998 XgrSetGridDrawingMode (drawingPad, 0, #lineStyle, #lineWidth)
999
1000 ' PRINT "linestyle="; #lineStyle
1001
1002 END SUB
1003
1004
1005 ' ***** WidthRange *****
1006 SUB WidthRange
1007 ' XgrSetGridDrawingMode (grid, drawingMode, lineStyle, lineWidth)
1008 ' lineWidth is a value in pixels
1009 ' XuiSendStringMessage (grid, "GetValues", @v0, @v1, @v2, @v3, kid, 0)
1010 XuiSendStringMessage (grid, "GetValues", @v0, @v1, @v2, @v3, $LineWidthRange, 0)
1011 ' XuiRange sets v0 as current value
1012
1013 #lineWidth = v0
1014 XgrSetGridDrawingMode (drawingPad, 0, #lineStyle, #lineWidth)
1015
1016 ' PRINT "linewidth="; #lineWidth
1017
1018 END SUB
1019
1020
1021 ' ***** DrawArc *****
1022 SUB DrawArc
1023
1024 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1025
1026 ' Clear the grid of previous drawing using XgrClearGrid
1027 ' XgrClearGrid (grid, color) color= -1 for current background color
1028 XgrClearGrid (drawingPad, -1)
1029
1030 ' XgrDrawArc (grid, color, r, startAngle#, endAngle#)
1031 ' XgrDrawArc() draws a arc of radius r with center of curvature at
1032 ' current drawpoint which does not need to be in the grid.
1033 ' It begins at startAngle# and ends at endAngle# expressed in radians
1034 ' Angles increase counterclockwise, and a circle is $$TWOPI radians.
1035 ' Angles are folded into the range 0 to $$TWOPI before drawing.
1036 ' color = -1 means draw in the current drawing color.
1037
1038 ' XgrSetDrawpoint (grid, x, y)
1039 ' XgrSetDrawpoint sets the position x, y of the pen position
1040
1041 pi# = 3.1415926535896
1042 dtr# = pi# / 180.0
1043
1044 Error = 170 'For some reason, the XgrSetDrawpoint does not seem to work here
1045 r = 30
1046 x = 20 + Error
1047 y = 50
1048 color = 100 'colorNum $$LightRed = 100
1049
1050 FOR theta = 0 TO 315 STEP 45 'draw 45 degree arc segments
1051
1052 thetaStart# = theta 'starting angle in degrees
1053 thetaEnd# = thetaStart# + 45.0 'ending angle in degrees
1054
1055 startAngle# = thetaStart# * dtr# 'starting angle in radians
1056 endAngle# = thetaEnd# * dtr# 'ending angle in radians
1057
1058 XgrSetDrawpoint (drawingPad, x, y)
1059 XgrDrawArc (drawingPad, color, r, startAngle#, endAngle#)
1060
1061 x = x + 50
1062 NEXT
1063
1064 XgrSetDrawpoint (drawingPad, 20, 70)
1065 XgrDrawText (drawingPad, -1, "45 Degree Arcs" )
1066
1067 r = 40
1068 x = 20 + Error
1069 y = 150
1070 color = 15 '$$BrightGreen = 15
1071
1072 FOR theta = 0 TO 270 STEP 90 'draw 90 degree arc segments
1073
1074 thetaStart# = theta 'starting angle in degrees
1075 thetaEnd# = thetaStart# + 90.0 'ending angle in degrees
1076
1077 startAngle# = thetaStart# * dtr# 'starting angle in radians
1078 endAngle# = thetaEnd# * dtr# 'ending angle in radians
1079
1080 XgrSetDrawpoint (drawingPad, x, y)
1081 XgrDrawArc (drawingPad, color, r, startAngle#, endAngle#)
1082
1083 x = x + 100
1084 NEXT
1085
1086 XgrSetDrawpoint (drawingPad, 20, 180)
1087 XgrDrawText (drawingPad, -1, "90 Degree Arcs" )
1088
1089
1090 END IF
1091 END SUB
1092
1093
1094 ' ***** DrawBorder *****
1095 SUB DrawBorder
1096
1097 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1098
1099 ' Clear the grid of previous drawing using XgrClearGrid
1100 ' XgrClearGrid (grid, color) color= -1 for current background color
1101 XgrClearGrid (drawingPad, -1)
1102
1103 ' ***** grid border styles *****
1104 '
1105 ' $$BorderHiLine1 = 4 : $$BorderLine1 = 4
1106 ' $$BorderHiLine2 = 5 : $$BorderLine2 = 5
1107 ' $$BorderHiLine4 = 6 : $$BorderLine4 = 6
1108 ' $$BorderLoLine1 = 7
1109 ' $$BorderLoLine2 = 8
1110 ' $$BorderLoLine4 = 9
1111 ' $$BorderRaise1 = 10 : $$BorderRaise = 10
1112 ' $$BorderRaise2 = 11
1113 ' $$BorderRaise4 = 12
1114 ' $$BorderLower1 = 13 : $$BorderLower = 13
1115 ' $$BorderLower2 = 14
1116 ' $$BorderLower4 = 15
1117 ' $$BorderFrame = 16
1118 ' $$BorderDrain = 17
1119 ' $$BorderRidge = 18
1120 ' $$BorderValley = 19
1121 ' $$BorderWide = 20 ' window frame border w/o resize marks
1122 ' $$BorderResize = 21 ' window frame resize border
1123
1124 ' XgrDrawBorder (grid, border, back, low, high, x1, y1, x2, y2)
1125 ' back, low, high are colors, use -1 for current values
1126 ' border is the border number 4 to 21, borders 1 to 4 draw no border
1127 ' x1, y1, x2, y2 are the UL - LR corners of the border box
1128
1129 gap = 19
1130 boxSize = 60
1131
1132 border = 4
1133
1134 FOR i = 0 TO 6 'no of rows
1135 y1 =(i*boxSize) + (i*gap) + gap
1136 y2 = y1 + boxSize
1137
1138 FOR j = 0 TO 2 'no of columns
1139 x1 = (j*boxSize) + (j*gap) + gap
1140 x2 = x1 + boxSize
1141
1142 XgrDrawBorder (drawingPad, border, -1, -1, -1, x1, y1, x2, y2)
1143 INC border
1144 NEXT j
1145 NEXT i
1146
1147 END IF
1148 END SUB
1149
1150
1151 ' ***** DrawBox *****
1152 SUB DrawBox
1153
1154 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1155
1156 XgrClearGrid (drawingPad, -1)
1157
1158 ' XgrDrawBox draws a box at x1, y1, x2, y2 in selected color
1159 ' XgrDrawBox (grid, color, x1, y1, x2, y2)
1160 '
1161 gap = 20
1162 boxSize = 50
1163
1164 FOR i = 0 TO 6
1165 y1 =(i*boxSize) + (i*gap) + gap
1166 y2 = y1 + boxSize
1167
1168 FOR j = 0 TO 5
1169 x1 = (j*boxSize) + (j*gap) + gap
1170 x2 = x1 + boxSize
1171
1172 ' Select a random color number from 0 to 124
1173 RandomN (@RandomNReturn#)
1174 rndNum# = RandomNReturn#
1175 colorNum = INT(rndNum# * 125)
1176
1177 XgrDrawBox (drawingPad, colorNum, x1, y1, x2, y2)
1178
1179 NEXT j
1180 NEXT i
1181
1182 END IF
1183 END SUB
1184
1185
1186 ' ***** DrawCircle *****
1187 SUB DrawCircle
1188 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1189
1190 XgrClearGrid (drawingPad, -1)
1191
1192 ' XgrDrawCircle (grid, color, r)
1193 ' XgrDrawCircle() draws a circle of radius r in selected color at current
1194 ' set DrawPoint
1195 ' A circle drawn with the SetGridDrawingMode() linestyle=0 (solid line)
1196 ' and a linewidth = r will fill the circle. If a linestyle > 0 is chosen,
1197 ' then a "donut" type circle is drawn with outside edge of the circle
1198 ' expanding to r + linewidth/2
1199
1200 ' XgrSetDrawpoint (grid, x, y)
1201 ' XgrSetDrawpoint sets the position x, y of the pen position
1202
1203 gap = 10
1204 r = 10
1205 boxSize = r * 2
1206
1207 FOR i = 0 TO 15 'no of rows
1208 y =(i*boxSize) + (i*gap) + gap + r
1209
1210
1211 FOR j = 0 TO 14 'no of columns
1212 x = (j*boxSize) + (j*gap) + gap + r
1213
1214 XgrSetDrawpoint (drawingPad, x, y)
1215
1216
1217 ' Select a random color number from 0 to 124
1218 RandomN (@RandomNReturn#)
1219 rndNum# = RandomNReturn#
1220 colorNum = INT(rndNum# * 125)
1221
1222 XgrDrawCircle (drawingPad, colorNum, r)
1223
1224 NEXT j
1225 NEXT i
1226
1227 END IF
1228 END SUB
1229
1230
1231
1232 ' ***** DrawLine *****
1233 SUB DrawLine
1234 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1235
1236 XgrClearGrid (drawingPad, -1)
1237
1238 'XgrDrawLine (grid, color, x1, y1, x2, y2)
1239 'XgrDrawLine draws a line from x1,y1 to x2,y2 using selected color
1240
1241 'This example draws a "Rose" pattern by drawing lines from points chosen
1242 'along the edge of a circle and then drawing a line from each point to
1243 'every other point on the circle.
1244
1245 rads# = 3.141593 / 180.0
1246
1247 ' Number of points
1248 ' points = 20
1249 ' Select a random number of points from 5 to 35
1250 RandomN (@RandomNReturn#) 'call RandomN() function
1251 rndNum# = RandomNReturn#
1252 points = INT(rndNum# * 30)+ 6
1253
1254 ' Radius of circle
1255 dist = 210
1256
1257 DIM pointsX[points]
1258 DIM pointsY[points]
1259
1260 FOR i = 0 TO points
1261 angle# = (360.0 / points) * i
1262 pointsX[i] = 230 + (dist * COS((angle# - 90) * rads#))
1263 pointsY[i] = 240 + (dist * SIN((angle# - 90) * rads#))
1264 NEXT i
1265
1266 FOR i = 0 TO points
1267 FOR j = i + 1 TO points - 1
1268
1269 XgrDrawLine (drawingPad, -1, pointsX[i], pointsY[i], pointsX[j], pointsY[j])
1270
1271 NEXT j
1272 NEXT i
1273 END IF
1274 END SUB
1275
1276
1277 ' ***** DrawPoint *****
1278 SUB DrawPoint
1279
1280 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1281
1282 XgrClearGrid (drawingPad, -1)
1283
1284 'XgrDrawPoint (grid, color, x, y)
1285 'XgrDrawPoint draws a point (pixel) in selected color at x,y in grid
1286
1287 'This example draws a Spirograph made by plotting points from parametric equations
1288
1289 pi# = 3.1415926535896
1290 dtr# = pi# / 180.0
1291
1292 ' a# = 100.0 'radius of inside circle
1293 ' b# = 70.0 'radius of outside circle
1294 ' h# = 70.0 'pen offset distance from center of outside circle h <= b
1295
1296 DO
1297 ' Select a random number for a# from 50 to 150
1298 RandomN (@RandomNReturn#) 'call RandomN() function
1299 rndNum# = RandomNReturn#
1300 a# = INT(rndNum# * 100)+ 51
1301
1302 ' Select a random number for b# from 20 to 120
1303 RandomN (@RandomNReturn#) 'call RandomN() function
1304 rndNum# = RandomNReturn#
1305 b# = INT(rndNum# * 100)+ 21
1306
1307 ' Select a random number for h# which is <= to b#
1308 RandomN (@RandomNReturn#) 'call RandomN() function
1309 rndNum# = RandomNReturn#
1310 h# = INT(rndNum# * b#)+ 1
1311
1312 LOOP UNTIL (a# + b# + h# <= 200.0)
1313
1314 increment# = 0.25 'increment for degrees, smaller for more detailed drawings
1315 t# = 0 'theta degrees
1316 m# = a# + b# 'for epi a+b+h must be <= 200 in order to fit onto grid
1317 n# = a# - b#
1318 rm# = m#/b#
1319 rn# = n#/b#
1320
1321 ' select a color
1322 ' $$Red = 50
1323 ' $$BrightRed = 75
1324 ' $$LightRed = 100
1325
1326 color = 100
1327
1328 'Draw epitrochoid type spirograph
1329
1330 tdtr# = t#*dtr#
1331 mbt# = rm#*tdtr#
1332
1333 'Parametric equations for epitrochoid
1334
1335 x0# = m# * COS(tdtr#) - (h# * COS(mbt#)) + 230.0
1336 y0# = m# * SIN(tdtr#) - (h# * SIN(mbt#)) + 240.0
1337
1338 xset = INT(x0#) 'draw first point at x0, y0 and t=0
1339 yset = INT(y0#)
1340
1341 XgrDrawPoint (drawingPad, color, xset, yset)
1342
1343 x# = 0. 'reset x
1344 y# = 0. 'reset y position
1345
1346 DO WHILE (x# <> x0#) && (y# <> y0#)
1347 ' draw the rest of the points until the pattern starts over
1348
1349 t# = t# + increment# 'increment by .25 degrees
1350 tdtr# = t#*dtr#
1351 mbt# = rm#*tdtr#
1352
1353 x# = m# * COS(tdtr#) - (h# * COS(mbt#)) + 230.0
1354 y# = m# * SIN(tdtr#) - (h# * SIN(mbt#)) + 240.0
1355
1356 xset = INT(x#)
1357 yset = INT(y#)
1358
1359 XgrDrawPoint (drawingPad, color, xset, yset)
1360
1361 LOOP
1362 END IF
1363 END SUB
1364
1365
1366 SUB TriangleDirection
1367 ' Triangle Direction Options:
1368 ' $$TriangleUp = 16
1369 ' $$TriangleRight = 20
1370 ' $$TriangleDown = 24
1371 ' $$TriangleLeft = 28
1372 ' DropBox v0 : item - 0 is topmost item
1373
1374 #direction = 16 + (v0 * 4)
1375 PRINT "Triangle Direction="; #direction
1376
1377 END SUB
1378
1379
1380
1381 ' ***** DrawText *****
1382
1383 SUB DrawText
1384 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1385
1386 XgrClearGrid (drawingPad, -1)
1387
1388 ' XgrDrawText (grid, color, text$)
1389 ' XgrDrawText draws contents of text$ in selected color at current Drawpoint
1390 ' color = -1 draws in default color
1391
1392 ' XgrSetDrawpoint (grid, x, y)
1393 ' XgrSetDrawpoint sets the position x, y of the pen position
1394
1395 x = 10
1396 FOR y = 10 TO 470 STEP 18
1397
1398 ' Select a random color number from 0 to 124
1399 RandomN (@RandomNReturn#)
1400 rndNum# = RandomNReturn#
1401 colorNum = INT(rndNum# * 125)
1402
1403 XgrSetDrawpoint (drawingPad, x, y)
1404 text$ = "XgrDrawText() example using colorNumber" + STR$(colorNum)
1405 XgrDrawText (drawingPad, colorNum, text$)
1406 NEXT y
1407 END IF
1408 END SUB
1409
1410
1411
1412 ' ***** DrawTextFill *****
1413 SUB DrawTextFill
1414 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1415
1416 XgrClearGrid (drawingPad, -1)
1417
1418 ' XgrDrawTextFill (grid, color, text$)
1419 ' XgrDrawTextFill draws contents of text$ using selected background color at current Drawpoint
1420 ' color = -1 draws in default background color
1421
1422 ' XgrSetDrawpoint (grid, x, y)
1423 ' XgrSetDrawpoint sets the position x, y of the pen position
1424
1425 x = 10
1426 FOR y = 10 TO 470 STEP 18
1427
1428 ' Select a random color number from 0 to 124 for background color
1429 RandomN (@RandomNReturn#)
1430 rndNum# = RandomNReturn#
1431 backgroundColorNum = INT(rndNum# * 125)
1432
1433 ' XgrSetBackgroundColor (grid, color)
1434 ' XgrSetBackgroundColor sets the background color of selected grid
1435 ' $$Black = 0
1436 ' $$White = 124
1437 ' $$LightGrey = 93
1438
1439 XgrSetBackgroundColor (drawingPad, backgroundColorNum)
1440
1441
1442 ' Select a random color number from 0 to 124 for text color
1443 RandomN (@RandomNReturn#)
1444 rndNum# = RandomNReturn#
1445 colorNum = INT(rndNum# * 125)
1446
1447 XgrSetDrawpoint (drawingPad, x, y)
1448 text$ = "XgrDrawTextFill() example w/ background colorNumber" + STR$(backgroundColorNum)
1449 XgrDrawTextFill (drawingPad, colorNum, text$)
1450
1451 NEXT y
1452 ' Set background color back to light grey
1453 XgrSetBackgroundColor (drawingPad, 93)
1454
1455 END IF
1456
1457 END SUB
1458
1459
1460 ' ***** FillBox *****
1461 SUB FillBox
1462
1463 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1464
1465 XgrClearGrid (drawingPad, -1)
1466
1467 ' XgrFillBox fills a box at x1, y1, x2, y2 with selected color
1468 ' XgrFillBox (grid, color, x1, y1, x2, y2)
1469 '
1470 gap = 20
1471 boxSize = 50
1472
1473 FOR i = 0 TO 6
1474 y1 =(i*boxSize) + (i*gap) + gap
1475 y2 = y1 + boxSize
1476
1477 FOR j = 0 TO 5
1478 x1 = (j*boxSize) + (j*gap) + gap
1479 x2 = x1 + boxSize
1480
1481 'Select a random color number from 0 to 124
1482 RandomN (@RandomNReturn#)
1483 rndNum# = RandomNReturn#
1484 colorNum = INT(rndNum# * 125)
1485
1486 XgrFillBox (drawingPad, colorNum, x1, y1, x2, y2)
1487
1488 NEXT j
1489 NEXT i
1490
1491 END IF
1492
1493 END SUB
1494
1495
1496 SUB FillTriangle
1497
1498 IFT v0 THEN 'Radio Button v0 TRUE = selected, or FALSE = unselected
1499
1500 XgrClearGrid (drawingPad, -1)
1501
1502 ' XgrFillTriangle fills a triangle at x1, y1, x2, y2 with selected color
1503 ' using selected direction.
1504 ' Triangle Direction Options:
1505 ' $$TriangleUp = 16
1506 ' $$TriangleRight = 20
1507 ' $$TriangleDown = 24
1508 ' $$TriangleLeft = 28
1509 ' Style is not yet available.
1510 ' XgrFillTriangle (grid, color, style, direction, x1, y1, x2, y2)
1511 '
1512 IFZ #direction THEN #direction = 16
1513
1514 gap = 1
1515 boxSize = 25
1516
1517 FOR i = 0 TO 18 'no of rows
1518 y1 =(i*boxSize) + (i*gap) + gap
1519 y2 = y1 + boxSize
1520
1521 FOR j = 0 TO 16 'no of columns
1522 x1 = (j*boxSize) + (j*gap) + gap
1523 x2 = x1 + boxSize
1524
1525 'Select a random color number from 0 to 124
1526 RandomN (@RandomNReturn#)
1527 rndNum# = RandomNReturn#
1528 colorNum = INT(rndNum# * 125)
1529
1530 XgrFillTriangle (drawingPad, colorNum, 0, #direction, x1, y1, x2, y2)
1531
1532 NEXT j
1533 NEXT i
1534
1535 END IF
1536
1537 END SUB
1538
1539
1540 END FUNCTION
1541 '
1542 '
1543 ' ########################
1544 ' ##### RandomN () #####
1545 ' ########################
1546 '
1547 FUNCTION RandomN (@RandomNReturn#)
1548 'random number generator by Brosco!
1549 'returns a random value between 0 and 1
1550 IF #RandomNSeed# = 0 THEN GOSUB RandomNSeedRNG
1551 RandomNC1#=24298
1552 RandomNC2#=99991
1553 RandomNC3#=199017
1554 RandomNSeedTmp# = RandomNC1# * #RandomNSeed# + RandomNC2#
1555 ' PRINT "RandomNSeedTmp#="; RandomNSeedTmp#
1556 #RandomNSeed# = RandomNSeedTmp# - INT( RandomNSeedTmp# / RandomNC3# ) * RandomNC3#
1557 ' PRINT "RandomNSeed#="; #RandomNSeed#
1558 RandomNReturn# = #RandomNSeed# / RandomNC3#
1559 ' PRINT "RandomNReturn#="; RandomNReturn#
1560 RETURN
1561 '
1562 '
1563 SUB RandomNSeedRNG
1564 ' RandomNSeed = rnd(1) * 199017
1565 XstGetDateAndTime ( @year, @month, @day, @weekDay, @hour, @minute, @ second, @nanos)
1566 #RandomNSeed# = second/60.0 * 199017
1567 ' PRINT "RandomNSeed#="; #RandomNSeed#
1568 END SUB
1569
1570 END FUNCTION
1571 END PROGRAM