home *** CD-ROM | disk | FTP | other *** search
- /*
- @N
-
- This Genie will copy an object or group of objects to a range of pages.
- */
- msg = PDSetup.rexx(2,0)
- units = getclip(pds_units)
- if msg ~= 1 then exit_msg(msg)
-
- arg object, startpage, endpage
- pageoptions = "ODDEVENALL "
-
- if object = '' then do
- object = pdm_SelFirstobj()
- if object = 0 then
- exit_msg("Select a group of objects to be copied first")
- sourcepage = pdm_GetObjPage(object)
- docstart = pdm_DocFirstPage()
- docend = pdm_DocLastPage()
-
- form = "Start Page:"docstart'0a'x "End Page:"docend'0a'x "ODD/EVEN/ALL:ALL"
- form = upper(pdm_GetForm("Enter options", 8, form))
- if form = '' then exit_msg()
-
- parse var form startpage '0a'x endpage '0a'x pageopts
-
- if endpage = '' then exit_msg("Invalid Range")
- if pageopts = '' then pageopts = "ALL"
-
- if startpage < docstart then exit_msg("Invalid Range")
- else if startpage > docend then exit_msg("Invalid Range")
- if endpage < docstart then exit_msg("Invalid Range")
- else if endpage > docend then exit_msg("Invalid Range")
- if endpage < startpage then exit_msg("Invalid Range")
- end
-
-
- if datatype(startpage) ~= 'NUM' | datatype(endpage) ~= 'NUM' then
- call exit_msg("Invalid input")
-
- if verify(pageopts, pageoptions) ~= 0 then exit_msg("Invalid Entry")
-
- opos = pos(pageopts, pageoptions)
-
- if opos = 4 then do
- increment = 2
- if (startpage // 2) then startpage = startpage + 1
- end
- else if opos = 1 then do
- increment = 2
- if ~(startpage // 2) then startpage = startpage + 1
- end
- else increment = 1
-
- num = 0
- object = pdm_SelFirstObj()
- do while object ~= 0
- if ((pdm_iscompound(object) = 0) | (pdm_isfirst(object) ~= 0)) then do
- num = num + 1
- objects.num = object
- end
- object = pdm_SelNextObj(object)
- end
-
- do page = startpage to endpage by increment
- if page ~= sourcepage then do
- call pdm_ShowStatus("Working on page "page)
- do i = 1 to num
- newobject = pdm_CloneObj(objects.i, 0, 0, 0, 0, 1, 1, 0)
- call pdm_SetObjPage(newobject, page)
- end
- end
- end
-
- exit_msg()
-
- exit_msg: procedure expose units
- do
- parse arg message
-
- if message ~= '' then
- call pdm_Inform(1,message,)
-
- call pdm_SetUnits(units)
- call pdm_ClearStatus()
- call pdm_AutoUpdate(1)
- exit
- end
-