home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 June / PCWorld_2002-06_cd.bin / Software / Komercni / xbase / express / exd17208.r04 / exp17 / Samples / Xdemo4.prg < prev    next >
Text File  |  2002-01-30  |  5KB  |  273 lines
  1. /*
  2.  ╓─────────────────────────────────────────────────────────────────╖
  3.  ║  Program..: XDEMO4.PRG                                          ║
  4.  ║  Author...: Roger J. Donnay                                     ║
  5.  ║  Notice...: (c) DONNAY Software Designs 1987-1998               ║
  6.  ║  Date.....: Jun 26, 1999                                        ║
  7.  ║  Notes....: eXPress Demo Program #4 (Clipper conversion)        ║
  8.  ╙─────────────────────────────────────────────────────────────────╜
  9.  
  10.  This sample program demonstrates how an existing Clipper application
  11.  can be converted from Text-Based to Gui-Based by including the
  12.  EXPRESS.CH header file and linking with the DCLIPX.LIB library.
  13.  
  14. */
  15.  
  16.  
  17. #include "express.ch"
  18.  
  19.  
  20. MEMVAR promptList
  21.  
  22. /* ----------------------- */
  23.  
  24. FUNCTION XDemo_4 ( oDialog, lMDI, lGui )
  25.  
  26. LOCAL nChoice := 1, lSaveGui := DC_Gui(), cSaveScrn, oAppWindow, ;
  27.       oCrt, aDemo, oParent, nCol, nRow
  28.  
  29. DEFAULT lMDI := .f.
  30. DEFAULT lGui := .t.
  31. SET PATH TO ..\DATA
  32.  
  33. IF !lGui
  34.  
  35.   oAppWindow := SetAppWindow()
  36.   DC_Gui(.f.)
  37.   // Create XbpCRT object
  38.   oCrt := XbpCrt():New( oDialog:drawingArea, NIL, { 0, 0 }, 25, 80 )
  39.   oCrt:FontWidth  := 8
  40.   oCrt:FontHeight := 12
  41.   oCrt:FontName   := "Alaska Crt"
  42.   oCrt:Title      := "eXPress++ Demo 4 (Text)"
  43.   oCrt:setInputFocus := {||SetAppWindow(oCrt)}
  44.   oCrt:Create()
  45.  
  46.   // Init Presentation Space
  47.   oCrt:PresSpace()
  48.  
  49.   // XbpCrt gets active window and output device
  50.   SetAppWindow ( oCrt )
  51.  
  52. ELSE
  53.  
  54.    DC_Gui(.t.)
  55.  
  56. ENDIF
  57.  
  58. IF Select('COLLECT') = 0
  59.   USE COLLECT VIA DBFNTX NEW SHARED
  60. ELSE
  61.   dbSelectArea('COLLECT')
  62. ENDIF
  63.  
  64. DO WHILE .t.
  65.  
  66.   IF !lGui
  67.     DC_Gui(.f.)
  68.   ENDIF
  69.  
  70.   SetColor('W+/N')
  71.   CLS
  72.  
  73.   SetColor('N/W,W+/B')
  74.   @ 5,20 CLEAR TO 19,60
  75.   @ 5,20 TO 19,60
  76.  
  77.   @ 7,25 PROMPT 'E = Edit         '
  78.  
  79.   @ 9,25 PROMPT 'B = Browse       '
  80.  
  81.   @11,25 PROMPT 'U = Utilities    '
  82.  
  83.   @13,25 PROMPT 'F = Field List   '
  84.  
  85.   @15,25 PROMPT 'S = Shell to DOS '
  86.  
  87.   @17,25 PROMPT 'X = Exit         '
  88.  
  89.   MENU TO nChoice
  90.  
  91.   DO CASE
  92.  
  93.     CASE nChoice = 1
  94.  
  95.       EditRec()
  96.  
  97.     CASE nChoice = 2
  98.  
  99.       BrowseRec()
  100.  
  101.  
  102.     CASE nChoice = 3
  103.  
  104.       Utilities()
  105.  
  106.  
  107.     CASE nChoice = 4
  108.  
  109.       FieldList()
  110.  
  111.  
  112.     CASE nChoice = 5
  113.  
  114.       RUN COMMAND.COM
  115.  
  116.     CASE nChoice = 6 .OR. nChoice = 0
  117.  
  118.       EXIT
  119.  
  120.   ENDCASE
  121.  
  122. ENDDO
  123.  
  124. DC_Gui(lSaveGui)
  125.  
  126. IF Valtype(oCrt) = 'O' .AND. oCrt:status()>0
  127.   oCrt:Destroy()
  128.   SetAppWindow( oAppWindow )
  129. ENDIF
  130.  
  131. RETURN nil
  132.  
  133. /* --------------------- */
  134.  
  135. STATIC FUNCTION EditRec
  136.  
  137. LOCAL Getlist := {}, GetOptions, cDescrip, cType, cSubType, ;
  138.       dDateOrig, cLocation, cBitmap1, cBitmap2, lOriginal, ;
  139.       nForSale, cCondition, dDateAcq, nOrigPrice, nApprValue, ;
  140.       cComments
  141.  
  142. cDescrip   := COLLECT->descrip
  143. cType      := COLLECT->type
  144. cSubType   := COLLECT->sub_type
  145. dDateOrig  := COLLECT->date_orig
  146. dDateAcq   := COLLECT->date_acqu
  147. nOrigPrice := COLLECT->orig_price
  148. nApprValue := COLLECT->appr_value
  149. cCondition := COLLECT->condition
  150. nForSale   := COLLECT->for_sale
  151. cBitmap1   := COLLECT->bitmap1
  152. cBitmap2   := COLLECT->bitmap2
  153. cLocation  := COLLECT->location
  154. cComments  := COLLECT->comments
  155. lOriginal  := COLLECT->original
  156.  
  157. SetColor('W+/N')
  158. CLS
  159.  
  160. SET DATE FORMAT TO 'mm/dd/yyyy'
  161. SetColor('N/W,W+/B')
  162. @ 5,5 CLEAR TO 20,75
  163. @ 5,5 TO 20,75
  164.  
  165. @ 7,10 SAY '    Description' GET cDescrip
  166.  
  167. @ 9,10 SAY '           Type' GET cType
  168. @10,10 SAY '       Sub-Type' GET cSubType
  169. @11,10 SAY '       Location' GET cLocation
  170.  
  171. @13,10 SAY '  Original Date' GET dDateOrig PICT '99/99/9999'
  172. @14,10 SAY '  Date Acquired' GET dDateAcq  PICT '99/99/9999'
  173.  
  174. @16,10 SAY ' Original Price' GET nOrigPrice
  175. @17,10 SAY 'Appraised Value' GET nApprValue
  176.  
  177. @13,40 SAY '  Bit Map 1' GET cBitMap1
  178. @14,40 SAY '  Bit Map 2' GET cBitMap2
  179.  
  180. @16,40 SAY '  For Sale?' GET nForSale
  181. @16,60 SAY '0,1,2'
  182. @17,40 SAY '  Condition' GET cCondition
  183.  
  184. READ
  185.  
  186.  
  187. RETURN nil
  188.  
  189. /* --------------------- */
  190.  
  191. STATIC FUNCTION BrowseRec
  192.  
  193. SetColor('N/W,W+/B')
  194.  
  195. DbEdit()
  196.  
  197. RETURN nil
  198.  
  199.  
  200. /* --------------------- */
  201.  
  202. STATIC FUNCTION Utilities
  203.  
  204. LOCAL nChoice := 2
  205.  
  206. SetColor('W+/N')
  207. CLS
  208.  
  209. SetColor('N/W,W+/B')
  210.  
  211. @ 5,20 CLEAR TO 17,60
  212. @ 5,20 TO 17,60
  213.  
  214. @ 7,25 PROMPT 'P = Pack         '
  215.  
  216. @ 9,25 PROMPT 'B = Backup       '
  217.  
  218. @11,25 PROMPT 'C = Copy         '
  219.  
  220. @13,25 PROMPT 'I = Import       '
  221.  
  222. @15,25 PROMPT 'X = Exit         '
  223.  
  224. MENU TO nChoice
  225.  
  226. DO CASE
  227.  
  228.   CASE nChoice = 1
  229.  
  230.     Alert('This is my PACK routine')
  231.  
  232.   CASE nChoice = 2
  233.  
  234.     Alert('This is my BACKUP routine')
  235.  
  236.   CASE nChoice = 3
  237.  
  238.     Alert('This is my COPY routine')
  239.  
  240.   CASE nChoice = 4
  241.  
  242.     Alert('This is my IMPORT routine')
  243.  
  244. ENDCASE
  245.  
  246. RETURN nil
  247.  
  248.  
  249. /* --------------------- */
  250.  
  251. STATIC FUNCTION FieldList
  252.  
  253. LOCAL aStru := dbStruct(), aFieldNames := {}, i, nChoice
  254.  
  255. FOR i := 1 TO Len(aStru)
  256.   AAdd( aFieldNames, Pad(aStru[i,1],12) + Pad(aStru[i,2],4) + ;
  257.                      Str(aStru[i,3],4) + Str(aStru[i,4],4) )
  258. NEXT
  259.  
  260. SetColor('W+/N')
  261. CLS
  262.  
  263. SetColor('N/W,W+/B')
  264.  
  265. @ 8,10 CLEAR TO 20,40
  266. @ 8,10 TO 20,40
  267.  
  268. nChoice := Achoice(  9, 11, 19, 39, aFieldNames )
  269.  
  270. RETURN nChoice
  271.  
  272.  
  273.