home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / arexx / ole1v10a.lha / OLE_System / ole / ReadTable.pcalc < prev    next >
Encoding:
Text File  |  1995-02-10  |  8.2 KB  |  422 lines
  1. /*
  2.  * ReadTable.pcalc
  3.  *
  4.  * This script read a selected range of cells from ProCalc and put it into
  5.  * the cliplist in order to use with other external modules. My first OLE
  6.  * module.
  7.  *
  8.  * USAGE: ReadTable.pcalc(ArgObject)
  9.  *
  10.  * TODO: exclude hided rows and columns
  11.  *         write filename in the update info
  12.  *
  13.  * HISTORY:
  14.  * v1.01    some bug fixed in the GUI builder
  15.  *
  16.  * v1.02    aligned with the new server design v1.10
  17.  *
  18.  * v1.03    bug fixed in ReqFile()
  19.  *
  20.  * v1.04    small bug fixed when quitting
  21.  *
  22.  * $(C): (1994, Rocco Coluccelli, Bologna)
  23.  * $VER: ReadTable.pcalc 1.04 (07.Feb.1995)
  24.  */
  25.  
  26. OPTIONS RESULTS
  27.  
  28. /*
  29.  *    Read the startup clip
  30.  *    start point for gadgets, font dimension, commands ports, ...
  31.  */
  32. PARSE ARG oleclip
  33. PARSE VALUE GETCLIP(oleclip) WITH jobID modID box.left box.top char.w char.h olewin oleport olehost userscreen . olepipe locale config .
  34.  
  35. /*
  36.  *    Configuration
  37.  */
  38. IF ~SHOW('C',config) THEN DO
  39.     host.path = 'Work:ProCalc/Procalc'
  40.     host.port = 'PCALC'
  41.     host.file = 'Work:Procalc/PCF/'
  42.     range = 'A1:B2'
  43.     launch = 0
  44.     END
  45.  
  46. ELSE
  47.     PARSE VALUE GETCLIP(config) WITH host.path','host.port','host.file','range','launch','
  48.  
  49.  
  50. /*
  51.  *    Send commands to OLE server
  52.  */
  53. ADDRESS VALUE oleport
  54.  
  55. /*
  56.  *    Open the module commands port
  57.  */
  58. IF OPENPORT(olehost) == NULL() THEN DO
  59.     ERROR jobID modID 1 olehost
  60.     SETJOB jobID 'end'
  61.     EXIT 10
  62.     END
  63.  
  64. /*
  65.  *    Wait for messages at control port until the end
  66.  */
  67. elab = 1
  68. st = GUIGads()
  69. DO UNTIL st = 'end'
  70.  
  71.     CALL WAITPKT(olehost)
  72.     pkt = GETPKT(olehost)
  73.  
  74.     IF pkt == NULL() THEN ITERATE
  75.  
  76.     /*
  77.      *    Extract and execute each command.
  78.      */
  79.     PARSE VALUE GETARG(pkt) WITH cmd argv
  80.     PARSE VALUE GETARG(pkt,1) WITH n0 .
  81.  
  82.     SELECT
  83.  
  84.         WHEN cmd = 'REQFILE' THEN DO
  85.             PARSE VAR argv t .
  86.             str = STRIP(GETARG(pkt,2),'B')
  87.  
  88.             IF str = '' THEN str = ReqFile(100,100,host.t,GetLocale(t),userscreen)
  89.             IF t = 'FILE' THEN str = CheckFAFF(str)
  90.  
  91.             IF str ~= '' THEN host.t = str
  92.             g_str.n0 = host.t
  93.         END
  94.  
  95.         WHEN cmd = 'PORT' THEN DO
  96.             IF GETARG(pkt,2) ~= '' THEN host.port = GETARG(pkt,2)
  97.             g_str.n0 = host.port
  98.         END
  99.  
  100.         WHEN cmd = 'LOMEM' THEN DO
  101.             launch = ~launch
  102.             g_str.n0 = launch
  103.         END
  104.  
  105.         WHEN cmd = 'RANGE' THEN DO
  106.             str = UPPER(GETARG(pkt,2))
  107.  
  108.             IF argv = 'DEL' THEN
  109.                 str = ''
  110.  
  111.             ELSE IF argv = 'ADD' THEN
  112.                 str = range HostCmd('Current')
  113.  
  114.             ELSE IF argv = 'SUB' THEN
  115.                 str = range '-'HostCmd('Current')
  116.  
  117.             range = ''
  118.             DO WHILE str ~= ''
  119.                 PARSE VAR str firstcell':'lastcell str
  120.                 IF lastcell ~= '' THEN range = range firstcell':'lastcell
  121.             END
  122.  
  123.             range = SPACE(range,1)
  124.             elab = (range ~= '')
  125.             g_str.n0 = range
  126.         END
  127.  
  128.         WHEN cmd = 'START' THEN DO
  129.  
  130.             IF st = nmain & launch THEN DO
  131.                 IF ~Run_Host(host.path,host.port) THEN DO
  132.                     ERROR jobID modID 0 'can´t find' host.path || '0a'x || host.port 'don´t responde...'
  133.                     elab = 0
  134.                     END
  135.  
  136.                 ELSE CALL HostCmd('Open' host.file)
  137.  
  138.                 CALL WindowToFront(olewin)
  139.                 END
  140.  
  141.             IF st = nmain THEN DO
  142.                 CALL Gadgets(7,n1.st,n2.st)
  143.                 g_str.nokay = GetLocale('11'); CALL Gadgets(2,nokay)
  144.                 st = nrange; CALL Gadgets(4,n1.st,n2.st)
  145.                 IF launch THEN CALL Gadgets(4,n1.nlaunch,n2.nlaunch)
  146.                 END
  147.  
  148.             ELSE st = 'end'
  149.  
  150.         END
  151.  
  152.         WHEN cmd = 'UNICONIFY' THEN
  153.             CALL Gadgets(8,1,g_gads)
  154.  
  155.         WHEN cmd = 'HELP' THEN
  156.             ABOUT jobID modID 'HELP' || st
  157.  
  158.         WHEN cmd = 'QUIT' THEN DO
  159.             elab = 0
  160.             st = 'end'
  161.         END
  162.  
  163.         OTHERWISE NOP
  164.  
  165.     END    /* end select commands */
  166.  
  167.     IF n0 ~= '' THEN DO
  168.         CALL Gadgets(2,n0)
  169.         CALL SETCLIP(config,host.path','host.port','host.file','range','launch',')
  170.         END
  171.  
  172.     CALL REPLY(pkt,0)
  173.  
  174. END    /* end do until */
  175.  
  176. CALL CLOSEPORT(olehost)
  177.  
  178. IF cmd = 'QUIT' THEN
  179.     EXIT 0
  180.  
  181. IF ~elab THEN
  182.     SETJOB jobID 'end'
  183.  
  184. IF launch THEN
  185.     CALL HostCmd('Close')
  186.  
  187. /*
  188.  *    Let the server launch the next module
  189.  */
  190. SETJOB jobID modID + 1
  191.  
  192. IF 'OLE:Parse_PCF'(olepipe,host.file,range) ~= 0 THEN DO
  193.     SETJOB jobID 'end'
  194.     EXIT 10
  195.     END
  196.  
  197. EXIT 0
  198.  
  199.  
  200. GetLocale: PROCEDURE EXPOSE locale
  201. ARG strID
  202.  
  203.     strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale) WITH (strID)text'Þ'
  204.  
  205. RETURN text
  206.  
  207.  
  208. /*
  209.  *    procedure that split a path and request a file
  210.  *
  211.  *    pathname = ReqFile(x,y,path,title,userscreen)
  212.  */
  213. ReqFile: PROCEDURE
  214.  
  215.     dir = ''; file = ''
  216.     IF ARG(3) ~= '' THEN DO
  217.         pos = LASTPOS('/',ARG(3))
  218.  
  219.         IF pos = 0 THEN DO
  220.             pos = POS(':',ARG(3))
  221.             dir = LEFT(ARG(3),pos)
  222.             END
  223.  
  224.         ELSE dir = LEFT(ARG(3),pos - 1)
  225.  
  226.         file = SUBSTR(ARG(3),pos + 1)
  227.         END
  228.  
  229. RETURN GetFile(ARG(1),ARG(2),dir,file,ARG(4),ARG(5))
  230.  
  231.  
  232. /*
  233.  *    Send commands to host program
  234.  */
  235. HostCmd:
  236. PARSE ARG cmd
  237.  
  238.     ADDRESS VALUE host.port
  239.     cmd
  240.     ADDRESS
  241.  
  242. RETURN result
  243.  
  244.  
  245. /*
  246.  *    Check if FAFF
  247.  */
  248. CheckFAFF: PROCEDURE EXPOSE jobID modID
  249. PARSE ARG file
  250.  
  251.     IF file = '' THEN RETURN ''
  252.  
  253.     IF OPEN(pcf,file,'R') THEN DO
  254.         head  = C2D(READCH(pcf,1))
  255.         len   = C2D(READCH(pcf,2))
  256.         magic = C2D(READCH(pcf,4))
  257.         CALL CLOSE(pcf)
  258.         END
  259.  
  260.     IF head = 1 & len = 4 & magic = 681281268 THEN RETURN file
  261.  
  262.     REQASK jobID modID 'þBADFILE'
  263.  
  264. RETURN ''
  265.  
  266.  
  267. GUIGads:
  268.  
  269.     g_offx. = 2;    g_offx.1 = 0;            g_offx.3 = 2
  270.     g_offy. = 2;    g_offy.1 = char.h + 1;    g_offy.3 = 3
  271.     g_wid. = 8;                g_wid.1 = 0;            g_wid.3 = 12
  272.     g_hei. = char.h + 4;    g_hei.1 = char.h + 1;    g_hei.3 = char.h + 6
  273.     g_sx = char.w % 2;    g_sy = char.h % 4
  274.     g_onoff. = 0
  275.  
  276.     box.left = box.left + g_sx; box.top = box.top + 2 * g_sy
  277.     box.w = 36 * char.w
  278.  
  279.     n = 1
  280.     nmain = 1; nrange = 2; nlaunch = 3
  281.  
  282.     n1.nmain = n
  283.     x = box.left; y = box.top
  284.     CALL IniFileGad('REQFILE PATH',host.path,GetLocale('1'))
  285.     y = y + g_hei.3 + g_sy
  286.     CALL IniGad(1,1,0,,GetLocale('2'))
  287.     CALL IniGad(3,0,1,'PORT %1' n '%2%g',host.port,12)
  288.     y = y + g_hei.3 + 2 * g_sy
  289.     CALL IniGad(4,1,0,'LOMEM %1' n,launch,GetLocale('3'))
  290.     y = y + g_hei.3 + 2 * g_sy
  291.     CALL IniFileGad('REQFILE FILE',host.file,GetLocale('4'))
  292.     box.h = y
  293.     n2.nmain = n - 1
  294.  
  295.     n1.nrange = n
  296.     y = box.top
  297.     CALL IniGad(1,1,0,,GetLocale('5')); x0 = x
  298.     CALL IniGad(2,3,0,'RANGE DEL %1' n + 1,GetLocale('6'))
  299.     x = box.left; y = y + g_hei.3 + g_sy
  300.     n1 = IniGad(3,1,0,'RANGE %1' n '%2%g',range)
  301.     box.h = MAX(box.h,y)
  302.     n2.nrange = n - 1
  303.  
  304.     n1.nlaunch = n
  305.     x = x0; y = box.top
  306.     CALL IniGad(2,0,1,'RANGE ADD %1' n1,GetLocale('7'))
  307.     CALL IniGad(2,0,0,'RANGE SUB %1' n1,GetLocale('8'))
  308.     n2.nlaunch = n - 1
  309.  
  310.     y = box.h + g_hei.3 + 2 * g_sy
  311.     nokay = IniGad(2,1,0,'START',GetLocale('9'))
  312.     g_gads = IniGad(2,3,0,'HELP',GetLocale('10'))
  313.  
  314.     box.h = y + g_hei.2 + 2 * g_sy - box.top
  315.  
  316.     WINDOW jobID modID (box.w + 2 * g_sx) (box.h + 2 * g_sy) 1 1
  317.     CALL Gadgets(1,g_gads,g_gads - 1)
  318.     CALL Gadgets(4,n1.nmain,n2.nmain)
  319.  
  320. RETURN nmain
  321.  
  322.  
  323. Gadgets:
  324.  
  325.     IF ARG(1) < 4 THEN
  326.         DO i = 2 TO ARG(); n = ARG(i)
  327.             IF ARG(1) ~= 1 THEN CALL DelGad(n,g_type.n)
  328.             IF ARG(1) ~= 3 THEN CALL NewGad(n,g_type.n)
  329.         END
  330.  
  331.     ELSE IF ARG(1) < 7 THEN
  332.         DO n = ARG(2) TO ARG(3)
  333.             IF ARG(1) ~= 4 THEN CALL DelGad(n,g_type.n)
  334.             IF ARG(1) ~= 6 THEN CALL NewGad(n,g_type.n)
  335.         END
  336.  
  337.     ELSE IF ARG(1) = 8 THEN
  338.         DO n = ARG(2) TO ARG(3)
  339.             IF g_onoff.n THEN CALL NewGad(n,g_type.n)
  340.         END
  341.  
  342.     ELSE DO
  343.         DO n = ARG(2) TO ARG(3)
  344.             g_onoff.n = 0
  345.             IF g_type.n ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  346.         END
  347.         CALL SetAPen(olewin,0)
  348.         CALL RectFill(olewin,box.left,box.top,box.left + box.w,box.top + box.h)
  349.         CALL RefreshGadgets(olewin)
  350.         END
  351. RETURN
  352.  
  353.  
  354. DelGad:
  355. PARSE ARG n,t
  356.  
  357.     g_onoff.n = 0
  358.  
  359.     IF t ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  360.  
  361.     x = g_xpos.n - g_offx.t; y = g_ypos.n - g_offy.t
  362.     CALL SetAPen(olewin,0)
  363.     CALL RectFill(olewin,x,y,x + g_len.n,y + g_hei.t)
  364.  
  365. RETURN
  366.  
  367.  
  368. NewGad:
  369. PARSE ARG n,t
  370.  
  371.     g_onoff.n = 1
  372.  
  373.     IF t = 2 THEN
  374.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n)
  375.  
  376.     ELSE IF t = 3 THEN
  377.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n,g_len.n - 4,"RIDGEBORDER")
  378.  
  379.     ELSE IF t = 4 THEN
  380.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,D2C(32 + g_str.n * 183),g_msg.n)
  381.  
  382.     ELSE DO
  383.         CALL SetAPen(olewin,1)
  384.         CALL Move(olewin,g_xpos.n,g_ypos.n)
  385.         CALL Text(olewin,g_str.n)
  386.         END
  387. RETURN
  388.  
  389.  
  390. IniFileGad:
  391. PARSE ARG msg,str,txt
  392.  
  393.     CALL IniGad(1,1,0,,txt)
  394.     y = y + g_hei.1 + 2 * g_sy
  395.     CALL IniGad(2,1,0,msg '%1' (n + 1),'F')
  396.     CALL IniGad(3,0,1,msg '%1' n '%2%g',str)
  397.  
  398. RETURN n - 1
  399.  
  400.  
  401. IniGad:
  402. PARSE ARG t,na,nx,g_msg.n,g_str.n,var
  403.  
  404.     x = x + nx * g_sx
  405.  
  406.     IF t = 3 & var > 0 THEN
  407.         g_len.n = var * char.w + g_wid.t
  408.     ELSE IF t = 3 THEN
  409.         g_len.n = box.left + box.w - x
  410.     ELSE
  411.         g_len.n = LENGTH(g_str.n) * char.w + g_wid.t
  412.  
  413.     IF na > 0 THEN x = box.left + (na - 1) * (box.w - g_len.n) % 2 + nx * g_sx
  414.  
  415.     g_xpos.n = x + g_offx.t; g_ypos.n = y + g_offy.t; g_type.n = t
  416.     x = x + g_len.n
  417.     n = n + 1
  418.  
  419.     IF t = 4 THEN CALL IniGad(1,0,1,,var)
  420.  
  421. RETURN n - 1
  422.