home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 June / PCWorld_2002-06_cd.bin / Software / Komercni / xbase / express / exd17208.r04 / exp17 / Samples / Xdemo3.prg < prev    next >
Encoding:
Text File  |  2002-01-30  |  22.1 KB  |  788 lines
  1. /*
  2.  ╓─────────────────────────────────────────────────────────────────╖
  3.  ║  Program..: XDEMO3.PRG                                          ║
  4.  ║  Author...: Roger J. Donnay                                     ║
  5.  ║  Notice...: (c) DONNAY Software Designs 1987-2001               ║
  6.  ║  Date.....: Sep 15, 2001                                        ║
  7.  ║  Notes....: eXPress Demo Program #3                             ║
  8.  ╙─────────────────────────────────────────────────────────────────╜
  9.  
  10.  This sample program demonstrates miscellaneous features of
  11.  eXPress++ like Tab Pages, Bitmaps, Spin Buttons, ScrollBars,
  12.  Directory listings and Custom objects.
  13.  
  14. */
  15.  
  16. #include "dcdir.ch"
  17. #include "dcgra.ch"
  18. #include "dcpick.ch"
  19. #include "dcbitmap.ch"
  20. #include "dcdialog.ch"
  21. #include "appevent.ch"
  22. #include "dccursor.ch"
  23. #include "gra.ch"
  24.  
  25. #define  oTabPage1     aLocals[1]
  26. #define  oTabPage2     aLocals[2]
  27. #define  oTabPage3     aLocals[3]
  28. #define  oTabPage4     aLocals[4]
  29. #define  oTabPage5     aLocals[5]
  30. #define  oTabPage6     aLocals[6]
  31. #define  oTabPage7     aLocals[7]
  32. #define  oTabPage8     aLocals[8]
  33. #define  cBitMap1      aLocals[9]
  34. #define  oBitMap1      aLocals[10]
  35. #define  oToolBar      aLocals[11]
  36. #define  aDirectory    aLocals[12]
  37. #define  oDirectory    aLocals[13]
  38. #define  oDirGroup     aLocals[14]
  39. #define  oIconGroup    aLocals[15]
  40. #define  nRed          aLocals[16]
  41. #define  nGreen        aLocals[17]
  42. #define  nBlue         aLocals[18]
  43. #define  oColorBox     aLocals[19]
  44. #define  oPS           aLocals[20]
  45. #define  oMsgBox       aLocals[21]
  46. #define  oRedBar       aLocals[22]
  47. #define  oGreenBar     aLocals[23]
  48. #define  oBlueBar      aLocals[24]
  49. #define  oRedSpin      aLocals[25]
  50. #define  oGreenSpin    aLocals[26]
  51. #define  oBlueSpin     aLocals[27]
  52. #define  oPhoto1       aLocals[28]
  53. #define  oPhoto2       aLocals[29]
  54. #define  oDesc1        aLocals[30]
  55. #define  oDesc2        aLocals[31]
  56. #define  oDesc3        aLocals[32]
  57. #define  bCustom       aLocals[33]
  58. #define  oBanner       aLocals[34]
  59. #define  aGetlist      aLocals[35]
  60. #define  aGetOptions   aLocals[36]
  61. #define  bCrt1         aLocals[37]
  62. #define  bCrt2         aLocals[38]
  63. #define  bCrt3         aLocals[39]
  64. #define  oCrtWindow    aLocals[40]
  65. #define  cCrtGet1      aLocals[41]
  66. #define  lTestMode     aLocals[42]
  67. #define  lLogicTest    aLocals[43]
  68. #define  oClipPhoto    aLocals[44]
  69. #define  lDotActive    aLocals[45]
  70. #define  bTimerEvent   aLocals[46]
  71. #define  nSeconds2     aLocals[47]
  72. #define  oButton1      aLocals[48]
  73. #define  oButton2      aLocals[49]
  74. #define  lPlayBack     aLocals[50]
  75. #define  lStartUp      aLocals[51]
  76. #define  oDirs         aLocals[52]
  77. #define  oFiles        aLocals[53]
  78. #define  cFileName1    aLocals[54]
  79. #define  oFileName1    aLocals[55]
  80. #define  cFileName2    aLocals[56]
  81. #define  oFileName2    aLocals[57]
  82. #define  cDirectory    aLocals[58]
  83. #define  aFile         aLocals[59]
  84. #define  cSource       aLocals[60]
  85. #define  bSortCol      aLocals[61]
  86. #define  aListField    aLocals[62]
  87. #define  aPickField    aLocals[63]
  88. #define  cAlias        aLocals[64]
  89. #define  oBrowse       aLocals[65]
  90. #define  lDialogActive aLocals[66]
  91. #define  oProgress     aLocals[67]
  92. #define  oThread       aLocals[68]
  93. #define  cSaveDir      aLocals[69]
  94. #define  oDir          aLocals[70]
  95. #define  oDlg          aLocals[71]
  96. #define  oDlgWindow    aLocals[72]
  97. #define  cTitle        aLocals[73]
  98. #define  lMDIApp       aLocals[74]
  99. #define  oTabPageArea3 aLocals[75]
  100. #define  oTabPageArea4 aLocals[76]
  101.  
  102. FUNCTION XDemo_3 ( oDialog )
  103.  
  104. LOCAL aLocals[76], GetOptions, GetList, i
  105.  
  106. SET PATH TO ..\DATA
  107.  
  108. DC_Gui(.t.)
  109.  
  110. _BuildGets( @GetList, @GetOptions, aLocals, oDialog )
  111.  
  112. lStartUp := .t.
  113. lDotActive := .f.
  114.  
  115. cSaveDir := DC_CurPath()
  116.  
  117. DCREAD GUI ;
  118.    TITLE cTitle ;
  119.    OPTIONS GetOptions ;
  120.    HANDLER DlgHandler REFERENCE aLocals ;
  121.    APPWINDOW oDialog ;
  122.    FIT
  123.  
  124. SetTimerEvent(0)
  125. lDialogActive := .f.
  126. Sleep(30)
  127. DC_ChDir(cSaveDir)
  128.  
  129. CLOSE DATABASES
  130.  
  131. RETURN nil
  132.  
  133. * -------------------------
  134.  
  135. STATIC FUNCTION ;
  136.   DlgHandler ( nEvent, mp1, mp2, oXbp, oDialog, GetList, aLocals )
  137.  
  138. IF lStartUp
  139.   lDialogActive := .t.
  140.   oThread := Thread():new()
  141.   oThread:Start({||_TestProgress(aLocals)})
  142.   RGB(aLocals)
  143.   lStartUp := .f.
  144. ENDIF
  145.  
  146. RETURN DCGUI_NONE
  147.  
  148. * --------------------
  149.  
  150. STATIC FUNCTION _BuildGets( GetList, GetOptions, aLocals, oDialog )
  151.  
  152. LOCAL i, aCoords
  153.  
  154. GetList := {}
  155. cTitle := 'eXPress++ Demo Program #3' ;
  156.  
  157. /* ---- Tab Page #1 ---- */
  158.  
  159. @  2,1 DCTABPAGE oTabPage1 CAPTION 'Colors' ;
  160.    SIZE 84,16 PREOFFSET 0 POSTOFFSET 90 ;
  161.    MESSAGE 'Demonstration of Colors and ScrollBars'
  162.  
  163. nRed   := 50 ; nGreen := 100 ; nBlue  := 150
  164.  
  165. @ 2.5, 20 DCSPINBUTTON nRed PARENT oTabPage1 SIZE 7 LIMITS 0,255 ;
  166.         OBJECT oRedSpin ;
  167.         CALLBACK {|a,b,o|o:GetData(),oRedBar:SetData(),RGB(aLocals)}
  168.  
  169. @ 0, -10  DCSAY 'Red' SAYSIZE 5 PARENT oTabPage1 RELATIVE oRedSpin
  170.  
  171. @ 0, 10 DCSCROLLBAR DATA nRed SIZE 40,1 PARENT oTabPage1 ;
  172.         RELATIVE oRedSpin ;
  173.         TYPE XBPSCROLL_HORIZONTAL RANGE 0,255 OBJECT oRedBar ;
  174.         SCROLL { |a,x,o| nRed := a[1], ;
  175.                          oRedSpin:SetData(), ;
  176.                          o:SetData(), RGB(aLocals) }
  177.  
  178. @ 2, 0  DCSPINBUTTON nGreen PARENT oTabPage1 SIZE 7 LIMITS 0,255 ;
  179.         OBJECT oGreenSpin RELATIVE oRedSpin ;
  180.         CALLBACK {|a,b,o|o:GetData(),oGreenBar:SetData(),RGB(aLocals)}
  181.  
  182.  
  183. @ 0, -10  DCSAY 'Green' SAYSIZE 5 PARENT oTabPage1 RELATIVE oGreenSpin
  184.  
  185. @ 0, 10 DCSCROLLBAR DATA nGreen SIZE 40,1 PARENT oTabPage1 ;
  186.         TYPE XBPSCROLL_HORIZONTAL RANGE 0,255 OBJECT oGreenBar ;
  187.         RELATIVE oGreenSpin ;
  188.         SCROLL { |a,x,o| nGreen := a[1], ;
  189.                          oGreenSpin:SetData(), ;
  190.                          o:SetData(), RGB(aLocals) }
  191.  
  192. @ 2, 0  DCSPINBUTTON nBlue PARENT oTabPage1 SIZE 7 LIMITS 0,255 ;
  193.         OBJECT oBlueSpin RELATIVE oGreenSpin ;
  194.         CALLBACK {|a,b,o|o:GetData(),oBlueBar:SetData(),RGB(aLocals)}
  195.  
  196. @ 0, -10 DCSAY 'Blue' SAYSIZE 5 PARENT oTabPage1 RELATIVE oBlueSpin
  197.  
  198. @ 0, 10 DCSCROLLBAR DATA nBlue  SIZE 40,1 PARENT oTabPage1 ;
  199.         RELATIVE oBlueSpin ;
  200.         TYPE XBPSCROLL_HORIZONTAL RANGE 0,255 OBJECT oBlueBar ;
  201.         SCROLL { |a,x,o| nBlue := a[1], ;
  202.                          oBlueSpin:SetData(), ;
  203.                          o:SetData(), RGB(aLocals) }
  204.  
  205. @ 3, 0  DCSTATIC XBPSTATIC_TYPE_RAISEDBOX SIZE 45,4 ;
  206.         OBJECT oColorBox PARENT oTabPage1 RELATIVE oBlueSpin ;
  207.         EVAL { |o| o:paint := {||RGB(aLocals)} }
  208.  
  209.  
  210. /* ---- Tab Page #2 ---- */
  211.  
  212. @  0,0 DCTABPAGE oTabPage2 CAPTION 'Directory' ;
  213.    RELATIVE oTabPage1 ;
  214.    MESSAGE 'Demonstration of Directory Listings'
  215.  
  216. cFileName1 := Space(30)
  217.  
  218. @ 2,2 DCGET cFileName1 GETSIZE 43 PARENT oTabPage2 GETOBJECT oFileName1
  219.  
  220. @ 3.5,2 DCSTATIC XBPSTATIC_TYPE_RECESSEDBOX SIZE 41.5,12 ;
  221.       OBJECT oDirGroup PARENT oTabPage2
  222.  
  223. aDirectory := Directory()
  224. FOR i := 1 TO Len(aDirectory)
  225.   ASize(aDirectory[i],5)
  226.   aDirectory[i,5] := .f.
  227. NEXT
  228. aFile := aDirectory[1]
  229.  
  230. @ .2,.2 DCBROWSE oDirectory PARENT oDirGroup DATA aDirectory ;
  231.       SIZE 41,11.8 ;
  232.       FONT '10.Helv Bold' ;
  233.       INTO aFile ;
  234.       DATALINK {||cFileName1:=aFile[1],oFileName1:SetData()} ;
  235.       MARK 5 ;
  236.       MKCOLOR nil, GRA_CLR_WHITE, GRA_CLR_BLUE
  237.  
  238. bSortCol := {|a,n,o| _Sort(aDirectory,n) }
  239.  
  240. DCBROWSECOL ELEMENT 1 WIDTH 8*10 HEADER "Name" PARENT oDirectory SORT bSortCol pixel
  241.  
  242. DCBROWSECOL ELEMENT 2 WIDTH 5 HEADER "Size" PARENT oDirectory SORT bSortCol WHEN {||.f.}
  243.  
  244. DCBROWSECOL ELEMENT 3 WIDTH 5 HEADER "Date" PARENT oDirectory SORT bSortCol
  245.  
  246. DCBROWSECOL ELEMENT 4 WIDTH 5 HEADER "Time" PARENT oDirectory SORT bSortCol
  247.  
  248. cFileName1 := Space(30)
  249. cFileName2 := Space(30)
  250. cDirectory := ''
  251.  
  252. @ 2,45 DCGET cFileName2 GETSIZE 43 PARENT oTabPage2 GETOBJECT oFileName2
  253.  
  254. IF Upper(AppName()) == 'XANON.EXE'
  255.  
  256.    @ 4.5, 45 DCSAY 'Directory Tree disabled in On-Line Demo' ;
  257.      PARENT oTabPage2 SAYSIZE 30
  258.  
  259. ELSE
  260.   @ 3.5,45 DCDIRTREE ;
  261.        DIRS oDirs VAR cDirectory ;
  262.        FILES oFiles VAR cFileName2 DATALINK {||oFileName2:SetData()} ;
  263.        PARENT oTabPage2 ;
  264.        SIZE 37,12 ;
  265.        EXT '*.BAT','*.*','*.BAK','*.BMP','*.TXT'
  266. ENDIF
  267.  
  268.  
  269. /* ---- Tab Page #3 ---- */
  270.  
  271. @  0,0 DCTABPAGE oTabPage3 CAPTION 'Banner' ;
  272.    RELATIVE oTabPage2 ;
  273.    STATICAREA oTabPageArea3 ;
  274.    MESSAGE 'Demonstration of Custom Banner and Icons'
  275.  
  276. @ 2,5 DCSTATIC XBPSTATIC_TYPE_RAISEDBOX SIZE 15,7 ;
  277.       OBJECT oIconGroup PARENT oTabPageArea3
  278.  
  279. @ 2,2 DCSTATIC XBPSTATIC_TYPE_SYSICON PARENT oIconGroup ;
  280.       CAPTION XBPSTATIC_SYSICON_ICONINFORMATION
  281.  
  282. @ 5,2 DCSTATIC XBPSTATIC_TYPE_SYSICON PARENT oIconGroup ;
  283.       CAPTION XBPSTATIC_SYSICON_ICONQUESTION
  284.  
  285. @ 2,7 DCSTATIC XBPSTATIC_TYPE_SYSICON PARENT oIconGroup ;
  286.       CAPTION XBPSTATIC_SYSICON_ICONERROR
  287.  
  288. @ 5,7 DCSTATIC XBPSTATIC_TYPE_SYSICON PARENT oIconGroup ;
  289.       CAPTION XBPSTATIC_SYSICON_ICONWARNING
  290.  
  291. @ 10,5 DCSAY 'This Banner is here to demonstrate custom ' + ;
  292.              'objects.  Move the mouse across the banner.' ;
  293.        PARENT oTabPageArea3 SAYSIZE 70
  294.  
  295. bCustom := {|a|DemoBanner(a,aLocals)}
  296. @ 11,5 DCCUSTOM bCustom PARENT oTabPageArea3 OBJECT oBanner ;
  297.          CAPTION 'This Banner is here to demonstrate custom ' + ;
  298.                  'objects.  Move the mouse across the banner.' ;
  299.          SIZE 70,2 TYPE 1 FONT "20.Arial Bold" ;
  300.          PRESENTATION { { XBP_PP_FGCLR, GRA_CLR_DARKRED }, ;
  301.                         { XBP_PP_BGCLR, GRA_CLR_WHITE } }
  302.  
  303.  
  304. @ 3,25 DCGRASTRING {'This is a Progress-Bar object that is being updated', ;
  305.                     'from a procedure running in another thread' } ;
  306.        PARENT oTabPageArea3 FONT '10.Arial Bold' COLOR GRA_CLR_RED
  307.  
  308.  
  309. @ 5.5,25 DCPROGRESS oProgress PARENT oTabPageArea3 ;
  310.        SIZE 50,1.5 ;
  311.        PERCENT ;
  312.        MAXCOUNT 100 COLOR GRA_CLR_BLUE
  313.  
  314. /* ---- Tab Page #4 ---- */
  315.  
  316. @  0,0 DCTABPAGE oTabPage4 CAPTION 'Graphics' ;
  317.    RELATIVE oTabPage3 ;
  318.    STATICAREA oTabPageArea4 ;
  319.    MESSAGE 'This Tab Page displays graphics stuff using DCGRA* commands'
  320.  
  321. @ .5,3 DCGRASTRING ;
  322.        {'DCGRA* commands are useful when creating dialogs that require', ;
  323.         'a lot of text, images, lines, boxes or other graphic primitives.', ;
  324.         'These commands automatically handle locking of presentation space', ;
  325.         'and repainting of the graphic area' } ;
  326.        FONT '12.Arial Bold Italic' COLOR GRA_CLR_BLUE ROWSPACE 18 ;
  327.        PARENT oTabPageArea4
  328.  
  329. @ 5,4 TO 10,76 DCGRABOX FILL GRA_OUTLINEFILL COLOR GRA_CLR_YELLOW ;
  330.        PARENT oTabPageArea4
  331.  
  332. @ 6.2,15 DCGRAPROC {|o,c,r|_BitMaps(o,c,r)} PARENT oTabPageArea4
  333.  
  334. FOR i := 1 TO 15
  335.   @ 10.5, i*4 TO 13.5, i*4 DCGRALINE COLOR i PARENT oTabPageArea4
  336.   @ 10.3 + (.22*i),4 TO 10.3 + (.22*i),56 DCGRALINE COLOR i PARENT oTabPageArea4
  337. NEXT
  338.  
  339. /* ---- Tab Page #5 ---- */
  340.  
  341. @  0,0 DCTABPAGE oTabPage5 CAPTION 'ClipBoard' ;
  342.    RELATIVE oTabPage4 ;
  343.    MESSAGE 'This Tab Page demonstrates the ClipBoard Monitor'
  344.  
  345. @  1.5,10 DCSAY 'Images captured to the Clipboard by any Windows program' ;
  346.         PARENT oTabPage5 SAYSIZE 50
  347.  
  348. @  2.2,10 DCSAY 'will be displayed below and saved in IMAGES.DBF.' ;
  349.         PARENT oTabPage5 SAYSIZE 50
  350.  
  351. @  4,10 DCSTATIC XBPSTATIC_TYPE_RAISEDBOX SIZE 50,10 ;
  352.    OBJECT oClipPhoto PARENT oTabPage5
  353.  
  354. bTimerEvent := {|| MonitorClipBoard( aLocals )}
  355.  
  356. cBitMap1 := BITMAP_EXPRESS
  357. DCBITMAP cBitMap1 PARENT oClipPhoto AUTOSCALE ;
  358.    OBJECT oBitMap1 EVAL {||SetTimerEvent( 100, bTimerEvent) }
  359.  
  360. lPlayBack := .f.
  361.  
  362. @ 4,65 DCPUSHBUTTON OBJECT oButton1 CAPTION 'PlayBack' SIZE 9,2 ;
  363.        PARENT oTabPage5 ;
  364.        TOOLTIP 'Play Back all BitMaps in IMAGES.DBF' ;
  365.        ACTION {||lPlayBack := .t., DisplayImages(aLocals) }
  366.  
  367. @ 7,65 DCPUSHBUTTON OBJECT oButton1 CAPTION 'Stop' SIZE 9,2 ;
  368.        PARENT oTabPage5 ;
  369.        TOOLTIP 'Stop the Play Back' ;
  370.        ACTION {||lPlayBack := .f.}
  371.  
  372. /* ---- Tab Page #6 ---- */
  373.  
  374. @  0,0 DCTABPAGE oTabPage6 CAPTION 'Pointer' ;
  375.    RELATIVE oTabPage5 ;
  376.    MESSAGE 'This Tab Page demonstrates Pointer (Cursor) Types'
  377.  
  378. @ 2,2 DCSAY 'Cursor type POINTER_ARROW_1' CURSOR POINTER_ARROW_1 ;
  379.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  380.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  381.  
  382. @ 4,2 DCSAY 'Cursor type POINTER_BEAM_1'  CURSOR POINTER_BEAM_1 ;
  383.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  384.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  385.  
  386. @ 6,2 DCSAY 'Cursor type POINTER_MOVE_1'  CURSOR POINTER_MOVE_1 ;
  387.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  388.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  389.  
  390. @ 8,2 DCSAY 'Cursor type POINTER_NO_1'  CURSOR POINTER_NO_1 ;
  391.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  392.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  393.  
  394. @10,2 DCSAY 'Cursor type POINTER_PEN_1'  CURSOR POINTER_PEN_1 ;
  395.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  396.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  397.  
  398. @12,2 DCSAY 'Cursor type POINTER_SIZE1_1'  CURSOR POINTER_SIZE1_1 ;
  399.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  400.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  401.  
  402. @ 2,40 DCSAY 'Cursor type POINTER_SIZE2_1'  CURSOR POINTER_SIZE2_1 ;
  403.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  404.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  405.  
  406. @ 4,40 DCSAY 'Cursor type POINTER_SIZE3_1'  CURSOR POINTER_SIZE3_1 ;
  407.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  408.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  409.  
  410. @ 6,40 DCSAY 'Cursor type POINTER_SIZE4_1'  CURSOR POINTER_SIZE4_1 ;
  411.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  412.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  413.  
  414. @ 8,40 DCSAY 'Cursor type POINTER_CROSS_1'  CURSOR POINTER_CROSS_1 ;
  415.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  416.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  417.  
  418. @10,40 DCSAY 'Cursor type POINTER_BUSY_1'  ;
  419.       CURSOR { nil, POINTER_BUSY_1, nil } ;
  420.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  421.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  422.  
  423. @12,40 DCSAY 'Cursor type POINTER_WAIT_1'  CURSOR POINTER_WAIT_1 ;
  424.       PARENT oTabPage6 SAYSIZE 35 FONT '10.Helv' ;
  425.       COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE
  426.  
  427. /* ---- Tab Page #7 ---- */
  428.  
  429. @  0,0 DCTABPAGE oTabPage7 CAPTION 'PickList' ;
  430.    RELATIVE oTabPage6 ;
  431.    MESSAGE 'This Tab Page Displays a Field Pick-List Example with a Browse'
  432.  
  433. IF Select('COLLECT') = 0
  434.   USE COLLECT VIA DBFNTX NEW SHARED
  435. ELSE
  436.   dbSelectArea('COLLECT')
  437. ENDIF
  438.  
  439. cAlias := 'COLLECT'
  440. aListField := Array(FCount())
  441. AFields(aListField)
  442.  
  443. @ 2,3 DCPICKLIST aPickField LIST aListField ;
  444.    CAPTION "Available Fields", "Selected Fields" ;
  445.    FONT '8.Courier' ;
  446.    SIZE 35,12 ;
  447.    PARENT oTabPage7 ;
  448.    DATALINK {||BrowseCollect(aLocals)}
  449.  
  450. /* ---- Tab Page #8 ---- */
  451.  
  452. @  0,0 DCTABPAGE oTabPage8 CAPTION 'Source' ;
  453.    RELATIVE oTabPage7 ;
  454.    MESSAGE 'This Tab Page Displays the Source Code for this Dialog'
  455.  
  456. cSource := MemoRead('XDEMO3.PRG')
  457. IF Empty(cSource)
  458.   cSource := MemoRead('..\PRG\XDEMO3.PRG')
  459. ENDIF
  460. IF Empty(cSource)
  461.   cSource := 'XDEMO3.PRG cannot be found'
  462. ENDIF
  463. @  1.4,1 DCMULTILINE cSource PARENT oTabPage8 SIZE 81,14 ;
  464.    FONT "8.Alaska Crt" EDITPROTECT {||.t.}
  465.  
  466.  
  467. /* ---- Tool Bar ---- */
  468.  
  469. @ .1,.2 DCTOOLBAR oToolBar SIZE 9,1 BUTTONSIZE 9,1
  470.  
  471. DCADDBUTTON CAPTION 'Exit' PARENT oToolBar ;
  472.    ACTION {||DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)}
  473.  
  474. /* ---- Message Box ---- */
  475.  
  476. @ 18,1 DCMESSAGEBOX OBJECT oMsgBox FONT "8.Courier New" ;
  477.   SIZE 70 COLOR GRA_CLR_GREEN, GRA_CLR_WHITE
  478.  
  479. DCGETOPTIONS ;
  480.    NOBUSY ;
  481.    CASCADE ;
  482.    SAYWIDTH 100 ;
  483.    HELPFILE '..\DOC\EXPRESS.HLP'
  484.  
  485. RETURN nil
  486.  
  487. /* ------------------- */
  488.  
  489. STATIC PROCEDURE _Sort ( aArray, nColumn )
  490.  
  491. ASort( aArray,,,{|x,y|x[nColumn] < y[nColumn]} )
  492.  
  493. RETURN
  494.  
  495. /* ------------------- */
  496.  
  497. STATIC PROCEDURE MonitorClipBoard( aLocals )
  498.  
  499. LOCAL oBitMap, aFormats, oClipBoard
  500.  
  501. // Open clipboard and determine the data formats contained in it
  502. oClipBoard := XbpClipBoard():new():Create()
  503. oClipBoard:open()
  504. aFormats := oClipBoard:queryFormats()
  505. IF AScan( aFormats, XBPCLPBRD_BITMAP ) > 0
  506.   oBitMap := oClipBoard:getBuffer( XBPCLPBRD_BITMAP )
  507.   oClipBoard:clear()
  508.   IF !File('IMAGES.DBF')
  509.     dBCreate( 'IMAGES', ;
  510.               { { 'BITMAP','V',4,0 }, ;
  511.                 { 'DESC','C',30,0 } }, 'FOXCDX' )
  512.   ENDIF
  513.   USE images NEW VIA foxcdx
  514.   AddRec()
  515.   REPL IMAGES->bitmap WITH oBitMap:setBuffer(), ;
  516.        IMAGES->desc WITH 'Image Number ' + Alltrim(Str(RecNo()))
  517.  
  518.   oBitMap:SetBuffer(oBitMap:SetBuffer())
  519.   DC_BitMapDraw( oClipPhoto, oBitMap )
  520.   CLOSE
  521. ENDIF
  522. oClipBoard:close()
  523. oClipBoard:Destroy()
  524. RETURN
  525.  
  526. /* ------------------- */
  527.  
  528. STATIC PROCEDURE DisplayImages( aLocals )
  529.  
  530. LOCAL nSeconds, lClearBox := .t., nSaveArea := Select(), cBmpDb, cAlaskaDrive
  531.  
  532. SetAppFocus(oTabPage5)
  533. SetAppFocus(oClipPhoto)
  534. IF !File('IMAGES.DBF')
  535.   dBCreate( 'IMAGES', ;
  536.             { { 'BITMAP','V',4,0 }, ;
  537.               { 'DESC','C',30,0 } }, 'FOXCDX' )
  538. ENDIF
  539. USE images NEW VIA foxcdx
  540. DO WHILE lPlayBack .AND. !Eof()
  541.   SetAppFocus()
  542.   oBitMap1:SetBuffer(IMAGES->bitmap)
  543.   DC_BitMapDraw( oClipPhoto, oBitMap1 )
  544.   Sleep(10)
  545.   SKIP
  546. ENDDO
  547. CLOSE
  548.  
  549. IF !lPlayBack
  550.   SELE (nSaveArea)
  551.   RETURN
  552. ENDIF
  553.  
  554. cBmpDb := 'C:\ALASKA\XPPW32\SOURCE\SAMPLES\DATA\BMPDB.DBF'
  555. IF !File(cBmpDb)
  556.   cAlaskaDrive := SubStr(GetEnv('XPPRESOURCE'),1,2)
  557.   cBmpDb := Strtran(cBmpDb,'C:',cAlaskaDrive)
  558. ENDIF
  559. IF File(cBmpDb)
  560.   USE (cBmpDb) NEW VIA foxcdx
  561.   DO WHILE lPlayBack .AND. SetAppFocus():ClassName()='XbpStatic'
  562.     DC_AppEvent( @lPlayBack, 0, .01 )
  563.     oBitMap1:setBuffer(FIELD->BITMAP,XBPBMP_FORMAT_WIN3X)
  564.     DC_BitMapDraw( oClipPhoto, oBitMap1, lClearBox )
  565.     lClearBox := .f.
  566.     IF Eof()
  567.       DbGoTop()
  568.     ELSE
  569.       DbSkip(1)
  570.     ENDIF
  571.     Sleep(.4)
  572.   ENDDO
  573.   CLOSE
  574. ENDIF
  575.  
  576. SELE (nSaveArea)
  577.  
  578. RETURN
  579.  
  580. /* ---- Custom Class ----------------- */
  581.  
  582. CLASS XbpBanner FROM XbpStatic
  583.  
  584.    EXPORTED:
  585.  
  586.    VAR    ScrollMouseCol          // Last Scroll Mouse Column
  587.    VAR    ScrollType              // Scroll Type
  588.    VAR    ScrollPos               // Scroll Position
  589.    VAR    ScrollCaption           // Scroll Caption
  590.    VAR    ScrollNum               // Scroll number
  591.  
  592.    METHOD Init, Create
  593.    METHOD Scroll
  594.  
  595. ENDCLASS
  596.  
  597. /* ------------------- */
  598.  
  599. METHOD XbpBanner:Create( oParent, oOwner, aPos, aSize, aPP, lVisible )
  600.  
  601. ::XbpStatic:Create( oParent, oOwner, aPos, aSize, aPP, lVisible )
  602.  
  603. RETURN self
  604.  
  605. /* --------------------- */
  606.  
  607. METHOD XbpBanner:Init( oParent, oOwner, aPos, aSize, aPP, lVisible )
  608.  
  609. DEFAULT aPP := {}
  610.  
  611. * initialize base class
  612. ::XbpStatic:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
  613.  
  614. ::scrollPos       := 1
  615. ::scrollType      := 1
  616. ::scrollCaption   := ''
  617. ::scrollMouseCol  := 0
  618. ::scrollNum       := 3
  619. ::motion := { | aPos | ::Scroll( aPos[1] ) }
  620.  
  621. RETURN self
  622.  
  623. /* --------------------- */
  624.  
  625. METHOD XbpBanner:Scroll( nMouseCol )
  626.  
  627. ::SetCaption( Substr(::scrollCaption,::scrollPos) )
  628. IF nMouseCol > ::scrollMouseCol .AND. ::scrollPos < Len(::scrollCaption)-15
  629.   ::scrollPos += ::scrollNum
  630.   ELSEIF nMouseCol < ::scrollMouseCol .AND. ::scrollPos > 1
  631.   ::scrollPos -= ::scrollNum
  632. ENDIF
  633. ::scrollMouseCol := nMouseCol
  634. RETURN self
  635.  
  636. /* --------------------- */
  637.  
  638. STATIC FUNCTION DemoBanner ( aParams, aLocals )
  639.  
  640. LOCAL oXbp, GetList, nGetPointer, oParent, aPos, aSize, aPres, lVisible
  641.  
  642. GetList     := aParams[1]
  643. nGetPointer := aParams[2]
  644. oParent     := aParams[3]
  645. aPos        := aParams[4]
  646. aSize       := aParams[5]
  647. aPres       := aParams[6]
  648. lVisible    := aParams[7]
  649.  
  650. oXbp := XbpBanner():new( oParent, , aPos, aSize, aPres, lVisible, ;
  651.                          GetList, nGetPointer )
  652.  
  653. oXbp:scrollType    := Getlist[nGetPointer,nGETLIST_SUBTYPE]
  654. oXbp:scrollCaption := GetList[nGetPointer,cGETLIST_CAPTION]
  655. oXbp:scrollNum     := 10
  656. IF !Empty(Getlist[nGetPointer,cGETLIST_FONT])
  657.   oXbp:SetFontCompoundName( Getlist[nGetPointer,cGETLIST_FONT] )
  658. ENDIF
  659. oXbp:clipSiblings := .T.
  660. oXbp:caption := oXbp:scrollCaption
  661. oXbp:create()
  662. RETURN oXbp
  663.  
  664. /* --------------------- */
  665.  
  666. STATIC PROCEDURE RGB( aLocals )
  667.  
  668. LOCAL aAttr := Array(GRA_AA_COUNT)        // area attributes
  669. LOCAL nMax, aOldAttr, aOldRGB
  670.  
  671. oPS   := oColorBox:LockPS()
  672. nMax  := 255 // oPS:maxColorIndex()  // max colors
  673.  
  674. // Set new RGB color and draw box
  675. aAttr[ GRA_AA_COLOR  ] := nMax
  676. aOldAttr := oPS:setAttrArea( aAttr )
  677. aOldRGB  := oPS:setColorIndex( nMax, {nRed,nGreen,nBlue} )
  678. GraBox( oPS, {0,0}, {400,400}, GRA_FILL )
  679. oPS:setAttrArea( aOldAttr )
  680. oPS:setColorIndex( nMax, aOldRGB )
  681. oColorBox:unlockPS( oPS )
  682.  
  683. RETURN
  684.  
  685. /* -------------------- */
  686.  
  687. STATIC FUNCTION AddRec ( nWaitTime )
  688.  
  689. LOCAL nWait
  690.  
  691. APPEND BLANK
  692. IF !NETERR()
  693.    RETURN (.T.)
  694. ENDIF
  695. DO WHILE .T.
  696.   nWait := nWaitTime
  697.   DO WHILE (nWaitTime = 0 .OR. nWait > 0)
  698.     APPEND BLANK
  699.     IF .NOT. NETERR()
  700.       RETURN .T.
  701.     ENDIF
  702.     nWait  :=  nWait - .5
  703.   ENDDO
  704. ENDDO
  705. RETURN .F.
  706.  
  707. /* --------------------- */
  708.  
  709. STATIC FUNCTION BrowseCollect ( aLocals )
  710.  
  711. LOCAL GetList := {}, i, aChildList
  712.  
  713. IF Valtype(oBrowse) = 'O'
  714.   aChildList := oBrowse:ChildList()
  715.   FOR i := 1 TO Len(aChildList)
  716.     aChildList[i]:Destroy()
  717.   NEXT
  718.   oBrowse:Destroy()
  719. ENDIF
  720.  
  721. oBrowse := nil
  722.  
  723. IF Empty(aPickField)
  724.   RETURN nil
  725. ENDIF
  726.  
  727. @ 2,40 DCBROWSE oBrowse DATA cAlias SIZE 43,12 PARENT oTabPage7 ;
  728.        PRESENTATION DC_BrowPres()
  729.  
  730. SELECT collect
  731. FOR i := 1 TO Len(aPickField)
  732.   DCBROWSECOL DATA &('{||COLLECT->'+aPickField[i]+'}') ;
  733.   HEADER aPickField[i] PARENT oBrowse
  734. NEXT
  735.  
  736. DCREAD GUI PARENT oTabPage7 EXIT
  737. oBrowse:Hide()
  738. oBrowse:Show()
  739.  
  740. SetAppFocus( oTabPage7 )
  741.  
  742. RETURN nil
  743.  
  744. /* --------------------- */
  745.  
  746. STATIC FUNCTION _TestProgress ( aLocals )
  747.  
  748. LOCAL nCount := 0
  749.  
  750. DO WHILE lDialogActive
  751.   Sleep(100)
  752.   IF oProgress:status()=XBP_STAT_CREATE
  753.     DC_GetProgress( oProgress, nCount )
  754.   ENDIF
  755.   nCount++
  756.   IF nCount = 100
  757.     nCount := 0
  758.   ENDIF
  759. ENDDO
  760.  
  761. RETURN nil
  762.  
  763. /* -------------------- */
  764.  
  765. STATIC FUNCTION _Bitmaps( oPresSpace, nCol, nRow )
  766.  
  767. LOCAL aTarget, aSource, oBitMap, nResource, i, nSaveCol
  768.  
  769. nSaveCol := nCol
  770.  
  771. FOR nResource := 7110 TO 7119
  772.   oBitMap := XbpBitMap():new():create(oPresSpace)
  773.   oBitMap:load( NIL, nResource )
  774.   aTarget := {nCol,nRow,nCol+oBitmap:xSize,nRow+oBitmap:ySize}
  775.   aSource := {0,0,oBitmap:xSize,oBitmap:ySize}
  776.   nCol += oBitmap:xSize + 5
  777.   IF nResource = 7114
  778.     nRow -= 40
  779.     nCol := nSaveCol
  780.   ENDIF
  781.   oBitmap:draw( oPresSpace, aTarget, aSource, , GRA_BLT_BBO_IGNORE )
  782.   oBitmap:destroy()
  783. NEXT
  784.  
  785. RETURN nil
  786.  
  787.  
  788.