home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2002 June
/
PCWorld_2002-06_cd.bin
/
Software
/
Komercni
/
xbase
/
express
/
exd17208.r04
/
exp17
/
Samples
/
Xsample5.prg
< prev
next >
Wrap
Text File
|
2002-01-30
|
53KB
|
2,080 lines
*-- PROGRAM FILE -------------------------------------------------------------
* Application: eXPress++ Library
* Description: eXPress++ sample programs
* File Name: xsample5.prg
* Author: Roger Donnay Tester:
* Date created: 09/03/00 Date updated: 11/07/2001
* Copyright: (c) 2001 by DONNAY Software Designs
*-----------------------------------------------------------------------------
#include "DCDIALOG.CH"
#include "SET.CH"
#include "XBP.CH"
#include "APPEVENT.CH"
#INCLUDE "inkey.CH"
#INCLUDE "dcicon.CH"
#INCLUDE "dcgrump.ch"
#INCLUDE "dcbitmap.ch"
#INCLUDE "dcgra.ch"
#include "dcfields.ch"
#INCLUDE "dccursor.CH"
#INCLUDE "dcprint.CH"
#include "font.ch"
#define CRLF Chr(13) + Chr(10)
FIELD areacode, exchange, number
FUNCTION X_Samples_5( oDialog )
LOCAL GetList := {}, nTest := 0, cMemo := '', oMemo, i, j, oDlg, ;
lDebugCreate := .f., lDebugEvent := .f., GetOptions, aApp[1], ;
cTitle, oDlgWindow, aCoords, oSourceFile, cSource
SET DEFA TO
SET PATH TO ..\DATA
cTitle := 'eXPress++ Sample Programs (Set 5)'
nTest := 0
cMemo := ''
lDebugEvent := .f.
lDebugCreate := .f.
FOR i := 1 TO 5
FOR j := 1 TO 6
nTest++
@ j-1,1 + (i-1)*14 DCRADIO nTest ;
VALUE nTest ;
PROMPT XSample_Header(nTest) ;
ACTION {||XSample_Memo(nTest,oMemo,oSourceFile,@cSource)} ;
COLOR XSample_Color(nTest)
NEXT j
NEXT i
nTest := 1
@ 2,73 DCPUSHBUTTON CAPTION 'Run Sample' ;
SIZE 12, 1 ;
ACTION {||XSample_Run(nTest,oDialog,lDebugCreate,lDebugEvent,GetList,GetOptions)}
@ 3,73 DCPUSHBUTTON CAPTION 'Print Source' ;
SIZE 12, 1 ;
ACTION {||XSample_Print(cSource)}
@ 4,73 DCPUSHBUTTON CAPTION 'Exit' ;
SIZE 12, 1 ;
ACTION {||PostAppEvent(xbeP_Close,,,oDlg)}
@ 5,73 DCCHECKBOX lDebugEvent PROMPT 'Debug Events'
@ 6.3,5 DCSAY '' SAYSIZE 60 COLOR GRA_CLR_DARKBLUE ;
OBJECT oSourceFile FONT '8.Courier Bold'
@ 7,1 DCMULTILINE cMemo ;
OBJECT oMemo ;
SIZE 85,12 ;
FONT '8.Alaska Crt'
DCGETOPTIONS ;
ICON ICON_EXPRESS ;
NOBUSY ;
CASCADE
DCREAD GUI ;
OPTIONS GetOptions ;
EVAL {||XSample_Memo(nTest,oMemo,oSourceFile,@cSource)} ;
APPWINDOW oDialog ;
PARENT @oDlg ;
TITLE cTitle ;
FIT
CLOSE DATABASES
RETURN nil
* ---------------------------- *
STATIC FUNCTION XSample_Memo( nTest, oMemo, oSourceFile, cSource )
LOCAL cFunction, nFound, cSourceFile
cSource := ''
nTest += 132
cFunction := 'XSample_' + Alltrim(Str(nTest))
cSourceFile := 'XSAMPLE5.PRG'
cSource := MemoRead(cSourceFile)
IF Empty(cSource)
cSourceFile := '..\PRG\XSAMPLE5.PRG'
cSource := MemoRead(cSourceFile)
ENDIF
IF Empty(cSource)
cSource := 'XSAMPLE5.PRG cannot be found'
ENDIF
nFound := AT('FUNCTION ' + cFunction,cSource)
cSource := Substr(cSource,nFound)
nFound := AT('*** END OF EXAMPLE ***',cSource)
cSource := Substr(cSource,1,nFound+21)
IF !Empty(cSource)
oMemo:setData(cSource)
oSourceFile:setCaption(cSourceFile)
ENDIF
RETURN nil
* -------------------
STATIC FUNCTION XSample_Print( cSource )
LOCAL oPrinter, nLineCount := MLCount(cSource), i, cMemoLine, nRow
DCPRINT ON TO oPrinter PREVIEW FONT '10.Courier' NONSTOP HIDE
IF Valtype(oPrinter) # 'O' .OR. !oPrinter:lActive
RETURN nil
ENDIF
nRow := 1
FOR i := 1 TO nLineCount - 1
cMemoLine := MemoLine( cSource, nil, i )
@ nRow++,2 DCPRINT SAY cMemoLine PRINTER oPrinter
IF nRow > 60
DCPRINT EJECT
nRow := 1
ENDIF
NEXT
DCPRINT OFF
RETURN nil
* ---------------------------- *
STATIC FUNCTION XSample_Run( nTest, oDialog, lDebugCreate, lDebugEvent, ;
GetList, GetOptions )
LOCAL nDebug := 0, lVer20, lVer15, lVer17, oThread
#ifdef EXPRESS20
lVer20 := .t.
#else
lVer20 := .f.
#endif
#ifdef EXPRESS17
lVer17 := .t.
#else
lVer17 := .f.
#endif
#ifdef EXPRESS15
lVer15 := .t.
#else
lVer15 := .f.
#endif
DC_Gui(.t.)
nTest += 132
IF lDebugCreate
nDebug += DCGUI_DEBUG_CREATE
ENDIF
IF lDebugEvent
nDebug += DCGUI_DEBUG_EVENTS
ENDIF
DC_ReadGuiDebug(nDebug)
CLOSE ALL
SET DEFA TO
IF nTest = 133
XSample_133()
ELSEIF nTest = 134 .AND. ( lVer15 .OR. lVer17 .OR. lVer20 )
XSample_134()
ELSEIF nTest = 135
XSample_135()
ELSEIF nTest = 136 .AND. ( lVer15 .OR. lVer17 .OR. lVer20 )
XSample_136()
ELSEIF nTest = 137 .AND. lVer20
XSample_137()
ELSEIF nTest = 138 .AND. lVer20
XSample_138()
ELSEIF nTest = 139 .AND. lVer20
XSample_139()
ELSEIF nTest = 140 .AND. lVer20
XSample_140()
ELSEIF nTest = 141 .AND. lVer20
XSample_141()
ELSEIF nTest = 142 .AND. lVer20
XSample_142()
ELSEIF nTest = 143
XSample_143()
ELSEIF nTest = 144
XSample_144()
ELSEIF nTest = 145 .AND. ( lVer15 .OR. lVer20 )
XSample_145()
ELSEIF nTest = 146 .AND. lVer20
XSample_146()
ELSEIF nTest = 147 .AND. lVer20
XSample_147(GetList)
ELSEIF nTest = 148 .AND. lVer20
XSample_148(GetList)
ELSEIF nTest = 149 .AND. lVer20
XSample_149()
ELSEIF nTest = 150
XSample_150()
ELSEIF nTest = 151
XSample_151()
ELSEIF nTest = 152
XSample_152()
ELSEIF nTest = 153
XSample_153()
ELSEIF nTest = 154
XSample_154()
ELSEIF nTest = 155
XSample_155()
ELSEIF nTest = 156
XSample_156()
ELSEIF nTest = 157
XSample_157()
ELSEIF nTest = 158
XSample_158()
ELSEIF nTest = 159 .AND. ( lVer17 .OR. lVer20 )
XSample_159()
ELSEIF nTest = 160
XSample_160()
ELSEIF nTest = 161
XSample_161()
ELSEIF nTest = 162
XSample_162()
ELSE
DC_WinAlert('This sample is available under eXPress++ 2.0 or later')
ENDIF
DC_ClearEvents()
RETURN nil
* ---------------------------- *
STATIC FUNCTION XSample_Header( nTest )
nTest += 132
IF nTest = 133
RETURN "MergeGets 1"
ELSEIF nTest = 134
RETURN "RGBColors"
ELSEIF nTest = 135
RETURN "PresEditor"
ELSEIF nTest = 136
RETURN "ColorPicker"
ELSEIF nTest = 137
RETURN "Stack"
ELSEIF nTest = 138
RETURN "FileGroup 1"
ELSEIF nTest = 139
RETURN "FileGroup 2"
ELSEIF nTest = 140
RETURN "FieldGroup 1"
ELSEIF nTest = 141
RETURN "FieldGroup 2"
ELSEIF nTest = 142
RETURN "CodeTables"
ELSEIF nTest = 143
RETURN "DragDrop 2"
ELSEIF nTest = 144
RETURN "MergeGets 2"
ELSEIF nTest = 145
RETURN "WHENColor"
ELSEIF nTest = 146
RETURN "QueryWizard"
ELSEIF nTest = 147
RETURN "GetSource 1"
ELSEIF nTest = 148
RETURN "GetSource 2"
ELSEIF nTest = 149
RETURN "DBU"
ELSEIF nTest = 150
RETURN "PrintScreen"
ELSEIF nTest = 151
RETURN "GRASTRING"
ELSEIF nTest = 152
RETURN "DataToolTips"
ELSEIF nTest = 153
RETURN "RJustGets"
ELSEIF nTest = 154
RETURN "RJustPrint"
ELSEIF nTest = 155
RETURN "DynamicAddr"
ELSEIF nTest = 156
RETURN "MessageInto"
ELSEIF nTest = 157
RETURN 'MoveColumn'
ELSEIF nTest = 158
RETURN 'DropBrowse'
ELSEIF nTest = 159
RETURN 'StaticButton'
ELSEIF nTest = 160
RETURN 'Ascend/Descend'
ELSEIF nTest = 161
RETURN 'Print Align'
ELSEIF nTest = 162
RETURN 'Print Buttons'
ENDIF
RETURN ''
* ---------------------------- *
STATIC FUNCTION XSample_Color( nTest )
LOCAL lVer20
#ifdef EXPRESS20
lVer20 := .t.
#else
lVer20 := .f.
#endif
IF lVer20
RETURN GRA_CLR_BLACK
ENDIF
nTest += 132
IF nTest >= 137 .AND. ;
AScan({144,150,151,152,153,154,155,156,157,158,159,160,161,162},nTest) == 0
RETURN GRA_CLR_DARKGRAY
ENDIF
RETURN GRA_CLR_BLACK
* -----------------
STATIC FUNCTION XSample_133()
/* This example shows how to merge to dialogs into one
with a common GetList and a single event loop */
LOCAL GetList := {}, aGetList1, aGetList2, dDate1 := Date(), ;
dDate2 := Date() + 2, cName1 := Space(10), cName2 := Space(10), ;
oDlg1, oDlg2
@ 0,0 DCSAY 'Enter Date 1' GET dDate1 ;
GETTOOLTIP 'Enter a Valid Start Date'
@ 1,0 DCSAY 'Enter Date 2' GET dDate2 ;
GETTOOLTIP 'Enter a Valid End Date'
DCREAD GUI FIT ADDBUTTONS EXIT PARENT @oDlg1 SAVE ;
TITLE 'Enter Date Information'
aGetList1 := GetList
GetList := {}
@ 0,0 DCSAY 'Enter Name 1' GET cName1 ;
GETTOOLTIP 'Enter a Valid Start Name'
@ 1,0 DCSAY 'Enter Name 2' GET cName2 ;
GETTOOLTIP 'Enter a Valid End Name'
DCREAD GUI FIT EXIT PARENT @oDlg2 SAVE ;
TITLE 'Enter Name Information'
oDlg2:setPos( { oDlg1:currentPos()[1], ;
oDlg1:currentPos()[2] + oDlg1:currentSize()[2]} )
aGetList2 := GetList
GetList := DC_MergeGetLists( aGetList1, aGetList2 )
DC_ReadGuiEventLoop( GetList )
oDlg1:destroy()
oDlg2:destroy()
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_134()
/* This example shows how to use RGB colors in dialogs. */
LOCAL GetList := {}
@ 0,0 DCPUSHBUTTON CAPTION 'RGB Test (DCSAY)' SIZE 30,2 ;
ACTION {||RGBSayTest()}
@ 3,0 DCPUSHBUTTON CAPTION 'RGB Test (DCGRASTRING)' SIZE 30,2 ;
ACTION {||RGBGraTest()}
DCREAD GUI FIT BUTTONS DCGUI_BUTTON_EXIT TITLE 'RGB Tests'
RETURN nil
* -------------
STATIC FUNCTION RGBSayTest()
LOCAL GetList := {}, nRow, nCol, nRed, nGreen, nBlue
nRow := 0
nCol := 0
FOR nRed := 0 TO 255 STEP 55
FOR nGreen := 0 TO 255 STEP 55
FOR nBlue := 0 TO 255 STEP 55
@ nRow, nCol ;
DCSAY Strtran(Str(nRed,3)+'/'+Str(nGreen,3)+'/'+Str(nBlue,3),' ','0') ;
COLOR {nRed,nGreen,nBlue}
nCol += 11
IF nCol > 70
nCol := 0
nRow++
ENDIF
NEXT
NEXT
NEXT
@ nRow, nCol DCSAY '255/255/255' COLOR {255,255,255}
DCREAD GUI FIT TITLE 'RGB Color Test (DCSAY)' CLEAREVENTS
RETURN nil
* -------------------
STATIC FUNCTION RGBGraTest()
LOCAL GetList := {}, nRow, nCol, nRed, nGreen, nBlue
nRow := 1
nCol := 0
@ 0,0 DCSAY ''
FOR nRed := 0 TO 255 STEP 55
FOR nGreen := 0 TO 255 STEP 55
FOR nBlue := 0 TO 255 STEP 55
@ nRow, nCol ;
DCGRASTRING Strtran(Str(nRed,3)+'/'+Str(nGreen,3)+'/'+Str(nBlue,3),' ','0') ;
COLOR {nRed,nGreen,nBlue}
nCol += 11
IF nCol > 70
nCol := 0
nRow++
ENDIF
NEXT
NEXT
NEXT
@ nRow, nCol DCGRASTRING '255/255/255' COLOR {255,255,255}
@ nRow, nCol + 8 DCSAY ''
DCREAD GUI FIT CLEAREVENTS MODAL ;
TITLE 'RGB Color Test (DCGRASTRING)'
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_135()
/* This example shows how to use the presentation Parameters
editor to selection PP options */
LOCAL GetList := {}, aPres, aDir := Directory(), oBrowse, GetOptions
aPres := DC_PresEdit(DC_BrowPres())
@ 0,0 DCBROWSE oBrowse SIZE 50,10 DATA aDir PRESENTATION aPres
DCBROWSECOL ELEMENT 1 PARENT oBrowse HEADER 'File Name' WIDTH 10
DCBROWSECOL ELEMENT 2 PARENT oBrowse HEADER 'File Size' WIDTH 10
DCBROWSECOL ELEMENT 3 PARENT oBrowse HEADER 'File Date' WIDTH 10
DCBROWSECOL ELEMENT 4 PARENT oBrowse HEADER 'File Time' WIDTH 10
DCGETOPTIONS PRESENTATION aPres
DCREAD GUI FIT ADDBUTTONS MODAL OPTIONS GetOptions ;
TITLE 'Presentation Example'
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_136()
/* This example shows how to use the RGB Color Picker */
LOCAL GetList := {}, aRGBColor, GetOptions, oSay
aRGBColor := { {0,0,0}, {0,0,0} }
SET WRAP ON
@ 0,0 DCSAY 'Red Foreground' GET aRGBColor[1,1] RANGE 0,255
@ 1,0 DCSAY 'Green Foreground' GET aRGBColor[1,2] RANGE 0,255
@ 2,0 DCSAY 'Blue Foreground' GET aRGBColor[1,3] RANGE 0,255
@ 4,0 DCSAY 'Red Background' GET aRGBColor[2,1] RANGE 0,255
@ 5,0 DCSAY 'Green Background' GET aRGBColor[2,2] RANGE 0,255
@ 6,0 DCSAY 'Blue Background' GET aRGBColor[2,3] RANGE 0,255
@ 8,0 DCPUSHBUTTON CAPTION 'Color Picker' SIZE 12,1.2 ;
ACTION {|a|a := DC_PopColor(aRGBColor,0,.t.), ;
aRGBColor[1,1] := a[1,1], ;
aRGBColor[1,2] := a[1,2], ;
aRGBColor[1,3] := a[1,3], ;
aRGBColor[2,1] := a[2,1], ;
aRGBColor[2,2] := a[2,2], ;
aRGBColor[2,3] := a[2,3], ;
DC_GetRefresh(GetList) }
@11,0 DCSAY 'Compound Color' SAYSIZE 0 FONT '14.Arial Bold' ;
OBJECT oSay ;
WHEN {|o|o:setColorFG(GraMakeRGBColor(aRGBColor[1])), ;
o:setColorBG(GraMakeRGBColor(aRGBColor[2])), ;
.t.}
DCGETOPTIONS SAYRIGHT SAYWIDTH 120
DCREAD GUI FIT ADDBUTTONS MODAL TITLE 'RGB Color Picker' ;
OPTIONS GetOptions EVAL {|o|SetAppWindow(o)}
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_137()
/* This example shows how the function DC_CallStack() is
integrated to work with your own editor */
LOCAL GetList := {}, GetOptions
@ 1,0 DCSAY 'When you click on "Call Stack", the source for this program will be'
@ 2,0 DCSAY 'compiled into an .OBJ file. In normal debugging situations, your'
@ 3,0 DCSAY '.OBJ files will already exist. A Call Stack window will be displayed.'
@ 5,0 DCSAY 'When the Call Stack is displayed, click on any function that starts'
@ 6,0 DCSAY 'with an X. This will create a file named DCPUBLIC.TXT from all the'
@ 7,0 DCSAY '.OBJ files in the current directory and find the name of the .OBJ'
@ 8,0 DCSAY 'that contains the selected function. The .OBJ will then be scanned'
@ 9,0 DCSAY 'to find the full-path name of the associated .PRG, then your editor'
@10,0 DCSAY 'will be called with the name of the .PRG and the line number.'
@12,0 DCPUSHBUTTON CAPTION 'Call Stack' SIZE 12,2 ;
ACTION {||DC_Compile('XSAMPLE8'),DC_CallStack()}
DCGETOPTIONS SAYFONT '10.Arial' SAYWIDTH 0
DCREAD GUI FIT ADDBUTTONS MODAL TITLE 'Call Stack' ;
EVAL {|o|SetAppWindow(o)} ;
OPTIONS GetOptions
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
FUNCTION XSample_138()
/* This example shows how to use the File Dictionary to
open databases and indexes, set relations, etc.
This example opens the MYSTUFF file group */
DC_FileRest('MYSTUFF')
DC_WorkTree()
CLOSE ALL
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_139()
/* This example opens a user-specified file group
and displays a work area tree or a browse */
LOCAL GetList := {}, cFileGroup := Space(10)
@ 1,0 DCSAY 'File Group to Open' GET cFileGroup PICT '@' ;
POPUP {|c|DC_FilePik(c)}
@ 3,0 DCPUSHBUTTON CAPTION 'Open' SIZE 10,2 ;
TOOLTIP 'Open Files and Display Work Area Tree' ;
ACTION {||dbCloseAll(), ;
DC_FileRest(cFileGroup), ;
DC_WorkTree() }
@ 3,12 DCPUSHBUTTON CAPTION 'Browse' SIZE 10,2 ;
TOOLTIP 'Open Files and Browse All Work Areas' ;
ACTION {||dbCloseAll(), ;
DC_FileRest(cFileGroup), ;
WorkBrowse() }
@ 3,24 DCPUSHBUTTON CAPTION 'Edit' SIZE 10,2 ;
TOOLTIP 'Edit File Group' ;
ACTION {||DC_FileEdit(cFileGroup)}
DCREAD GUI FIT ADDBUTTONS MODAL TITLE 'File Group Example #2' ;
EVAL {|o|SetAppWindow(o)}
CLOSE ALL
RETURN nil
* -------------
STATIC FUNCTION WorkBrowse()
LOCAL GetList := {}, GetOptions, aTabPage := {}, aBrowse := {}, i, ;
cAlias, nCount := 0, j
FOR i := 1 TO 255
cAlias := Alias(i)
IF !Empty(cAlias)
SELE (i)
GO TOP
nCount++
ASize(aTabPage,nCount)
ASize(aBrowse,nCount)
IF nCount = 1
@ 0,0 DCTABPAGE aTabPage[nCount] SIZE 90,20 CAPTION cAlias
ELSE
@ 0,0 DCTABPAGE aTabPage[nCount] RELATIVE aTabPage[nCount-1] ;
CAPTION cAlias
ENDIF
@ 2,2 DCBROWSE aBrowse[nCount] SIZE 86, 17 ALIAS cAlias ;
PRESENTATION DC_BrowPres() PARENT aTabPage[nCount]
FOR j := 1 TO (cAlias)->(FCount())
DCBROWSECOL DATA &('{||' + cAlias + '->' + FieldName(j) + '}') ;
PARENT aBrowse[nCount] HEADER (cAlias)->(FieldName(j))
NEXT
ENDIF
NEXT
DCGETOPTIONS BUSYMESSAGE 'Please wait while building dialog'
DCREAD GUI FIT MODAL TITLE 'Browsing All Work Areas' ;
OPTIONS GetOptions CLEAREVENTS
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_140()
/* This example shows how to use the field dictionary to
set up Descriptors, Validations, Prompts, etc */
LOCAL aFields
USE COLLECT VIA DBFNTX
DC_FieldEdit()
aFields := DC_FieldLoad('COLLECT')
DC_ArrayView(aFields)
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_141()
/* This example shows how to use the field dictionary to
display a data-driven browse and data-entry screen */
LOCAL GetList := {}, i, aFieldGroup, oBrowse, cAlias, aFieldOpt, ;
aFieldItems, oTabPage1, oTabPage2, oTabPage2Static, bGetSet, ;
bKeyBlock, bPopUp, GetOptions, bCompile
DC_FileRest('COLLECT')
aFieldGroup := DC_FieldLoad('COLLECT')
aFieldOpt := aFieldGroup[1]
aFieldItems := aFieldGroup[2]
cAlias := 'COLLECT'
@ 0,0 DCTABPAGE oTabPage1 SIZE 84,18 CAPTION 'Browse' ;
GOTFOCUS {||oBrowse:RefreshAll()}
@ 0,0 DCTABPAGE oTabPage2 RELATIVE oTabPage1 CAPTION 'Edit' ;
STATICAREA oTabPage2Static ;
GOTFOCUS {||DC_RecLock(), ;
DC_GetRefresh(GetList)}
@ 2,2 DCBROWSE oBrowse SIZE 80,15 ALIAS 'COLLECT' ;
PRESENTATION DC_BrowPres() PARENT oTabPage1
FOR i := 1 TO Len(aFieldItems)
bCompile := DC_GetBlock(aFieldItems[i,DCFLD_COMPILE])
IF Valtype(bCompile) = 'B' .AND. !Eval(bCompile)
LOOP
ENDIF
DCBROWSECOL DATA &('{||' + cAlias + '->' + ;
aFieldItems[i,DCFLD_NAME] + '}') ;
PARENT oBrowse HEADER aFieldItems[i,DCFLD_DESC] ;
MESSAGE aFieldItems[i,DCFLD_PROMPT] ;
PROTECT aFieldItems[i,DCFLD_PROTECT] ;
WHEN aFieldItems[i,DCFLD_WHEN] ;
FONT aFieldItems[i,DCFLD_FONT] ;
HELPCODE aFieldItems[i,DCFLD_HELPCODE]
IF aFieldItems[i,DCFLD_TYPE] = 'M'
bGetSet := 'MEMO'
bKeyBlock := {|a,b,o|o:undo()}
bPopUp := MemoBlock(i,cAlias,aFieldItems[i,DCFLD_DESC])
ELSE
bGetSet := DC_FieldWBlock(aFieldItems[i,DCFLD_NAME],cAlias)
bKeyBlock := nil
IF !Empty(aFieldItems[i,DCFLD_POPUP])
bPopUp := aFieldItems[i,DCFLD_POPUP]
ELSEIF aFieldItems[i,DCFLD_VALTYPE] $ 'TCVD' // table, choice, view, datapick
bPopUp := PopupBlock(i,aFieldItems)
ELSEIF aFieldItems[i,DCFLD_TYPE] = 'D'
bPopUp := {|d|DC_PopDate()}
ELSE
bPopUp := nil
ENDIF
ENDIF
@ i-.5,2 DCSAY aFieldItems[i,DCFLD_DESC] ;
GET bGetSet ;
POPUP bPopUp ;
PARENT oTabPage2Static ;
KEYBLOCK bKeyBlock ;
PICTURE aFieldItems[i,DCFLD_PICT] ;
MESSAGE aFieldItems[i,DCFLD_PROMPT] ;
EDITPROTECT aFieldItems[i,DCFLD_PROTECT] ;
WHEN aFieldItems[i,DCFLD_WHEN] ;
VALID ValidBlock(i, aFieldItems, ;
aFieldItems[i,DCFLD_VALTYPE],aFieldItems[i,DCFLD_VALID],cAlias) ;
HELPCODE aFieldItems[i,DCFLD_HELPCODE] ;
GETFONT aFieldItems[i,DCFLD_FONT]
NEXT
@ 18,0 DCMESSAGEBOX TYPE XBPSTATIC_TYPE_RECESSEDBOX ;
FONT '12.Arial Bold' COLOR GRA_CLR_DARKBLUE ;
SIZE 84,1.2
DCGETOPTIONS SAYWIDTH 150 SAYRIGHT AUTORESIZE
DCREAD GUI FIT ADDBUTTONS MODAL ;
TITLE aFieldOpt[DCFLDGROUP_DESC] ;
CLEAREVENTS ;
OPTIONS GetOptions ;
EVAL {|o|SetAppWindow(o)}
RETURN nil
* -----------------------------
STATIC FUNCTION MemoBlock( i, cAlias, cDesc )
RETURN {|c,x|x:=(cAlias)->(FieldGet(i)), ;
x:=DC_MemoBase(x,{,,,,,,,,,,,,,'Editing Memo: ' + cDesc}), ;
FieldPut(i,x),c}
* -----------------------------
STATIC FUNCTION PopUpBlock( i, aFieldItems )
RETURN {|c|DC_FieldValidate(@c, aFieldItems, i, .t. ),c}
* -----------------------------
STATIC FUNCTION ValidBlock( i, aFieldItems, cValtype, cFormula, cAlias )
IF Empty(cValtype)
RETURN cFormula
ENDIF
RETURN {||DC_FieldValidate( (cAlias)->(FieldGet(i)), aFieldItems, i ) }
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_142()
/* This example shows how to use code tables
in validations and PopUps */
LOCAL GetList := {}, cName := Space(25), cPosition := ' ', ;
cTeam := Space(10), GetOptions
@ 1,0 DCSAY 'Player Name' GET cName PROPER
@ 2,0 DCSAY ' Team Name' GET cTeam ;
POPUP {|c|DC_CodeGet('TEAMS',cTeam,,.t.)}
@ 3,0 DCSAY ' Position' GET cPosition ;
POPUP {|c|DC_CodeGet('BASEBALL',cPosition,,.t.)}
@ 5,0 DCPUSHBUTTON CAPTION "Edit Code Tables" SIZE 20,1.2 ;
ACTION {||DC_CodeEdit()}
DCGETOPTIONS TABSTOP SAYRIGHT SAYWIDTH 80
DCREAD GUI FIT ADDBUTTONS MODAL TITLE 'Enter Player Information' ;
EVAL {|o|SetAppWindow(o)} ;
OPTIONS GetOptions
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_143()
/*
Drag and Drop (database)
This sample demonstrates dragging a value from a field/record in
a database browse to another record. The value in the cell
that is grabbed is copied to the same field of the new record.
*/
LOCAL GetList := {}, oBrowse
USE XTEST VIA 'DBFCDX' INDEX XTEST.CDX EXCLUSIVE
OrdSetFocus(0)
@ 0,0 DCBROWSE oBrowse ALIAS 'XTEST' SIZE 45,10 ;
PRESENTATION DC_BrowPres()
DCSETPARENT oBrowse
DCBROWSECOL FIELD XTEST->date HEADER 'Date' Width 8
DCBROWSECOL FIELD XTEST->time HEADER 'Time' Width 8
DCBROWSECOL FIELD XTEST->tel_called HEADER 'Number Called' Width 10
DCREAD GUI ;
FIT ;
MODAL ;
BUTTONS DCGUI_BUTTON_EXIT ;
TITLE 'Drag a Value from one Row to another' ;
HANDLER _XSample_143 REFERENCE @oBrowse
RETURN nil
/* ------------------- */
STATIC FUNCTION ;
_XSample_143 ( nEvent, mp1, mp2, oXbp, oDlg, GetList, oBrowse )
STATIC lButtonDown := .f., nTopRow, nGrabRow, xValue, oCellGroup
LOCAL oColumn, nRowPos, nRecNo, nNewRecNo, i, lHitBottom := .f.
IF Valtype(oXbp) = 'O'
/* -- Left button pressed in a cell -- */
IF nEvent = xbeM_LbDown .AND. oXbp:ClassName() = 'XbpCellGroup'
nRowPos := Int((oXbp:currentSize()[2]-mp1[2]) / (oXbp:CellRect(1)[4]-oXbp:CellRect(1)[2]))
oBrowse:forcestable()
IF oBrowse:colpos == 1
xValue := XTEST->date
ELSEIF oBrowse:colpos == 2
xValue := XTEST->time
ELSE
xValue := XTEST->tel_called
ENDIF
nRecNo := OrdKeyNo() // Get current record positioin
nTopRow := nRecNo - nRowPos
nGrabRow := nRecNo
oBrowse:setPointer( nil, POINTER_MOVE_1, 1)
lButtonDown := .t.
oCellGroup := oXbp
/* -- Left button released in new cell -- */
ELSEIF nEvent = xbeM_LbUp .AND. oXbp:ClassName() = 'XbpCellGroup' .AND. ;
oXbp == oCellGroup
nRowPos := Int((oXbp:currentSize()[2]-mp1[2]) / ;
(oXbp:CellRect(1)[4]-oXbp:CellRect(1)[2]))
nRecNo := OrdKeyNo()
nNewRecNo := nTopRow + nRowPos
IF nNewRecNo < nRecNo
FOR i := 1 TO ( nRecNo-nNewRecNo)
oBrowse:up()
NEXT
ELSE
FOR i := 1 TO ( nNewRecNo-nRecNo)
oBrowse:down()
NEXT
ENDIF
oBrowse:forceStable()
IF oBrowse:colpos == 1
XTEST->date := xValue
ELSEIF oBrowse:colpos == 2
XTEST->time := xValue
ELSE
XTEST->tel_called := xValue
ENDIF
oBrowse:refreshAll()
oBrowse:setPointer( nil, 1, 1 )
lButtonDown := .f.
ELSEIF lButtonDown
oBrowse:setPointer( nil, POINTER_MOVE_1, 1)
/* -- Mouse moved in Bottom ScrollBar area -- */
IF nEvent = xbeM_Motion .AND. oXbp:ClassName() = 'XbpScrollbar' .AND. ;
oXbp:type = XBPSCROLL_HORIZONTAL
DO WHILE oBrowse:cargo[4] < Len(oBrowse:cargo[5])
IF oBrowse:RowPos+1 = oBrowse:RowCount
nTopRow++
ENDIF
oBrowse:down()
oBrowse:refreshAll()
nEvent := AppEvent( @mp1, @mp2, @oXbp, .1 )
IF nEvent = xbeM_LbUp
EXIT
ELSEIF nEvent = xbeP_None .OR. Valtype(oXbp) # 'O' .OR. oXbp:ClassName() = 'XbpScrollbar'
Sleep(7)
LOOP
ENDIF
EXIT
ENDDO
/* -- Mouse moved in Header area -- */
ELSEIF nEvent = xbeM_Motion .AND. oXbp:ClassName() = 'XbpCellGroup' .AND. ;
!(oXbp==oCellGroup) .AND. oXbp:setParent()==oCellGroup:setParent()
DO WHILE OrdKeyNo() > 1
IF oBrowse:RowPos = 1
nTopRow--
ENDIF
oBrowse:up()
oBrowse:refreshAll()
nEvent := AppEvent( @mp1, @mp2, @oXbp, .1 )
IF nEvent = xbeM_LbUp
EXIT
ELSEIF nEvent = xbeP_None .OR. Valtype(oXbp) # 'O' .OR. ;
(oXbp:ClassName() = 'XbpCellGroup' .AND. ;
!(oXbp==oCellGroup) .AND. oXbp:setParent()==oCellGroup:setParent())
Sleep(7)
LOOP
ENDIF
EXIT
ENDDO
ENDIF
ENDIF
ENDIF
IF nEvent = xbeM_LbUp
lButtonDown := .f.
ENDIF
RETURN DCGUI_NONE
*** END OF EXAMPLE ***
* ---------------------------- *
FUNCTION XSample_144()
/* This example demonstrates how to create a dialog that
builds objects and adds items to the GetList on demand
rather than all at once. This improves performance
by creating the objects only when they are needed and
saves on Windows resources by destroying objects when
the tabpage loses focus. The Gets on a Tab Page will
be created when the respective Tab Page is selected and
only if it is selected. The Gets are destroyed and
removed from the GetList on all tab pages that are not
visible. */
LOCAL GetList := {}, aTabPages[8], aGets[8,20], i, j, aBuildGets[8], ;
GetOptions, bGotFocus
AFill(aBuildGets,.t.)
FOR i := 1 TO 8
bGotFocus := BuildBlock(aTabPages,aBuildGets,i,GetList,aGets)
IF i = 1
@ 0,0 DCTABPAGE aTabPages[i] SIZE 80,23 ;
CAPTION 'Page ' + Alltrim(Str(i)) PREOFFSET 0 POSTOFFSET 90 ;
GOTFOCUS bGotFocus
ELSE
@ 0,0 DCTABPAGE aTabPages[i] RELATIVE aTabPages[i-1] ;
CAPTION 'Page ' + Alltrim(Str(i)) ;
GOTFOCUS bGotFocus
ENDIF
NEXT
bGotFocus := BuildBlock(aTabPages,aBuildGets,1,GetList,aGets)
DCGETOPTIONS AUTORESIZE
DCREAD GUI FIT TITLE 'Gets are created "On Demand"' MODAL ;
OPTIONS GetOptions EVAL bGotFocus
RETURN nil
* ------------------
STATIC FUNCTION BuildBlock( aTabPages, aBuildGets, i, GetList, aGets )
RETURN {||BuildGets(aTabPages,aBuildGets,i,GetList,aGets)}
* ------------------
STATIC FUNCTION BuildGets( aTabPages, aBuildGets, i, aGetList, aGets )
LOCAL j, GetOptions, GetList := {}
IF aBuildGets[i]
aBuildGets[i] := .f.
FOR j := 1 TO 20
aGets[i,j] := Pad('This is the data in Get ' + ;
Alltrim(Str(i)) + '/' + Alltrim(Str(j)),40)
@ j+1, 5 DCSAY 'This is Say ' + ;
Alltrim(Str(i)) + '/' + Alltrim(Str(j)) ;
GET aGets[i,j] PARENT aTabPages[i] ;
SAYSIZE 15
NEXT
#ifdef EXPRESS17
aTabPages[i]:lockUpdate(.t.)
#endif
DCREAD GUI PARENT aTabPages[i] EXIT SAVE
DC_MergeGetLists(aGetList,GetList)
#ifdef EXPRESS17
aTabPages[i]:lockUpdate(.f.)
#endif
ENDIF
#ifdef EXPRESS17
FOR j := 1 TO Len(aTabPages)
IF j # i .AND. !aBuildGets[j]
aBuildGets[j] := .t.
DC_GetDestroy( aGetList,aTabPages[j],.t.,.t.)
ENDIF
NEXT
#endif
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_145()
/* This example shows how to use the DISABLEDCOLOR clause
of DCGETOPTIONS to set the color of objects when are
are disabled by the WHEN clause of DC* commands */
LOCAL GetList := {}, GetOptions, aGets[10], i
FOR i := 1 TO 10
aGets[i] := Pad('This is GET ' + Alltrim(Str(i)),30)
@ i,1 DCSAY 'This is Say ' + Alltrim(Str(i)) GET aGets[i] ;
SAYSIZE 15 SAYRIGHT ;
WHEN _Modulus(i)
NEXT
DCGETOPTIONS DISABLEDCOLOR { 50,100,0 }
DCREAD GUI FIT ADDBUTTONS TITLE 'WHEN Color' ;
OPTIONS GetOptions ;
EVAL {||SetTimerEvent(110,{||DC_GetRefresh(GetList)})}
SetTimerEvent(0)
RETURN nil
* ------------
FUNCTION _Modulus(i)
RETURN {||Int(Val(Str(Seconds())[9])) % i = 0}
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_146( lExit )
/* This example shows how to use the Query Wizard to
create complex logical conditions based on simple,
easy-to-use pick lists of options */
LOCAL GetList := {}, GetOptions, oBrowse, cDataFilter := '', ;
cIndexFilter := '', i, aStructure, oDialog
DEFAULT lExit := .f.
USE XTEST VIA 'DBFCDX'
@ 0,0 DCBROWSE oBrowse ALIAS 'XTEST' SIZE 80,10 ;
PRESENTATION DC_BrowPres()
aStructure := dbStruct()
FOR i := 1 TO Len(aStructure)
DCBROWSECOL DATA &('{||XTEST->'+aStructure[i,1]+'}') ;
HEADER aStructure[i,1] WIDTH aStructure[i,3] ;
PARENT oBrowse
NEXT
@ 11,0 DCSAY {||'Data Filter: ' + dbFilter()} SAYSIZE 80 ;
COLOR GRA_CLR_BLUE
@ 12,0 DCSAY {||'Index Filter: ' + DC_IndexFilt()} SAYSIZE 80 ;
COLOR GRA_CLR_BLUE
@ 13.5,0 DCPUSHBUTTON CAPTION '&Data Filter' SIZE 15,1.2 ;
ACTION {||_SetFilter(@cDataFilter,GetList)}
@ 13.5,17 DCPUSHBUTTON CAPTION '&Index Filter' SIZE 15,1.2 ;
ACTION {||_SetIndex(@cIndexFilter,GetList)}
@ 13.5,34 DCPUSHBUTTON CAPTION 'E&xit' SIZE 15,1.2 ;
ACTION {||DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)}
IF !lExit
DCREAD GUI FIT MODAL TITLE 'Query Builder Example'
CLOSE ALL
ENDIF
RETURN GetList
* -----------------
PROCEDURE _SetFilter( cQuery, GetList )
LOCAL bQuery
cQuery := DC_QueryBuild(cQuery)
IF !Empty(cQuery)
bQuery := &('{||'+cQuery+'}')
dbSetFilter(bQuery,cQuery)
ELSE
SET FILTER TO
ENDIF
GO TOP
DC_GetRefresh(GetList)
RETURN
* -----------------
PROCEDURE _SetIndex( cQuery, GetList )
LOCAL bQuery
cQuery := DC_QueryBuild(cQuery)
IF !Empty(cQuery)
bQuery := &('{||'+cQuery+'}')
OrdCondSet( cQuery, bQuery )
OrdCreate( 'XTEST.NTX', 'JUNK', 'AREACODE+EXCHANGE+NUMBER', ;
{||AREACODE+EXCHANGE+NUMBER},.f.,.f. )
ELSE
SET INDEX TO
ENDIF
GO TOP
DC_GetRefresh(GetList)
RETURN
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_147()
/* This example shows how to use the DC_GetList2Source() function
to write out command-based source code from the contents of
a GetList. In this example a call is made to XSample_146() to
build a GetList. */
LOCAL lOk, cSource, GetList := {}, aGetList := XSample_146(.t.)
cSource := DC_GetList2Source(aGetList)
cSource += CRLF + 'DCREAD GUI FIT ADDBUTTONS TITLE "Test Browse"' + CRLF
@ 0,0 DCMULTILINE cSource SIZE 80,20 FONT '8.Courier New'
DCREAD GUI FIT ADDBUTTONS TO lOk ;
TITLE 'Click OK to Interpret this code with DC_Interpret()'
IF lOk
DC_Interpret(cSource)
ENDIF
CLOSE ALL
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_148( aGetList )
/* This example shows how to use the DC_GetList2Source() function
to write out command-based source code from the contents of
a GetList. In this example, the GetList from this dialog is
passed and will be converted to commands. */
LOCAL lOk, cSource, GetList := {}
cSource := DC_GetList2Source(aGetList)
cSource += CRLF + 'DCREAD GUI FIT ADDBUTTONS TITLE "Test Browse"' + CRLF
@ 0,0 DCMULTILINE cSource SIZE 90,20 FONT '10.Courier New'
DCREAD GUI FIT BUTTONS DCGUI_BUTTON_EXIT ;
TITLE 'Command-based Source Code'
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_149()
/* This example shows how to use the DC_Dbu() function
to invoke a Database Management Utility */
LOCAL oThread := Thread():new()
oThread:start({||DC_Dbu()})
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_150()
/* This example captures the current dialog to the
ClipBoard and views the clipboard using the print previewer */
DC_Scrn2ClipBoard()
DC_PrintClipBoard(.t.)
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_151()
/* This example shows how to use the GRASTRING clause of
DCSAY to produce a GraString() image instead of an
XbpStatic() object. Saves on resources. The leftmost
text is XbpStatic(). The rightmost text is GraString() */
LOCAL GetList := {}, oStatic, GetOptions
@ 0,0 DCSTATIC TYPE XBPSTATIC_TYPE_TEXT SIZE 90,25 OBJECT oStatic
DCSETPARENT TO oStatic
@ 1,0 DCSAY 'LEFTTOP_TEXT' SAYLEFTTOP ;
COLOR GRA_CLR_WHITE, GRA_CLR_BLUE SAYSIZE 30
@ 1,35 DCSAY 'LEFTTOP_TEXT' GRASTRING SAYLEFTTOP ;
COLOR GRA_CLR_WHITE, GRA_CLR_BLUE SAYSIZE 30
@ 3,0 DCSAY 'CENTER_TEXT_VERT' SAYVCENTER ;
COLOR GRA_CLR_YELLOW, GRA_CLR_BLUE SAYSIZE 30
@ 3,35 DCSAY 'CENTER_TEXT_VERT' GRASTRING SAYVCENTER ;
COLOR GRA_CLR_YELLOW, GRA_CLR_BLUE SAYSIZE 30
@ 5,0 DCSAY 'RIGHTBOTTOM_TEXT' SAYRIGHTBOTTOM ;
COLOR GRA_CLR_GREEN, GRA_CLR_BLACK SAYSIZE 30
@ 5,35 DCSAY 'RIGHTBOTTOM_TEXT' GRASTRING SAYRIGHTBOTTOM ;
COLOR GRA_CLR_GREEN, GRA_CLR_BLACK SAYSIZE 30
@ 7,0 DCSAY 'LEFTBOTTOM_TEXT' SAYLEFTBOTTOM ;
COLOR GRA_CLR_GREEN, GRA_CLR_BLACK SAYSIZE 30
@ 7,35 DCSAY 'LEFTBOTTOM_TEXT' GRASTRING SAYLEFTBOTTOM ;
COLOR GRA_CLR_GREEN, GRA_CLR_BLACK SAYSIZE 30
@ 9,0 DCSAY 'LEFTBOTTOM_TEXT' SAYLEFTBOTTOM SAYSIZE 0
@ 9,35 DCSAY 'LEFTBOTTOM_TEXT' GRASTRING SAYLEFTBOTTOM
@11,0 DCSAY 'CENTER_TEXT_HORIZ' SAYCENTER ;
FONT '10.Courier New Bold' SAYSIZE 0
@11,35 DCSAY 'CENTER_TEXT_HORIZ' GRASTRING SAYCENTER ;
FONT '10.Courier New Bold'
@13,0 DCSAY 'TOP_TEXT' SAYTOP FONT '24.Arial Bold' SAYSIZE 40,2.5 ;
COLOR GRA_CLR_CYAN, GRA_CLR_BLACK
@13,45 DCSAY 'TOP_TEXT' GRASTRING SAYTOP FONT '24.Arial Bold' ;
SAYSIZE 40,2.5 COLOR GRA_CLR_CYAN,GRA_CLR_BLACK
@16,0 DCSAY 'CENTER_VERT_HORIZ' SAYHVCENTER FONT '12.Arial Bold' ;
SAYSIZE 40,1.7 COLOR GRA_CLR_YELLOW,GRA_CLR_GREEN
@16,45 DCSAY 'CENTER_VERT_HORIZ' GRASTRING SAYHVCENTER ;
FONT '12.Arial Bold' SAYSIZE 40,1.7 COLOR GRA_CLR_YELLOW,GRA_CLR_GREEN
@19,0 DCSAY 'TOP' SAYTOP FONT '12.Arial Bold' SAYSIZE 40,2 ;
COLOR GRA_CLR_YELLOW,GRA_CLR_GREEN
@19,45 DCSAY 'TOP' GRASTRING SAYTOP FONT '12.Arial Bold' SAYSIZE 40,2 ;
COLOR GRA_CLR_YELLOW,GRA_CLR_GREEN
@22,0 DCSAY 'TOPLEFT' SAYLEFTTOP FONT '10.Arial Bold' SAYSIZE 40,1.5 ;
COLOR GRA_CLR_YELLOW,GRA_CLR_RED
@22,45 DCSAY 'TOPLEFT' GRASTRING SAYLEFTTOP FONT '10.Arial Bold' ;
SAYSIZE 40,1.5 COLOR GRA_CLR_YELLOW,GRA_CLR_RED
DCREAD GUI FIT ADDBUTTONS OPTIONS GetOptions MODAL
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_152()
/* This example shows how the DCBROWSECOL .. DATATOOLTIP clause
can be used to expand the info in a cell */
LOCAL GetList := {}, oBrowse, lDataToolTips := .f., GetOptions
USE COLLECT VIA 'DBFNTX'
@ 0,0 DCBROWSE oBrowse SIZE 60,13 PRESENTATION DC_BrowPres() FIT
DCBROWSECOL FIELD COLLECT->descrip WIDTH 10 PARENT oBrowse ;
TOOLTIP 'Description' HEADER "Description" DATATOOLTIP {||lDataToolTips}
DCBROWSECOL FIELD COLLECT->type PARENT oBrowse ;
TOOLTIP 'Type' HEADER "Type"
DCBROWSECOL FIELD COLLECT->memo WIDTH 20 PARENT oBrowse ;
TOOLTIP 'Memo' HEADER "Memo" DATATOOLTIP {||lDataToolTips}
DCBROWSECOL FIELD COLLECT->bitmap1 WIDTH 7 PARENT oBrowse ;
TOOLTIP 'BitMap 1' HEADER "BitMap 1" ;
DATATOOLTIP {||lDataToolTips} TIPBLOCK {||_XSample_152(COLLECT->bitmap1)}
DCBROWSECOL FIELD COLLECT->bitmap2 WIDTH 7 PARENT oBrowse ;
TOOLTIP 'BitMap 1' HEADER "BitMap 2" ;
DATATOOLTIP {||lDataToolTips} TIPBLOCK {||_XSample_152(COLLECT->bitmap2)}
@ 14,0 DCCHECKBOX lDataToolTips PROMPT 'Show DataArea Tooltips'
DCGETOPTIONS TOOLTIPCOLOR GRA_CLR_BLACK, GRA_CLR_CYAN
DCREAD GUI FIT MODAL ADDBUTTONS TITLE 'Data Area ToolTips' ;
OPTIONS GetOptions
CLOSE ALL
RETURN nil
* ---------------
STATIC FUNCTION _XSample_152(cBitMap)
STATIC oBitMap
LOCAL cPath := DC_Path(AppName(.t.))
IF Valtype(oBitMap) = 'O' .AND. oBitMap:status() > 0
oBitMap:destroy()
ENDIF
oBitMap := XbpBitmap():new():create()
oBitMap:loadfile(cPath + '\' + cBitMap)
RETURN oBitMap
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_153()
/* This example shows how to right justify a table of Gets */
LOCAL GetList := {}, aFields, aData, i, cType, nRow, cPict, nLen, ;
aBackColor, nColPixels
USE COLLECT VIA DBFNTX
nColPixels := 7 // Default Pixels/Column
aFields := dbStruct()
aData := Array(Len(aFields))
nRow := 0
FOR i := 1 TO Len(aFields)
aData[i] := FieldGet(i)
cType := aFields[i,2]
cPict := NIL
nLen := aFields[i,3]
IF cType = 'L'
cPict := 'Y'
ELSEIF cType = 'D'
nLen := 10
ENDIF
IF cType # 'M'
IF i%2 == 0
aBackColor := { 200,200,200 }
ELSE
aBackColor := { 230,230,230 }
ENDIF
@ ++nRow,1 DCSAY aFields[i,1] COLOR GRA_CLR_BLACK, aBackColor SAYSIZE 60 SAYVCENTER
@ nRow,60 - nLen - nLen/nColPixels DCGET aData[i] PICTURE cPict
ENDIF
NEXT
DCREAD GUI FIT ADDBUTTONS MODAL TITLE 'Right-Justified GETs'
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_154()
LOCAL i := 0, oDrucker
DCPRINT ON TO oDrucker PREVIEW
DCPRINT FONT "10.Arial"
FOR i := 1 to 10
// With 4 decimals and a comma Picture String
@ i,20 DCRIGHTPRINT SAY i*456.7543 PICTURE "99,999.9999"
NEXT
@ 11,20 DCPRINT SAY "This is 11,20"
DCPRINT FONT "14.Modern"
FOR i := 1 to 10
// Without any Picture String
@ i,40 DCRIGHTPRINT SAY i*456.72
NEXT
@ 11,40 DCPRINT SAY "This is 11,40"
DCPRINT FONT "8.Arial"
FOR i := 1 to 10
// With 3 decimals without comma as Picture String
@ i,60 DCRIGHTPRINT SAY i*456.74 PICTURE "9999.999"
NEXT
@ 11,60 DCPRINT SAY "This is 11,60"
DCPRINT FONT "11.Modern Bold"
FOR i := 14 to 24
// Print a Date
@ i,20 DCRIGHTPRINT SAY date() + i
NEXT
@ 25,20 DCPRINT SAY "This is 25,20"
DCPRINT FONT "10.Courier New"
FOR i := 14 to 24
// Print a string
@ i,40 DCRIGHTPRINT SAY "This is a string " + Alltrim(Str(i))
NEXT
@ 25,40 DCPRINT SAY "This is 25,40"
DCPRINT OFF
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_155()
/* This example shows how to use code blocks for addressing
of GETs dynamically */
LOCAL GetList[0], aDates[20], aFields, nCol, nRow, i
USE collect VIA 'DBFNTX'
nCol := 0
nRow := 0
FOR i := 1 TO 20
aDates[i] := Date() + i
@ {||nRow}, {||nCol} DCGET aDates[i] EVAL _PosBlock(@nCol,@nRow)
NEXT
aFields := Array(Fcount())
FOR i := 1 TO Len(aFields)
aFields[i] := FieldGet(i)
IF Valtype(aFields[i]) $ 'CDLN'
@ {||nRow}, {||nCol} DCGET aFields[i] EVAL _PosBlock(@nCol,@nRow)
ENDIF
NEXT
DCREAD GUI FIT MODAL TITLE 'Dynamic Addressing'
CLOSE ALL
RETURN nil
* --------------
STATIC FUNCTION _PosBlock(nCol,nRow)
RETURN {|o|nCol := o:currentPos()[1]+o:currentSize()[1], ;
nCol := IIF( nCol>300,0,nCol+5 ), ;
nRow := IIF( nCol==0, nRow-25, nRow )}
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_156()
/* This example shows how to use the MESSAGEINTO clause of
DCGETOPTIONS to use any object as a message receptacle
for displaying custom messages such as multi-line messages,
bitmaps, etc. */
LOCAL i, GetList[0], aDates[4], cMsg := '', GetOptions, oMsgBox
FOR i := 1 TO 4
aDates[i] := Date()+i
NEXT
@ 1,1 DCGET aDates[1] ;
VALID {||aDates[1] > Date()} ;
MESSAGE "Enter the the FIRST date ;This must be later than today's date"
@ 2,1 DCGET aDates[2] ;
VALID {||aDates[2] > aDates[1]} ;
MESSAGE "Enter the SECOND date ;This must be later than the FIRST date"
@ 3,1 DCGET aDates[3] ;
VALID {||aDates[3] > aDates[2]} ;
MESSAGE "Enter the THIRD date ;This must be later than the SECOND date"
@ 4,1 DCGET aDates[4] ;
VALID {||aDates[4] > aDates[3]} ;
MESSAGE "Enter the FOURTH date ;This must be later than the THIRD date"
@ 6,1 DCMULTILINE cMsg COLOR GRA_CLR_WHITE, GRA_CLR_BLUE ;
OBJECT oMsgBox SIZE 50,3 EDITPROTECT {||.t.} ;
NOHSCROLL NOVSCROLL FONT '10.Courier Bold'
DCGETOPTIONS ;
MESSAGEINTO {|c|c:=Strtran(c,';',Chr(13)+Chr(10)),oMsgBox:setData(c)}
DCREAD GUI FIT ADDBUTTONS OPTIONS GetOptions TITLE 'MESSAGEINTO clause' ;
MODAL
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_157()
/* This example shows how to move browse columns */
LOCAL GetList[0], oBrowse, aDir := Directory(), i
@ 0,0 DCBROWSE oBrowse DATA aDir SIZE 80,10 PRESENTATION DC_BrowPres()
FOR i := 1 TO 10
DCBROWSECOL ELEMENT i HEADER Alltrim(Str(i)) WIDTH 5 PARENT oBrowse
NEXT
@ 12, 0 DCPUSHBUTTON CAPTION '<-Left' ;
SIZE 10,1.2 ;
ACTION {||MoveColumn(1,oBrowse),DC_GetRefresh(GetList)} ;
FONT '8.Courier' ;
WHEN {||oBrowse:colPos > 1}
@ 12,12 DCPUSHBUTTON CAPTION 'Right->' ;
SIZE 10,1.2 ;
ACTION {||MoveColumn(2,oBrowse),DC_GetRefresh(GetList)} ;
FONT '8.Courier' ;
WHEN {||oBrowse:colPos < 10}
DCREAD GUI FIT BUTTONS DCGUI_BUTTON_EXIT ;
TITLE 'Moving a Browse Column' MODAL
RETURN nil
* --------------
STATIC FUNCTION MoveColumn( nMode, oBrowse )
LOCAL oColumn, nPos
nPos := oBrowse:colPos
oColumn := oBrowse:getColumn(nPos)
oBrowse:delColumn(nPos)
IF nMode = 1
oBrowse:insColumn(nPos-1,oColumn)
oBrowse:left()
ELSE
oBrowse:insColumn(nPos+1,oColumn)
oBrowse:right()
ENDIF
oBrowse:forceStable()
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_158()
/* This example shows how to create a drop-down browse
from a POPUP button on a GET */
LOCAL GetList[0], cFile1, cFile2, cFile3, bPopUp, oStatic, nPopKey
STORE Space(30) TO cFile1, cFile2, cFile3
bPopUp := {|c,oGet|_PickFile(c,oGet,oStatic)}
@ 0,0 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE 80,15 ;
OBJECT oStatic
DCSETPARENT oStatic
@ 1,1 DCSAY 'File Name 1' GET cFile1 POPUP bPopUp SAYSIZE 0
@ 3,1 DCSAY 'File Name 2' GET cFile2 POPUP bPopUp SAYSIZE 0
@ 5,1 DCSAY 'File Name 3' GET cFile3 POPUP bPopUp SAYSIZE 0
nPopKey := DC_SetPopKey(xbeK_SH_DOWN)
DCREAD GUI FIT ADDBUTTONS TITLE 'Enter File Names' ;
SETAPPWINDOW MODAL
DC_SetPopKey(nPopKey)
RETURN nil
* ------------
STATIC FUNCTION _PickFile( cFileName, oGet, oStatic )
LOCAL GetList[0], aDirectory, oBrowse, nPointer := 1, lStatus, ;
GetOptions, aPos
aDirectory := Directory()
aPos := DC_CalcAbsolutePosition({0,0},oGet)
@ oGet:currentPos()[2]-113,oGet:currentPos()[1] ;
DCBROWSE oBrowse ;
SIZE 350,113 ;
PIXEL ;
DATA aDirectory ;
PRESENTATION DC_BrowPres() ;
NOHSCROLL ;
FIT ;
POINTER nPointer ;
INVISIBLE ;
ITEMSELECTED {||DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)}
aDirectory := Directory()
DCBROWSECOL ELEMENT 1 WIDTH 10 PARENT oBrowse
DCBROWSECOL ELEMENT 2 WIDTH 6 PARENT oBrowse
DCBROWSECOL ELEMENT 3 WIDTH 6 PARENT oBrowse
DCBROWSECOL ELEMENT 4 WIDTH 6 PARENT oBrowse
DCGETOPTIONS NOTRANSLATE
DCREAD GUI ;
MODAL ;
OPTIONS GetOptions ;
HANDLER _pickHandler ;
PARENT oStatic ;
TO lStatus ;
EVAL {||SetAppFocus(oBrowse:getColumn(1))}
oBrowse:destroy()
IF lStatus
RETURN aDirectory[nPointer,1]
ENDIF
RETURN cFileName
* -----------
STATIC FUNCTION _pickHandler( nEvent, mp1, mp2, oXbp )
IF nEvent == xbeM_LbDown .AND. ;
!(oXbp:isDerivedFrom('XbpCellGroup') .OR. ;
oXbp:isDerivedFrom('XbpScrollBar'))
RETURN DCGUI_EXIT_ABORT
ENDIF
RETURN DCGUI_NONE
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_159()
/* This example shows how to make STATIC style pushbuttons
(a nice touch for touch-screen applications) */
LOCAL GetList[0], oButton1, oButton2, lEnabled := .t., lHidden := .f., ;
aRegion
USE COLLECT VIA DBFNTX
@ 0,0 DCPUSHBUTTON ;
STATIC ;
ACTION {||DC_DbSkip(1), ;
IIF( Eof(),DC_DbGoTop(),nil),DC_GetRefresh(GetList)} ;
OBJECT oButton1 ;
SIZE 200,200 ;
PIXEL ;
FANCY ;
COLOR GRA_CLR_BLACK, XBPSYSCLR_TRANSPARENT ;
FOCUSCOLOR nil, GRA_CLR_RED ;
BITMAP BITMAP_EXPRESS_BACKGROUND1 ;
WHEN {||lEnabled} ;
HIDE {||lHidden}
DCSETPARENT TO oButton1
@ 10,10 DCSAY 'Press;here;to;go;to;the;Next;Record' ;
OPTIONS XBPSTATIC_TEXT_WORDBREAK ;
PIXEL ;
COLOR GRA_CLR_BROWN ;
FONT '11.Arial Bold' ;
SAYSIZE 70,170
@ 5,95 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX ;
SIZE 5,190 ;
PIXEL
@ 5,110 DCSAY 'Record:' PIXEL SAYSIZE 0
@ 30,110 DCSAY {||Alltrim(Str(RecNo()))} ;
SAYSIZE 80,50 ;
SAYCOLOR GRA_CLR_DARKPINK ;
FONT '32.Arial Bold' PIXEL
@ 120,110 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP ;
PIXEL ;
CAPTION { BITMAP_NEXT_1, BITMAP_NEXT_2 }
DCSETPARENT TO
@ 0,220 DCPUSHBUTTON ;
STATIC ;
ACTION {||msgbox('Ugh')} ;
SIZE 100,100 ;
REGION DC_RegionArray( DCGUI_REGION_DIAMOND, 100 ) ;
PIXEL ;
FANCY ;
BITMAP 'smileyneutral.jpg',nil,nil,'smileyflash.jpg' ;
FLASH 2,10 ;
WHEN {||lEnabled} ;
HIDE {||lHidden}
@ 105,220 DCPUSHBUTTON ;
STATIC ;
ACTION {||msgbox('Ugh')} ;
SIZE 100,100 ;
PIXEL ;
FANCY ;
BITMAP "smileyup.jpg",'smileydown.jpg','smileyneutral.jpg' ;
WHEN {||lEnabled} ;
HIDE {||lHidden}
@ 0,330 DCPUSHBUTTON ;
STATIC ;
ACTION {||msgbox('Ugh')} ;
SIZE 100,100 ;
REGION DC_RegionArray( DCGUI_REGION_ELLIPSE, 100 ) ;
PIXEL ;
FANCY ;
BITMAP 'smileyup.jpg','smileydown.jpg','smileyneutral.jpg' ;
WHEN {||lEnabled} ;
HIDE {||lHidden}
@ 105,330 DCPUSHBUTTON ;
STATIC ;
ACTION {||msgbox('Ugh')} ;
SIZE 100,100 ;
PIXEL ;
REGION DC_RegionArray( DCGUI_REGION_OCTAGON, 100 ) ;
FANCY ;
BITMAP "smileyup.jpg",'smileydown.jpg','smileyneutral.jpg' ;
WHEN {||lEnabled} ;
HIDE {||lHidden}
@ 210,0 DCPUSHBUTTON ;
PIXEL ;
SIZE 90,30 ;
CAPTION {||IIF(lEnabled,'Disable','Enable')} ;
ACTION {||lEnabled := !lEnabled, DC_GetRefresh(GetList)}
@ 210,100 DCPUSHBUTTON ;
PIXEL ;
SIZE 90,30 ;
CAPTION {||IIF(lHidden,'Show','Hide')} ;
ACTION {||lHidden := !lHidden, DC_GetRefresh(GetList)}
DCREAD GUI FIT BUTTONS DCGUI_BUTTON_EXIT MODAL ;
TITLE 'Static Button' SETAPPWINDOW
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_160()
/* This example shows how to use the DESCENDING feature of
@..DCBROWSE. Click the mouse in the header area of the
browse. Each successive click will toggle from ascending
to descending. No special indexes required. */
LOCAL GetList[0], oBrowse, GetOptions
IF !File('..\XDOC\EXPRESS.DBF')
DC_MsgBox({'Sorry. The database required to show this feature',;
'is not included in the demonstration version', ;
'or the ..\XDOC\EXPRESS.DBF file does not exist'})
RETURN nil
ENDIF
SET DEFA TO ..\XDOC
USE EXPRESS VIA FOXCDX SHARED ALIAS 'XDOC'
SET INDEX TO EXPRESS.CDX
OrdSetFocus('COMMAND')
SET DEFA TO
@ 1,0 DCBROWSE oBrowse ALIAS 'XDOC' SIZE 90, 20 ;
SORTSCOLOR GRA_CLR_WHITE, GRA_CLR_RED ;
SORTUCOLOR GRA_CLR_WHITE, GRA_CLR_DARKGRAY ;
SORTUPBITMAP BITMAP_RD_UP_RED ;
SORTDOWNBITMAP BITMAP_RD_DOWN_RED ;
FIT ;
PRESENTATION DC_BrowPres() ;
NOHORIZSCROLL
DCBROWSECOL DATA {||XDOC->command} HEADER 'Command' ;
PARENT oBrowse ;
SORT {||OrdSetFocus('COMMAND')} LEFTBUTTON ;
_DEFAULT OrdSetFocus()=='COMMAND'
DCBROWSECOL DATA {||XDOC->short} HEADER 'Short' ;
PARENT oBrowse WIDTH 25
DCBROWSECOL DATA {||XDOC->type} HEADER 'Type' ;
PARENT oBrowse ;
SORT {||OrdSetFocus('TYPE')} LEFTBUTTON ;
_DEFAULT OrdSetFocus()=='TYPE'
DCBROWSECOL DATA {||XDOC->module} HEADER 'Module' ;
PARENT oBrowse ;
SORT {||OrdSetFocus('MODULE')} LEFTBUTTON ;
_DEFAULT OrdSetFocus()=='MODULE' ;
WIDTH 10
DCGETOPTIONS AUTORESIZE
DCREAD GUI FIT ;
MODAL ;
OPTIONS GetOptions ;
TITLE 'eXPress++ Help File - Ascend/Descend Example'
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_161()
/* This example shows how to use the ALIGN feature of
DCPRINT SAY and how to print double-line boxes */
LOCAL oPrinter, aAttrVertical[GRA_AS_COUNT]
aAttrVertical[ GRA_AS_ANGLE ] := { 0, 1 }
DCPRINT ON TO oPrinter PREVIEW NONSTOP SIZE 66,132 COPYLOOP ;
ZOOMFACTOR 1.5
IF Valtype(oPrinter) # 'O'
RETURN nil
ENDIF
@ 0,30,50,30 DCPRINT LINE
@ 1,30 DCPRINT SAY 'Align Text Right' FONT '10.Courier New' ;
ALIGN DCPRINT_ALIGN_RIGHT
@ 3,30 DCPRINT SAY 'Align Text VCenter / HCenter' ;
FONT '12.Arial' ALIGN DCPRINT_ALIGN_VCENTER + DCPRINT_ALIGN_HCENTER
@ 5,30 DCPRINT SAY 'Align Text Left' FONT '12.Courier New Bold'
@ 7,30 DCPRINT SAY 'Align Text Left' FONT '14.Arial Bold Italic'
DCPRINT FONT '16.Arial Italic Underscore'
@ 9,30 DCPRINT SAY 'Align Text HCenter (Outlined)' ;
ALIGN DCPRINT_ALIGN_HCENTER ;
OUTLINE
DCPRINT FONT '18.Arial Bold Italic'
@ 11,30 DCPRINT SAY 'Align Text Left'
DCPRINT FONT '12.Courier New Bold Italic'
@ 13,30 DCPRINT SAY 'Align Text Left'
DCPRINT FONT '14.Courier New Bold Italic Underscore'
@ 15,30 DCPRINT SAY 'Align Text Left'
DCPRINT FONT '8.Terminal'
@ 17,30 DCPRINT SAY 'Align Text H-Center' ALIGN DCPRINT_ALIGN_HCENTER
DCPRINT FONT '10.Times Roman'
@ 19,30 DCPRINT SAY 'Align Text HCenter' ALIGN DCPRINT_ALIGN_HCENTER
DCPRINT FONT '8.Terminal'
@ 21,30 DCPRINT SAY 'Align Text Right' ALIGN DCPRINT_ALIGN_RIGHT
PrintBox( 39,32,45,80 )
@ 38,0,38,70 DCPRINT LINE
@37,33 DCPRINT SAY 'Horizontal Text' FONT '12.Courier New Bold' ;
@37,30 DCPRINT SAY 'Vertical Text (Outlined)' FONT '12.Courier New Bold' ;
ATTRIBUTE aAttrVertical OUTLINE
DCPRINT OFF
RETURN nil
* --------------
STATIC FUNCTION PrintBox( nSrow, nScol, nErow, nEcol )
@ nSrow,nScol,nErow,nEcol DCPRINT BOX
@ nSrow+.1,nScol+.3,nErow-.1,nEcol-.3 DCPRINT BOX
RETURN nil
*** END OF EXAMPLE ***
* ---------------------------- *
STATIC FUNCTION XSample_162()
/* This example shows how to replace the print buttons on
the print preview window with custom captions and sizes */
LOCAL oPrinter, aButtons[9], nPage, nLine
aButtons[DCPRINT_BUTTON_PRINT] := { 60,nil,{ BITMAP_PRINT_1, BITMAP_PRINT_2} }
// aButtons[DCPRINT_BUTTON_FIND] := { 60,nil,{ BITMAP_FIND_1, BITMAP_FIND_1} }
DCPRINT ON PREVIEW BUTTONS aButtons // FINDBUTTON
FOR nPage := 1 TO 3
@ 2,10 DCPRINT SAY 'This is Page ' + Alltrim(Str(nPage)) ;
FONT '12.Arial Bold'
FOR nLine := 5 TO 20
@ nLine,10 DCPRINT SAY 'This is Line ' + Alltrim(Str(nLine))
NEXT
IF nPage < 3
DCPRINT EJECT
ENDIF
NEXT
DCPRINT OFF
RETURN nil
*** END OF EXAMPLE ***
* ----------------
#ifndef EXPRESS20
FUNCTION DC_CallStack()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_FileRest()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_FileEdit()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_FilePik()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_FieldEdit()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_FieldLoad()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_FieldValidate()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_MemoBase()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_CodeGet()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_CodeEdit()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_QueryBuild()
RETURN nil
#endif
* ----------------
#ifdef EXPRESS13
FUNCTION GraMakeRGBColor()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_GetList2Source()
RETURN nil
#endif
* ----------------
#ifndef EXPRESS20
FUNCTION DC_Dbu()
RETURN nil
#endif