home *** CD-ROM | disk | FTP | other *** search
Text File | 2002-01-30 | 40.0 KB | 1,445 lines |
- /*
- ╓──────────────────────────────────────────────────────────────╖
- ║ Program..: XDEMO1.PRG ║
- ║ Author...: Roger J. Donnay ║
- ║ Notice...: (c) DONNAY Software Designs 1987-2001 ║
- ║ Date.....: Sep 14, 2001 ║
- ║ Notes....: eXPress Demo Program #1 ║
- ╙──────────────────────────────────────────────────────────────╜
-
- This sample program demonstrates a complete application that is
- written in a procedural fashion using commands supported by the
- DCDIALOG.CH header file. The application includes 5 Tab Pages,
- a Bar Menu, a Pop-Up Menu, a Toolbar, a Message box area,
- @Say..Gets, Multiline Gets, Bitmaps, a Database browse,
- combo boxes, check boxes, radio buttons, Tooltips, context help,
- and printing.
- */
-
-
- MEMVAR aApp, oMenuBar
-
- #include "dcdialog.ch"
- #include "dcbitmap.ch"
- #include "dccursor.ch"
- #include "dcprint.ch"
- #include "xbp.ch"
- #include "gra.ch"
- #include "appevent.ch"
- #include 'dmlb.ch'
- #include 'dcgra.ch'
-
- #define oTabPage1 aApp[1]
- #define oTabPage2 aApp[2]
- #define oTabPage3 aApp[3]
- #define oTabPage4 aApp[4]
- #define oTabPage5 aApp[5]
- #define oTabPage6 aApp[6]
- #define cBitMap1 aApp[7]
- #define cBitMap2 aApp[8]
- #define oBrowse aApp[9]
- #define oToolBar aApp[10]
- #define oMenuBar aApp[11]
- #define oMenuFile aApp[12]
- #define oMenuEdit aApp[13]
- #define oMenuPrint aApp[14]
- #define nMenuExit aApp[15]
- #define nMenuPack aApp[16]
- #define nMenuNext aApp[17]
- #define nMenuPrev aApp[18]
- #define nMenuTop aApp[19]
- #define nMenuBott aApp[20]
- #define nMenuFont aApp[21]
- #define nMenuList aApp[22]
- #define nMenuItem aApp[23]
- #define nRecord aApp[24]
- #define cDesc aApp[25]
- #define cType aApp[26]
- #define cSubType aApp[27]
- #define cLocation aApp[28]
- #define cMemo aApp[29]
- #define cComments aApp[30]
- #define dDateAcq aApp[31]
- #define dDateOrig aApp[32]
- #define nOrigPrice aApp[33]
- #define nApprValue aApp[34]
- #define aForSale aApp[35]
- #define aType aApp[36]
- #define aSubType aApp[37]
- #define aLocation aApp[38]
- #define xSpare1 aApp[39]
- #define oCheckGroup aApp[40]
- #define lOriginal aApp[41]
- #define nForSale aApp[42]
- #define oRadioGroup aApp[43]
- #define cCondition aApp[44]
- #define n3State aApp[45]
- #define xSpare2 aApp[46]
- #define oFontDlg aApp[47]
- #define oMsgBox1 aApp[48]
- #define oPhoto1 aApp[49]
- #define oPhoto2 aApp[50]
- #define aGetList aApp[51]
- #define aGetOptions aApp[52]
- #define cSource aApp[53]
- #define aPres aApp[54]
- #define xSpare3 aApp[55]
- #define xSpare4 aApp[56]
- #define aColors aApp[57]
- #define aChildList aApp[58]
- #define oNextButton aApp[59]
- #define oPrevButton aApp[60]
- #define oTopButton aApp[61]
- #define oBottButton aApp[62]
- #define oBrowBox aApp[64]
- #define oMenuMemo aApp[65]
- #define oMemo aApp[66]
- #define oTabPage7 aApp[67]
- #define oCrt aApp[68]
- #define oMsgBox2 aApp[69]
- #define oTab1Static aApp[70]
- #define oTab2Static aApp[71]
- #define oTab3Static aApp[72]
- #define oTab4Static aApp[73]
- #define oTab5Static aApp[74]
- #define oTab6Static aApp[75]
- #define oTab7Static aApp[76]
- #define oDlgWindow aApp[77]
- #define nMenuFile aApp[78]
- #define nMenuEdit aApp[79]
- #define nMenuPrint aApp[80]
- #define oDlg aApp[81]
- #define cTitle aApp[82]
- #define bForSale aApp[83]
- #define cAlias aApp[84]
- #define cSayFont aApp[85]
- #define cGetFont aApp[86]
- #define nColPixels aApp[87]
- #define nRowPixels aApp[88]
- #define nWidth aApp[89]
- #define nHeight aApp[90]
- #define nSayWidth aApp[91]
-
-
- FUNCTION XDemo_1 ( oDialog )
-
- STATIC slIsRunning := .f.
-
- #ifdef EXPRESS17
- LOCAL nTransColor := DC_BitmapTransparentColor({192,192,192})
- #endif
- LOCAL GetOptions, GetList := {}, aApp[100], aPopup
-
- IF slIsRunning
- DC_Winalert('This program is running in another window')
- RETURN nil
- ENDIF
-
- slIsRunning := .t.
-
- aPopup := DC_GetPopupCaption({'12.Alaska Crt',BITMAP_PICKLIST,1})
-
- SET DELETED ON
- SET DEFA TO
- SET PATH TO ..\DATA
- SET DATE FORMAT TO 'mm/dd/yyyy'
-
- IF Select('COLLECT') = 0
- USE COLLECT VIA DBFNTX NEW SHARED
- ELSE
- dbSelectArea('COLLECT')
- ENDIF
-
- aType := { 'HollyWood','Sports','Star-Trek','Comics','Books','Other' }
-
- aSubType := ;
- { 'Artifact','Document','Signature','Photo','Trading-Card','Other' }
-
- aLocation := ;
- { 'Bedroom Safe','On Wall','Safe Deposit',"Don't Know",'Secret','Other' }
-
- aForSale := { 'Not for Sale','For Sale','Not Sure' }
-
- aPres := ;
- { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE }, /* Header FG Color */ ;
- { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, /* Header BG Color */ ;
- { XBP_PP_COL_HA_ALIGNMENT, XBPALIGN_HCENTER }, /* Align Header */ ;
- { XBP_PP_COL_DA_ROWSEPARATOR, XBPCOL_SEP_DOTTED }, /* Row Sep */ ;
- { XBP_PP_COL_DA_COLSEPARATOR, XBPCOL_SEP_DOTTED }, /* Col Sep */ ;
- { XBP_PP_COL_DA_ROWHEIGHT, 20 }, /* Row Height */ ;
- { XBP_PP_COL_DA_CELLHEIGHT, 20 }, /* Cell Height */ ;
- { XBP_PP_COL_DA_HILITE_FGCLR, GRA_CLR_BLUE }, /* Cursor FG Color*/ ;
- { XBP_PP_COL_DA_HILITE_BGCLR, GRA_CLR_YELLOW } } /* Cursor BG Color*/
-
- bForSale := {|n|IIF(n==NIL.OR.COLLECT->for_sale=n,COLLECT->for_sale,COLLECT->for_sale:=n)}
-
- aColors := { {GRA_CLR_BLACK,GRA_CLR_GREEN}, ;
- {GRA_CLR_BLACK,GRA_CLR_RED}, ;
- {GRA_CLR_BLACK,GRA_CLR_BLUE} }
-
- cAlias := 'COLLECT'
-
- cTitle := 'My Personal Collection Inventory'
-
- cSource := MemoRead('XDEMO1.PRG')
- IF Empty(cSource)
- cSource := MemoRead('..\PRG\XDEMO1.PRG')
- ENDIF
- IF Empty(cSource)
- cSource := 'XDEMO1.PRG cannot be found'
- ENDIF
-
- XDemo1_LoadFields( aApp, -1 )
-
- _BuildGets( @GetList, aApp, oDialog )
-
- nRecord := COLLECT->(RecNo())
- aGetList := GetList
-
- /* -- Build Options Array -- */
-
- nWidth := AppDeskTop():currentSize()[1]
- nHeight := AppDeskTop():currentSize()[2]
-
- IF nWidth <= 800
- nSayWidth := 130
- cSayFont := '8.Helv'
- cGetFont := '10.Courier'
- nColPixels := 7
- nRowPixels := 20
- ELSEIF nWidth <= 1024
- cSayFont := '10.Helv'
- cGetFont := '12.Courier'
- nSayWidth := 160
- nColPixels := 8.5
- nRowPixels := 24
- ELSEIF nWidth <= 1280
- cSayFont := '12.Helv'
- cGetFont := '14.Courier'
- nSayWidth := 190
- nColPixels := 10
- nRowPixels := 28
- ELSE
- cSayFont := '14.Helv'
- cGetFont := '16.Courier'
- nSayWidth := 210
- nColPixels := 11.5
- nRowPixels := 32
- ENDIF
-
- DCGETOPTIONS ;
- SAYWIDTH nSayWidth ;
- NAME 'COLLECT' ;
- SAYOPTIONS XBPSTATIC_TEXT_BOTTOM ;
- HELPFILE {|c|DisplayHelp(c)} ;
- AUTORESIZE ;
- NOMAXBUTTON ;
- TABSTOP ;
- FONT cSayFont ;
- SAYFONT cSayFont ;
- GETFONT cGetFont ;
- ROWPIXELS nRowPixels ;
- ROWSPACE nRowPixels ;
- COLPIXELS nColPixels ;
- ABORTQUERY ;
- CLOSEQUERY MSG {||DC_MsgBox(,, ;
- {'Are you sure you want to Exit this program?'},,,,.t.) } ;
- EVAL {|o|SetAppWindow(o)} ;
- TOOLTIPCOLOR GRA_CLR_BLACK, GRA_CLR_YELLOW ;
- HILITEGETS GRA_CLR_RED ;
- BUTTONSOUND { 'type.wav' } ;
- CASCADE
-
- DCREAD GUI ;
- PARENT @oDlg ;
- TITLE cTitle ;
- OPTIONS GetOptions ;
- APPWINDOW oDialog ;
- EVAL {||oDialog:show()} ;
- WRITESOURCE 'XDEMO1.SRC' ;
- FIT
-
- #ifdef EXPRESS17
- DC_BitmapTransparentColor(nTransColor)
- #endif
-
- IF !Empty(Alias())
- dbCloseAll()
- ENDIF
-
- DC_GetPopupCaption(aPopup)
-
- slIsRunning := .f.
-
- RETURN nil
-
- * ---------------------
-
- STATIC PROCEDURE _BuildGets ( GetList, aApp, oDialog )
-
- LOCAL xNIL, aCoords
-
- GetList := {}
-
- DC_DotHotKey(xbeK_ALT_F12)
-
- /* ---- Tab Page #1 ---- */
-
- @ .5,1 DCTABPAGE oTabPage1 CAPTION 'C&ollection' ;
- SIZE 74,14.8 PREOFFSET 0 POSTOFFSET 85 ;
- MESSAGE {||'General information about the Collectible'} INTO oMsgBox1 ;
- TITLE 'TAB-PAGE 1 (Collection)' ;
- ACCELKEY xbeK_ALT_O ;
- STATICAREA oTab1Static ;
- HELPCODE 'COLLECTION' ;
- GOTFOCUS {||SetAppFocus(DC_GetObject(GetList,'DESCRIPTION'))}
-
- @ 1,2 DCSAY "Description" GET cDesc ;
- SAYRIGHTBOTTOM ;
- PARENT oTab1Static ;
- SAYSIZE 10 ;
- TABSTOP ;
- SAYTOOLTIP 'Enter the description of this item' ;
- MESSAGE 'Keep description short. You can add more in memo' INTO oMsgBox2 ;
- VALID { || IIF(Empty(cDesc),DC_WinAlert('Description Required'),nil), ;
- !Empty(cDesc) } ;
- SAYTITLE 'SAY Description' ;
- GETTITLE 'GET Description' ;
- GETID 'DESCRIPTION' ;
- HELPCODE 'DESCRIPTION'
-
- @ 3,10 DCSAY "Type" PARENT oTab1Static SAYSIZE 10 ;
- TITLE 'SAY Type'
-
- @ 3,10 DCCOMBOBOX cType LIST aType SIZE 12,6 PARENT oTab1Static ;
- TITLE 'COMBO-BOX Types' ;
- MESSAGE 'Enter the TYPE of article' INTO oMsgBox2 ;
- TYPE XBPCOMBO_SIMPLE ;
- TABSTOP ;
- ID 'TYPE' ;
- HELPCODE 'TYPE' ;
- VALID { || IIF(Empty(cType), ;
- DC_WinAlert('Type Required'),nil), ;
- !Empty(cType) }
-
-
- @ 3,30 DCSAY "Sub-Type" PARENT oTab1Static SAYSIZE 10 ;
- TITLE 'SAY Sub-Type'
-
- @ 3,30 DCCOMBOBOX cSubType LIST aSubType SIZE 12,6 PARENT oTab1Static ;
- TITLE 'COMBO-BOX Sub-Types' ;
- MESSAGE 'Enter the SUB-TYPE of article' INTO oMsgBox2 ;
- TABSTOP ;
- TYPE XBPCOMBO_SIMPLE ;
- VALID { || IIF(Empty(cSubType),DC_WinAlert('Sub-Type Required'),nil), ;
- !Empty(cSubType) } ;
- ID 'SUB_TYPE' ;
- HELPCODE 'SUB_TYPE'
-
- @ 3,50 DCSAY "Location" PARENT oTab1Static SAYSIZE 10 ;
- TITLE 'SAY Location'
-
- @ 3,50 DCCOMBOBOX cLocation LIST aLocation SIZE 12,6 PARENT oTab1Static ;
- TITLE 'COMBO-BOX Locations' ;
- TABSTOP ;
- MESSAGE 'Enter the LOCATION of article' INTO oMsgBox2 ;
- TYPE XBPCOMBO_SIMPLE ;
- VALID { || IIF(Empty(cLocation),DC_WinAlert('Location-Type Required'),nil), ;
- !Empty(cLocation) } ;
- ID 'LOCATION' ;
- HELPCODE 'LOCATION'
-
- @ 11,2 DCSAY 'Comments' GET cComments GETID 'EDIT_COMMENTS' ;
- PARENT oTab1Static ;
- SAYSIZE 10 SAYRIGHTBOTTOM GETSIZE 40 ;
- GETID 'COMMENTS' ;
- MESSAGE 'Enter some Comments' INTO oMsgBox2
-
-
- /* ---- Tab Page #2 ---- */
-
- @ 0,0 DCTABPAGE oTabPage2 ;
- CAPTION 'Fin~ancial' ;
- RELATIVE oTabPage1 ;
- MESSAGE 'Financial Data about this Collectible' INTO oMsgBox1 ;
- TITLE 'TAB-PAGE 2 (Financial)' ;
- ACCELKEY xbeK_ALT_A ;
- STATICAREA oTab2Static ;
- HELPCODE 'FINANCIAL' ;
- GOTFOCUS {||SetAppFocus(DC_GetObject(GetList,'ORIGINAL_DATE'))}
-
- @ 1,2 DCSAY {||COLLECT->descrip} ;
- SAYSIZE 35 FONT "10.Helv Bold" ;
- PARENT oTab2Static ;
- COLOR {||{IIF( RecNo()>3, GRA_CLR_RED, GRA_CLR_DARKBLUE), GRA_CLR_WHITE}}
-
- @ 3,2 DCSAY " Original Date" GET dDateOrig PICT '99/99/9999' ;
- POPUP {|d|DC_PopDate(d,,,,,,2)} ;
- PARENT oTab2Static SAYRIGHTBOTTOM ;
- TABSTOP ;
- MESSAGE 'Date that article was created or discovered' INTO oMsgBox2 ;
- SAYTITLE 'SAY Original Date' ;
- GETTITLE 'GET Original Date' ;
- GETID 'ORIGINAL_DATE' ;
- HELPCODE 'ORIGINAL_DATE'
-
- @ 5,2 DCSAY " Acquired Date" GET dDateAcq PICT '99/99/9999' ;
- POPUP {|d|DC_PopDate(d,,,,,,2)} ;
- MESSAGE 'Date that article was acquired' INTO oMsgBox2 ;
- PARENT oTab2Static SAYRIGHTBOTTOM ;
- TABSTOP ;
- SAYTITLE 'SAY Acquired Date' ;
- GETTITLE 'GET Acquired Date' ;
- GETID 'ACQUIRED_DATE' ;
- HELPCODE 'ACQUIRED_DATE'
-
- @ 7,2 DCSAY "Acquired Price" GET nOrigPrice PICT '@E 99,999.99' ;
- POPUP {|n|DC_PopCalc(n)} ;
- TABSTOP ;
- MESSAGE 'Price paid for article' INTO oMsgBox2 ;
- PARENT oTab2Static SAYRIGHTBOTTOM ;
- SAYTITLE 'SAY Acquired Price' ;
- GETTITLE 'GET Acquired Price' ;
- GETID 'ACQUIRED_PRICE' ;
- HELPCODE 'ACQUIRED_PRICE'
-
- @ 9,2 DCSAY "Appraised Value" GET nApprValue PICT '@K 99,999.99' ;
- POPUP {|n|DC_PopCalc(n)} ;
- TABSTOP ;
- MESSAGE 'Current appraised value of article' INTO oMsgBox2 ;
- PARENT oTab2Static SAYRIGHTBOTTOM ;
- SAYTITLE 'SAY Appraised Value' ;
- GETTITLE 'GET Appraised Value' ;
- GETID 'APPRAISED_VALUE' ;
- HELPCODE 'APPRAISED_VALUE'
-
- @ 1,45,5,65 DCGROUP oCheckGroup PARENT oTab2Static CAPTION "Status" ;
- TITLE 'GROUP - Status' ;
- HELPCODE 'STATUS_GROUP'
-
- @ 1,2 DCCHECKBOX lOriginal PARENT oCheckGroup PROMPT 'Original Owner' ;
- TITLE 'CHECK-BOX - Original Owner' TABSTOP ;
- HELPCODE 'ORIGINAL_OWNER'
-
- @ 2,2 DC3STATE nForSale PROMPT aForSale PARENT oCheckGroup ;
- SIZE 12 ;
- TABSTOP ;
- MESSAGE 'Is this article FOR SALE?' INTO oMsgBox2 ;
- TITLE '3-STATE - For Sale?' ;
- HELPCODE 'FOR_SALE'
-
- @ 5.5,45,12.5,65 DCGROUP oRadioGroup PARENT oTab2Static ;
- CAPTION "Condition" ;
- TOOLTIP 'What is the physical condition of this card?' ;
- TITLE 'GROUP - Condition' ;
- HELPCODE 'CONDITION_GROUP'
-
- @ 1,2 DCRADIO cCondition PARENT oRadioGroup PROMPT 'M - Mint' ;
- VALUE 'M' ;
- TITLE 'RADIO BUTTON - Mint' ;
- TABSTOP ;
- TABGROUP XBP_BEGIN_GROUP ;
- HELPCODE 'CONDITION_MINT'
-
- @ 2,2 DCRADIO cCondition PARENT oRadioGroup PROMPT 'E - Excellent' ;
- VALUE 'E' ;
- TITLE 'RADIO BUTTON - Excellent' ;
- TABGROUP XBP_WITHIN_GROUP ;
- HELPCODE 'CONDITION_EXCELLENT'
-
- @ 3,2 DCRADIO cCondition PARENT oRadioGroup PROMPT 'G - Good' ;
- VALUE 'G' ;
- TITLE 'RADIO BUTTON - Good' ;
- TABGROUP XBP_WITHIN_GROUP ;
- HELPCODE 'CONDITION_GOOD'
-
- @ 4,2 DCRADIO cCondition PARENT oRadioGroup PROMPT 'F - Fair' ;
- VALUE 'F' ;
- TITLE 'RADIO BUTTON - Fair' ;
- TABGROUP XBP_WITHIN_GROUP ;
- HELPCODE 'CONDITION_FAIR'
-
- @ 5,2 DCRADIO cCondition PARENT oRadioGroup PROMPT 'P - Poor' ;
- VALUE 'P' ;
- TITLE 'RADIO BUTTON - Poor' ;
- TABGROUP XBP_END_GROUP ;
- HELPCODE 'CONDITION_POOR'
-
- /* ---- Tab Page #3 ---- */
-
- @ 0,0 DCTABPAGE oTabPage3 CAPTION '&Memo' ;
- RELATIVE oTabPage2 ;
- MESSAGE 'Memo Information' INTO oMsgBox1 ;
- TITLE 'TAB-PAGE 3 (Memo)' ;
- ACCELKEY xbeK_ALT_M ;
- STATICAREA oTab3Static ;
- GOTFOCUS {||SetAppFocus(oMemo)} ;
- HELPCODE 'MEMO_PAGE'
-
- @ 1,2 DCSAY cDesc SAYVAR cDesc SAYSIZE 35 ;
- FONT "10.Helv Bold" PARENT oTab3Static ;
- COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE ;
- TITLE 'SAY Description (Blue/White)'
-
- @ 3,2 DCSAY 'Give us a little history about this item:' ;
- PARENT oTab3Static SAYSIZE 45 ;
- TITLE 'SAY History'
-
- @ 4,2 DCMULTILINE cMemo PARENT oTab3Static SIZE 70,8 ;
- TITLE 'MULTLINE History Memo' ;
- TABSTOP ;
- MAXLINES 5 MESSAGE 'Maximum of 5 Lines';
- MAXCHARS 50 MESSAGE 'Maximum of 50 Characters';
- LINELENGTH 30 MESSAGE 'Maximum Line length is 30 characters' ;
- FONT "8.Alaska Crt" ;
- OBJECT oMemo ;
- EVAL { |o| o:RbDown := { |x,y,z| oMenuMemo:PopUp ( z, x, 2 , ;
- XBPMENU_PU_DEFAULT + XBPMENU_PU_MOUSE_RBDOWN ) } } ;
- ID 'MEMO' ;
- HELPCODE 'MEMO'
-
- DCSUBMENU oMenuMemo PROMPT "&Memo" PARENT oMemo
-
- DCMENUITEM "~Delete" PARENT oMenuMemo ACTION {||oMemo:deleteMarked()} ;
- MESSAGE 'Delete Item'
-
- DCMENUITEM "~Cut" PARENT oMenuMemo ACTION {||oMemo:cutMarked()} ;
- MESSAGE 'Cut Item'
-
- DCMENUITEM "C~opy" PARENT oMenuMemo ACTION {||oMemo:copyMarked()} ;
- MESSAGE 'Copy Item'
-
- DCMENUITEM "~Paste" PARENT oMenuMemo ACTION {||oMemo:pasteMarked()} ;
- MESSAGE 'Paste Item'
-
- DCMENUITEM "~Undo" PARENT oMenuMemo ACTION {||oMemo:undo()} ;
- MESSAGE 'Undo Item'
-
- /* ---- Tab Page #4 ---- */
-
- @ 0,0 DCTABPAGE oTabPage4 ;
- CAPTION 'P&hotos' ;
- RELATIVE oTabPage3 ;
- MESSAGE 'Photos of the Collectible Item' INTO oMsgBox1 ;
- TITLE 'TAB-PAGE 4 (Photos)' ;
- ACCELKEY xbeK_ALT_H ;
- STATICAREA oTab4Static ;
- GOTFOCUS {||SetAppFocus(DC_GetObject(GetList,'PHOTO_1'))}
-
- @ 1,2 DCSAY cDesc SAYVAR cDesc SAYSIZE 35 ;
- FONT "10.Helv Bold" PARENT oTab4Static ;
- COLOR GRA_CLR_DARKBLUE, GRA_CLR_WHITE ;
- TITLE 'SAY Description (Blue/White)' ;
- CURSOR POINTER_BUSY_1
-
- @ 4,2 DCSTATIC XBPSTATIC_TYPE_RAISEDBOX SIZE 33,9 ;
- OBJECT oPhoto1 PARENT oTab4Static ;
- TITLE 'STATIC (Photo 1)' ;
- CURSOR POINTER_PEN_1
-
- @ 4,37 DCSTATIC XBPSTATIC_TYPE_RAISEDBOX SIZE 33,9 ;
- OBJECT oPhoto2 PARENT oTab4Static ;
- TITLE 'STATIC (Photo 2)' ;
- CURSOR POINTER_PEN_1
-
- DCBITMAP cBitMap1 PARENT oPhoto1 AUTOSCALE CENTER ;
- TITLE 'BIT MAP (Photo 1)'
-
- DCBITMAP cBitMap2 PARENT oPhoto2 AUTOSCALE CENTER ;
- TITLE 'BIT MAP (Photo 2)'
-
- @ 2.5,3 DCSAY 'Photo 1' GET cBitMap1 PARENT oTab4Static ;
- SAYRIGHTBOTTOM SAYSIZE 10 ;
- GETID 'PHOTO_1' ;
- DATALINK {||DC_BitMapDraw(oPhoto1,cBitMap1)}
-
- @ 2.5,38 DCSAY 'Photo 2' GET cBitMap2 PARENT oTab4Static ;
- SAYRIGHTBOTTOM SAYSIZE 10 ;
- DATALINK {||DC_BitMapDraw(oPhoto2,cBitMap2)}
-
- /* ---- Tab Page #5 ---- */
-
- @ 0,0 DCTABPAGE oTabPage5 CAPTION '&Browse' ;
- RELATIVE oTabPage4 ;
- MESSAGE 'Browse the Database' INTO oMsgBox1 ;
- TITLE 'TAB-PAGE 5 (Browse)' ;
- ACCELKEY xbeK_ALT_B ;
- GOTFOCUS {||SetAppFocus(oBrowse)}
-
- @ 2,2 DCSTATIC XBPSTATIC_TYPE_RECESSEDBOX SIZE 70.4,12 ;
- OBJECT oBrowBox PARENT oTabPage5
-
- @ .1,.5 DCBROWSE oBrowse PARENT oBrowBox ALIAS 'COLLECT' ;
- SIZE 69.5,11.8 ;
- FREEZELEFT { 1 } ;
- PRESENTATION aPres ;
- EVAL {|o|o:itemMarked := ;
- {||XDemo1_LoadFields(aApp,DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE})} } ;
- EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITACROSS ;
- DELETE xbeK_DEL ;
- INSERT xbeK_INS ;
- HANDLER BrowseHandler REFERENCE aApp ;
- COLOR {||IIF(RecNo()%2==0, ;
- { GRA_CLR_BLACK, GRA_CLR_WHITE }, ;
- { GRA_CLR_BLUE, GRA_CLR_WHITE } )} ;
- ID 'BROWSE'
-
- DCBROWSECOL FIELD COLLECT->descrip ;
- WIDTH 11 ;
- HEADER "Description" PARENT oBrowse ;
- ID 'BROWSE_DESCRIP' ;
- VALID {|c|DC_ReadEmpty(c)} ;
- MESSAGE 'This is the Description'
-
- @ nil,nil DCCOMBOBOX COLLECT->type LIST aType SIZE nil,6 ;
- TYPE XBPCOMBO_DROPDOWN ;
- VALID { || IIF(Empty(COLLECT->type), ;
- DC_WinAlert('Type Required'),nil), ;
- !Empty(COLLECT->type) } ;
- ID 'EDITOR_TYPE'
-
- DCBROWSECOL FIELD COLLECT->type ;
- WIDTH 7 ;
- HEADER "Type" PARENT oBrowse ;
- ID 'BROWSE_TYPE' ;
- EDITOR 'EDITOR_TYPE' ;
- MESSAGE 'This is the Type of item'
-
- @ nil,nil DCCOMBOBOX COLLECT->sub_type LIST aSubType SIZE nil, 6 ;
- TYPE XBPCOMBO_DROPDOWN ;
- ID 'EDITOR_SUBTYPE'
-
- DCBROWSECOL FIELD COLLECT->sub_type ;
- WIDTH 8 ;
- HEADER "SubType" PARENT oBrowse ;
- ID 'BROWSE_SUBTYPE' ;
- EDITOR 'EDITOR_SUBTYPE' ;
- MESSAGE 'This is the Sub-Type of item'
-
- @ nil,nil DCCOMBOBOX COLLECT->location LIST aLocation SIZE nil, 6 ;
- TYPE XBPCOMBO_DROPDOWN ;
- ID 'EDITOR_LOCATION'
-
- DCBROWSECOL FIELD COLLECT->location ;
- HEADER "Location" ;
- PARENT oBrowse ;
- WIDTH 10 ;
- ID 'BROWSE_LOCATION' ;
- EDITOR 'EDITOR_LOCATION' ;
- MESSAGE 'This is where the item is stored' ;
- INTO oMsgBox2 ;
-
- @ nil,nil DC3STATE bForSale PROMPT aForSale ID 'FOR_SALE'
-
- DCBROWSECOL DATA {|a|a:={'No','Yes','Not Sure'},a[COLLECT->for_sale+1]} ;
- HEADER "ForSale?" PARENT oBrowse ;
- WIDTH 5 ;
- COLOR {||aColors[COLLECT->for_sale+1]} ;
- ID 'BROWSE_FORSALE' ;
- EDITOR 'FOR_SALE' ;
- MESSAGE 'Is this item For Sale?'
-
- @ nil, nil DCGET xNIL PICT '99/99/9999' ;
- POPUP {|d|DC_PopDate(d,,,,,,2)} ;
- GETID 'EDITOR_ORIGINAL_DATE_2' ;
- VALID {|o|DC_ReadEmpty(o:Get:VarGet())}
-
- DCBROWSECOL FIELD COLLECT->date_orig ;
- HEADER "Orig Date" PARENT oBrowse ;
- WIDTH 6 ;
- ID 'BROWSE_DESCRIP' ;
- MESSAGE 'This is the date the item fell on this earth' ;
- INTO oMsgBox2 ;
- EDITOR 'EDITOR_ORIGINAL_DATE_2'
-
- @ nil,nil DCGET xNIL PICT '99/99/9999' ;
- POPUP {|d|DC_PopDate(d,,,,,,2)} ;
- GETID 'EDITOR_ACQUIRED_DATE'
-
- DCBROWSECOL FIELD COLLECT->date_acqu ;
- HEADER "Acqu Date" PARENT oBrowse ;
- WIDTH 6 ;
- TOOLTIP 'This is the Date the Item was Acquired' ;
- ID 'BROWSE_DATEACQU' ;
- EDITOR 'EDITOR_ACQUIRED_DATE'
-
- @ nil,nil DCGET xNIL PICT '9,999.99' ;
- POPUP {|n|DC_PopCalc(n)} ;
- MESSAGE 'Price paid for article' INTO oMsgBox2 ;
- GETID 'ORIG_PRICE'
-
- DCBROWSECOL FIELD (cAlias)->orig_price ;
- HEADER "Acqu Price" PARENT oBrowse ;
- WIDTH 6 ;
- TOOLTIP 'This is the Original Price' ;
- PICTURE '9,999.99'
-
- @ nil,nil DCGET COLLECT->appr_value PICT '@K 99,999.99' ;
- POPUP {|n|DC_PopCalc(n)} ;
- GETID 'EDITOR_APPRAISED_VALUE'
-
- DCBROWSECOL FIELD COLLECT->appr_value ;
- HEADER "Appr Value" PARENT oBrowse ;
- WIDTH 6 ;
- ID 'BROWSE_APPRVALUE' ;
- EDITOR 'EDITOR_APPRAISED_VALUE'
-
- DCBROWSECOL FIELD COLLECT->condition ;
- HEADER "Condition" PARENT oBrowse ;
- WIDTH 1 ;
- ID 'BROWSE_CONDITION'
-
- /*
- DCBROWSECOL DATA {||IIF(COLLECT->original, ;
- BITMAP_CHECKBOX_CHECKED_S, ;
- BITMAP_CHECKBOX_UNCHECKED_S)} ;
- TYPE XBPCOL_TYPE_BITMAP ;
- HEADER "Orig Owner?" PARENT oBrowse ;
- WIDTH 3
- */
-
- DCBROWSECOL DATA {||IIF(COLLECT->original,'Yes','No')} ;
- HEADER "Orig Owner?" PARENT oBrowse ;
- WIDTH 3
-
- @ nil,nil DCGET FIELD->comments GETID 'EDITOR_COMMENTS'
-
- DCBROWSECOL FIELD COLLECT->comments ;
- HEADER "Comments" PARENT oBrowse ;
- WIDTH 25 ;
- ID 'BROWSE_COMMENTS' ;
- EDITOR 'EDITOR_COMMENTS'
-
- @ nil,nil DCMULTILINE COLLECT->memo SIZE 20,5 ;
- FONT "8.Alaska Crt" ;
- ID 'EDITOR_MEMO'
-
- DCBROWSECOL FIELD COLLECT->memo ;
- HEADER "Memo" PARENT oBrowse ;
- WIDTH 30 ;
- MESSAGE 'Press the F10 key to Exit Memo Editor' INTO oMsgBox2 ;
- EDITOR 'EDITOR_MEMO' EXITKEY xbeK_F10
-
- /* ---- Tab Page #6 ---- */
-
- @ 0,0 DCTABPAGE oTabPage6 ;
- CAPTION 'So~urce' ;
- RELATIVE oTabPage5 ;
- MESSAGE 'Source code for this entire Dialog' INTO oMsgBox1 ;
- TITLE 'TAB-PAGE 6 (Source)' ;
- ACCELKEY xbeK_ALT_U
-
- @ 1.2,1 DCMULTILINE cSource PARENT oTabPage6 SIZE 72,13.5 ;
- FONT "8.Alaska Crt" EDITPROTECT {||.t.} ;
- TITLE 'MULTILINE (Source)'
-
- /* ---- Tool Bar ---- */
-
- @ 1,76 DCTOOLBAR oToolBar ;
- FANCY ;
- SIZE 9,17.2 ;
- TITLE 'TOOLBAR (Top)' ;
- BUTTONSIZE 9,1.5
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION { BITMAP_TOP_1, BITMAP_TOP_2 } ;
- PARENT oToolBar ;
- TOOLTIP 'Go to the Top of the File' ;
- OBJECT oTopButton ;
- ACTION {||XDemo1_TestChanged(aApp),dbGoTop(), ;
- XDemo1_LoadFields(aApp)} ;
- WHEN {||RecNo() > 1}
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION { BITMAP_PREVIOUS_1, BITMAP_PREVIOUS_2 } ;
- PARENT oToolBar ;
- OBJECT oPrevButton ;
- ACTION {||XDemo1_TestChanged(aApp),dbSkip(-1), ;
- XDemo1_LoadFields(aApp)} ;
- WHEN {||RecNo() > 1 }
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION { BITMAP_NEXT_1, BITMAP_NEXT_2 } ;
- PARENT oToolBar ;
- TOOLTIP 'Skip to the Next Record' ;
- OBJECT oNextButton ;
- ACTION {||XDemo1_TestChanged(aApp),dbSkip(), ;
- XDemo1_LoadFields(aApp)} ;
- WHEN {||RecNo() < LastRec()}
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION { BITMAP_BOTTOM_1, BITMAP_BOTTOM_2 } ;
- PARENT oToolBar ;
- TOOLTIP 'Go to the Bottom of the File' ;
- OBJECT oBottButton ;
- ACTION {||XDemo1_TestChanged(aApp),dbGoBottom(), ;
- XDemo1_LoadFields(aApp)} ;
- WHEN {||RecNo() < LastRec()}
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION BITMAP_NEW_1 ;
- PARENT oToolBar ;
- ACCELKEY xbeK_ALT_N ;
- TOOLTIP 'Add a New Item to the Collection' ;
- ACTION {|x|XDemo1_TestChanged(aApp), ;
- x:=DC_MsgBox(,,{'Add a New Item?'},,,,.t.),;
- IIF(x,AddRec(5),nil),;
- dbUnlock(), ;
- XDemo1_LoadFields(aApp),;
- SetAppFocus(oTabPage1) }
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION {||{BITMAP_DELETE_1,BITMAP_DELETE_1}} ;
- PARENT oToolBar ;
- ACCELKEY xbeK_ALT_D ;
- TOOLTIP 'Delete Selected Item from Collection' ;
- ACTION {|x|SetAppFocus(oTabPage1),;
- x:=DC_MsgBox(,,{'Delete this Item?'},,,,.t.),;
- RecLock(5),;
- IIF(x,dbDelete(),nil),;
- dbUnlock(),;
- IIF(x,dbSkip(),nil), ;
- IIF(x,dbSkip(-1),nil), ;
- XDemo1_LoadFields(aApp) }
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION BITMAP_SAVE_1 ;
- PARENT oToolBar ;
- ACCELKEY xbeK_ALT_S ;
- TOOLTIP 'Save Changes to the File' ;
- ACTION {||XDemo1_SaveFields(aApp),;
- DC_GetRefresh(Getlist)}
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION BITMAP_PRINT_1 ;
- PARENT oToolBar ;
- TOOLTIP 'Send data to Printer;to a file or;preview on screen' ;
- ACTION {|a,b,o|oMenuPrint:PopUp( o, o:currentPos(), 2 , ;
- XBPMENU_PU_DEFAULT + XBPMENU_PU_MOUSE_RBDOWN ) }
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION BITMAP_UTIL_1 ;
- PARENT oToolBar ;
- TOOLTIP 'Pack the File;Permanently remove Deleted Records ' ;
- ACTION {||Pack(aApp)}
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
- DCADDBUTTON CAPTION BITMAP_EXIT_1 ;
- PARENT oToolBar ;
- TOOLTIP 'Exit the program' ;
- ACTION {||DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)}
-
- DCADDBUTTON TYPE XBPSTATIC_TYPE_RAISEDRECT ;
- SIZE 9,.2 PARENT oToolBar
-
-
- /* ---- Message Box ---- */
-
- @ 16,1 DCMESSAGEBOX OBJECT oMsgBox1 FONT cSayFont ;
- SIZE 73 ;
- TITLE 'MESSAGE BOX' ;
- COLOR GRA_CLR_DARKBLUE, GRA_CLR_PALEGRAY ;
- TYPE XBPSTATIC_TYPE_RECESSEDBOX
-
- @ 17,1 DCMESSAGEBOX OBJECT oMsgBox2 FONT cSayFont ;
- SIZE 73 ;
- COLOR GRA_CLR_DARKRED, GRA_CLR_PALEGRAY ;
- TYPE XBPSTATIC_TYPE_RECESSEDBOX
-
- /* ---- Print Pop-up Menu ---- */
-
- DCSUBMENU oMenuPrint PROMPT "&Print" PARENT oMenuBar INDEX nMenuPrint
-
- DCMENUITEM "&Print List (@..SAY method)" INDEX nMenuList PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintList(.f.)}
-
- DCMENUITEM "&List Preview (@..SAY method)" INDEX nMenuList PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintList(.t.)}
-
- DCMENUITEM SEPARATOR PARENT oMenuPrint
-
- DCMENUITEM "Print Li&st (QOUT method)" INDEX nMenuList PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintListQ(.f.)}
-
- DCMENUITEM "List Previe&w (QOUT method)" INDEX nMenuList PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintListQ(.t.)}
-
- DCMENUITEM SEPARATOR PARENT oMenuPrint
-
- DCMENUITEM "Prin&t List (FORM method)" INDEX nMenuList PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintListF(.f.)}
-
- DCMENUITEM "List Pr&eview (FORM method)" INDEX nMenuList PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintListF(.t.)}
-
- DCMENUITEM SEPARATOR PARENT oMenuPrint
-
- DCMENUITEM "Print &Item to a SELECTED Printer" INDEX nMenuItem PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintItem(1)}
-
- DCMENUITEM "Print I&tem to DEFAULT Printer" INDEX nMenuItem PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintItem(4)}
-
- DCMENUITEM "Item Pre&view" INDEX nMenuItem PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintItem(2)}
-
- DCMENUITEM "Item to &File" INDEX nMenuItem PARENT oMenuPrint ;
- ACTION {||XDemo1_PrintItem(3)}
-
-
- RETURN
-
- /* ------------------- */
-
- PROCEDURE XDemo1_LoadFields ( aApp, nRefreshMode, aRefreshList )
-
- cDesc := COLLECT->descrip
- cType := COLLECT->type
- cSubType := COLLECT->sub_type
- cLocation := COLLECT->location
- dDateOrig := COLLECT->date_orig
- cMemo := COLLECT->memo
- dDateAcq := COLLECT->date_acqu
- nOrigPrice := COLLECT->orig_price
- nApprValue := COLLECT->appr_value
- cComments := COLLECT->comments
- lOriginal := COLLECT->original
- nForSale := COLLECT->for_sale
- cCondition := COLLECT->condition
- cBitMap1 := COLLECT->bitmap1
- cBitMap2 := COLLECT->bitmap2
-
- IF Eof()
- dbSkip(-1)
- ENDIF
- IF nRefreshMode = nil .OR. nRefreshMode > -1
- DC_GetRefresh(aGetList, nil, nRefreshMode, aRefreshList )
- DC_GetOrigSet( aGetList ) // Store new values to ORIG field in Getlist
- ENDIF
-
- nRecord := RecNo()
-
- RETURN
-
- /* ------------------ */
-
- PROCEDURE XDemo1_SaveFields ( aApp )
-
- IF Reclock(5)
-
- REPL COLLECT->descrip WITH cDesc
- REPL COLLECT->type WITH cType
- REPL COLLECT->sub_type WITH cSubType
- REPL COLLECT->location WITH cLocation
- REPL COLLECT->date_orig WITH dDateOrig
- REPL COLLECT->memo WITH cMemo
- REPL COLLECT->date_acqu WITH dDateAcq
- REPL COLLECT->orig_price WITH nOrigPrice
- REPL COLLECT->appr_value WITH nApprValue
- REPL COLLECT->comments WITH cComments
- REPL COLLECT->original WITH lOriginal
- REPL COLLECT->for_sale WITH nForSale
- REPL COLLECT->condition WITH cCondition
- REPL COLLECT->bitmap1 WITH cBitMap1
- REPL COLLECT->bitmap2 WITH cBitMap2
- UNLOCK
-
- DC_MsgBox(,,{'Record has been saved!'},,,,.f.,1)
- DC_GetOrigSet( aGetList ) // Store new values to ORIG field in Getlist
-
- ENDIF
-
- RETURN
-
- /* ------------------- */
-
- PROCEDURE XDemo1_TestChanged ( aApp )
-
- IF nRecord = COLLECT->(RecNo()) .AND. DC_GetOrigUpdated( aGetList )
- IF DC_MsgBox(,,{'Data has been modified. Save Changes?'},,,,.t.)
- XDemo1_SaveFields(aApp)
- ENDIF
- ENDIF
- RETURN
-
- /* ------------------- */
-
- FUNCTION XDemo1_PrintItem ( nMode )
-
- LOCAL aFor_Sale, oPrinter, i, nLineCount, cMemo, cMemoLine, cScrn, ;
- nRecNo := RecNo()
-
- SELE collect
-
- GO TOP
-
- aFor_Sale := { 'No','Yes','Not Sure' }
-
- BEGIN SEQUENCE
-
- IF nMode = 1 // Standard Print
- DCPRINT ON SIZE 60,80 TO oPrinter FONT '12.Courier New'
- ELSEIF nMode = 4 // Standard Print to Default Printer
- DCPRINT ON SIZE 60,80 TO oPrinter FONT '12.Courier New' USEDEFAULT
- ELSEIF nMode = 2 // Preview
- DCPRINT ON SIZE 60,80 TO oPrinter FONT '12.Courier New' ;
- PREVIEW HIDE
- ELSEIF nMode = 3 // Print to Text File
- DCPRINT ON SIZE 60,80 TO oPrinter TEXTONLY TOFILE
- ENDIF
-
- IF Valtype(oPrinter) # 'O' .OR. !oPrinter:lActive
- BREAK
- ENDIF
-
- DO WHILE !Eof() .AND. DC_PrinterOk(oPrinter)
-
- DCPRINT SIZE 66,80
-
- @ 2,2,20,35 DCPRINT BITMAP COLLECT->bitmap1 PRINTER oPrinter ;
- AUTOSCALE CENTER
-
- @ 2,37,20,70 DCPRINT BITMAP COLLECT->bitmap2 PRINTER oPrinter ;
- AUTOSCALE CENTER
-
- DCPRINT FONT '12.Courier New' PRINTER oPrinter
-
- @ 23, 5, 38, 65 DCPRINT BOX PRINTER oPrinter
-
- @ 24,7 DCPRINT SAY ' Description:' PRINTER oPrinter
- @ 25,7 DCPRINT SAY ' Type:' PRINTER oPrinter
- @ 26,7 DCPRINT SAY ' Sub-Type:' PRINTER oPrinter
- @ 27,7 DCPRINT SAY ' Condition:' PRINTER oPrinter
- @ 28,7 DCPRINT SAY ' Location:' PRINTER oPrinter
- @ 29,7 DCPRINT SAY ' For Sale?:' PRINTER oPrinter
- @ 30,7 DCPRINT SAY ' Original Date:' PRINTER oPrinter
- @ 31,7 DCPRINT SAY ' Acquired Date:' PRINTER oPrinter
- @ 32,7 DCPRINT SAY ' Original Price:' PRINTER oPrinter
- @ 33,7 DCPRINT SAY 'Appraised Value:' PRINTER oPrinter
- @ 34,7 DCPRINT SAY ' Comments:' PRINTER oPrinter
- @ 35,7 DCPRINT SAY ' Bit Map 1:' PRINTER oPrinter
- @ 36,7 DCPRINT SAY ' Bit Map 2:' PRINTER oPrinter
-
- DCPRINT FONT '14.Terminal' PRINTER oPrinter
-
- @ 24,25 DCPRINT SAY COLLECT->descrip PRINTER oPrinter
- @ 25,25 DCPRINT SAY COLLECT->type PRINTER oPrinter
- @ 26,25 DCPRINT SAY COLLECT->sub_type PRINTER oPrinter
- @ 27,25 DCPRINT SAY COLLECT->condition PRINTER oPrinter
- @ 28,25 DCPRINT SAY COLLECT->location PRINTER oPrinter
- @ 29,25 DCPRINT SAY aFor_Sale[COLLECT->for_sale+1] PRINTER oPrinter
- @ 30,25 DCPRINT SAY COLLECT->date_orig PRINTER oPrinter
- @ 31,25 DCPRINT SAY COLLECT->date_acqu PRINTER oPrinter
- @ 32,25 DCPRINT SAY COLLECT->orig_price PRINTER oPrinter
- @ 33,25 DCPRINT SAY COLLECT->appr_value PRINTER oPrinter
- @ 34,25 DCPRINT SAY COLLECT->comments PRINTER oPrinter
- @ 35,25 DCPRINT SAY COLLECT->bitmap1 PRINTER oPrinter
- @ 36,25 DCPRINT SAY COLLECT->bitmap2 PRINTER oPrinter
-
- DCPRINT FONT '16.Arial' PRINTER oPrinter
-
- DCPRINT SIZE 40,80
-
- cMemo := Alltrim(COLLECT->memo)
- nLineCount := MLCount(cMemo)
- FOR i := 1 TO nLineCount - 1
- cMemoLine := MemoLine( cMemo, nil, i )
- @ 25+i,7 DCPRINT SAY cMemoLine PRINTER oPrinter
- NEXT
-
- SKIP
-
- IF !Eof()
- DCPRINT EJECT
- ENDIF
-
- ENDDO
-
- DCPRINT OFF PRINTER oPrinter
-
- GO nRecNo
-
- END SEQUENCE
-
- RETURN nil
-
- /* ------------------- */
-
- FUNCTION XDemo1_PrintList ( lPreview )
-
- LOCAL nRow, nSaveRec, cScrn, aFor_Sale, cFontName, oPrinter, i, nStartRow
-
- SELE collect
- nSaveRec := RecNo()
- GO TOP
-
- aFor_Sale := { 'No','Yes','Not Sure' }
-
- BEGIN SEQUENCE
-
- IF lPreview
- DCPRINT ON SIZE 50,98 FONT '9.Terminal' TO oPrinter PREVIEW HIDE
- ELSE
- DCPRINT ON SIZE 50,98 FONT '9.Terminal' TO oPrinter
- ENDIF
-
- IF Valtype(oPrinter) # 'O' .OR. !oPrinter:lActive
- BREAK
- ENDIF
-
- cFontName := oPrinter:GetFontCompoundName()
-
- FOR i := 1 TO oPrinter:nCopies
-
- GO TOP
- nRow := 3
- oPrinter:nPage := 1
-
- DO WHILE !Eof() .AND. DC_PrinterOk()
-
- IF nRow <= 3
-
- DCPRINT FONT '14.Arial Bold'
-
- @ nRow, 5, nRow+1.5, 90 DCPRINT BOX
-
- @ nRow,10 DCPRINT SAY 'My Personal Collection Inventory'
- @ nRow,50 DCPRINT SAY 'Page ' + Alltrim(Str(oPrinter:nPage))
- @ nRow,70 DCPRINT SAY Date()
-
- nRow += 3
- nStartRow := nRow
- @ nRow+.5, 4, nRow+.5, 94 DCPRINT LINE
-
- DCPRINT FONT '12.Arial Bold'
-
- @ nRow+.5,5 DCPRINT SAY 'Description'
- @ nRow+.5,40 DCPRINT SAY 'Type'
- @ nRow+.5,55 DCPRINT SAY 'Sub-Type'
- @ nRow+.5,70 DCPRINT SAY 'Cond'
- @ nRow+.5,76 DCPRINT SAY 'For Sale?'
- @ nRow+.5,87 DCPRINT SAY 'Value'
- nRow += 2
-
- DCPRINT FONT cFontName
-
- ELSE
-
- @ nRow+.3, 4, nRow+.3, 94 DCPRINT LINE
-
- @ nRow,5 DCPRINT SAY COLLECT->descrip
- @ nRow,40 DCPRINT SAY COLLECT->type
- @ nRow,55 DCPRINT SAY COLLECT->sub_type
- @ nRow,70 DCPRINT SAY COLLECT->condition
- @ nRow,76 DCPRINT SAY aFor_Sale[COLLECT->for_sale+1]
- @ nRow,87 DCPRINT SAY Str(COLLECT->appr_value,7,2)
- nRow++
-
- SKIP
-
- IF nRow > ( oPrinter:nRows - 5 ) .OR. Eof()
- nRow += .5
- nStartRow += .5
- @ nRow, 4, nRow, 94 DCPRINT LINE
- @ nStartRow, 4, nRow, 4 DCPRINT LINE
- @ nStartRow,39, nRow,39 DCPRINT LINE
- @ nStartRow,54, nRow,54 DCPRINT LINE
- @ nStartRow,69, nRow,69 DCPRINT LINE
- @ nStartRow,75, nRow,75 DCPRINT LINE
- @ nStartRow,86, nRow,86 DCPRINT LINE
- @ nStartRow,94, nRow,94 DCPRINT LINE
- IF !Eof()
- DCPRINT EJECT
- ENDIF
- nRow := 3
- ENDIF
-
- ENDIF
-
- ENDDO
-
- NEXT
-
- END SEQUENCE
-
- DCPRINT OFF
-
- GO nSaveRec
- RETURN nil
-
- /* ------------------- */
-
- FUNCTION XDemo1_PrintListQ ( lPreview )
-
- LOCAL nRow, nSaveRec, cScrn, aFor_Sale, cFontName, oPrinter, i
-
- SELE collect
- nSaveRec := RecNo()
- GO TOP
-
- aFor_Sale := { 'No','Yes','Not Sure' }
-
- BEGIN SEQUENCE
-
- IF lPreview
- DCPRINT ON SIZE 50,90 FONT '9.Terminal' TO oPrinter PREVIEW HIDE
- ELSE
- DCPRINT ON SIZE 50,90 FONT '9.Terminal' TO oPrinter
- ENDIF
-
- IF Valtype(oPrinter) # 'O' .OR. !oPrinter:lActive
- BREAK
- ENDIF
-
- cFontName := oPrinter:GetFontCompoundName()
-
- FOR i := 1 TO oPrinter:nCopies
-
- GO TOP
- nRow := 3
- oPrinter:nPage := 1
- DCPRINT ?
- DCPRINT ?
- DO WHILE !Eof()
-
- IF nRow <= 3
-
- DCPRINT FONT '14.Arial Bold'
-
- DCPRINT ? 'My Personal Collection Inventory '
- DCPRINT ?? 'Page ' + Alltrim(Str(oPrinter:nPage))
- DCPRINT ?? ' '
- DCPRINT ?? Date()
- DCPRINT ?
-
- nRow += 2
-
- DCPRINT FONT '12.Arial Bold'
-
- DCPRINT ? Pad('Description',35)
- DCPRINT ?? Pad('Type',15)
- DCPRINT ?? Pad('Sub-Type',15)
- DCPRINT ?? Pad('Cond',6)
- DCPRINT ?? Pad('For Sale?',11)
- DCPRINT ?? 'Value'
- DCPRINT ?
-
- nRow += 2
-
- DCPRINT FONT cFontName
-
- ELSE
-
- DCPRINT ? Pad(COLLECT->descrip,35)
- DCPRINT ?? Pad(COLLECT->type,15)
- DCPRINT ?? Pad(COLLECT->sub_type,15)
- DCPRINT ?? Pad(COLLECT->condition,6)
- DCPRINT ?? Pad(aFor_Sale[COLLECT->for_sale+1],11)
- DCPRINT ?? Str(COLLECT->appr_value,7,2)
- nRow++
-
- SKIP
-
- IF nRow > ( oPrinter:nRows - 5 )
- DCPRINT EJECT
- nRow := 3
- ENDIF
-
- ENDIF
-
- ENDDO
-
- NEXT
-
- END SEQUENCE
-
- DCPRINT OFF
-
- GO nSaveRec
- RETURN nil
-
- /* ------------------- */
-
- FUNCTION XDemo1_PrintListF ( lPreview )
-
- LOCAL nSaveRec
-
- SELE collect
- nSaveRec := RecNo()
- GO TOP
-
- IF lPreview
- DCREPORT FORM collect XBP FONT '10.Courier New' ;
- TITLEFONT '10.Helv Bold' HEADFONT '10.Courier New Bold' PREVIEW
- ELSE
- DCREPORT FORM collect XBP FONT '10.Courier New' ;
- TITLEFONT '10.Helv Bold' HEADFONT '10.Courier New Bold'
- ENDIF
-
- GO nSaveRec
- RETURN nil
-
- /* -------------------- */
-
- STATIC FUNCTION RecLock( nWaitTime )
-
- LOCAL nWait
-
- IF DBRLOCK()
- RETURN (.T.) // locked
- ENDIF
- DO WHILE .T.
- nWait := nWaitTime
- DO WHILE (nWaitTime=0 .OR. nWait>0)
- IF DBRLOCK() // locked
- RETURN (.T.)
- ENDIF
- INKEY(.5) // wait 1/2 second
- nWait := nWait - .5
- ENDDO
- ENDDO
- RETURN (.F.) // not locked
-
- /* -------------------- */
-
- STATIC FUNCTION AddRec ( nWaitTime )
-
- LOCAL nWait
-
- APPEND BLANK
- IF !NETERR()
- RETURN (.T.)
- ENDIF
- DO WHILE .T.
- nWait := nWaitTime
- DO WHILE (nWaitTime = 0 .OR. nWait > 0)
- APPEND BLANK
- IF .NOT. NETERR()
- RETURN .T.
- ENDIF
- nWait := nWait - .5
- ENDDO
- ENDDO
- RETURN .F.
-
- /* --------------------- */
-
- STATIC FUNCTION FiLock( nWaitTime )
-
- LOCAL nWait
-
- IF FLOCK()
- RETURN (.T.) // locked
- ENDIF
- DO WHILE .T.
- nWait := nWaitTime
- DO WHILE (nWaitTime=0 .OR. nWait>0)
- INKEY(.5) // wait 1/2 second
- nWait := nWait - .5
- IF FLOCK()
- RETURN (.T.) // locked
- ENDIF
- ENDDO
- ENDDO
- RETURN .F.
-
- /* ------------------- */
-
- STATIC FUNCTION Pack ( aApp )
-
- LOCAL lIsShared := dbInfo( DBO_SHARED )
-
- IF lIsShared
- IF DC_MsgBox(,,{'The file must be opened exclusive to Pack.',;
- 'Close file and reopen exclusive?'},,,,.t.)
- dbCloseArea()
- USE collect EXCLUSIVE VIA DBFNTX
- ENDIF
- ENDIF
-
- lIsShared := dbInfo( DBO_SHARED )
-
- IF !lIsShared
- dbPack()
- dbGoTop()
- XDemo1_LoadFields( aApp )
- ENDIF
-
- RETURN nil
-
- /* ------------------------- */
-
- STATIC FUNCTION _SetCaption( nButton, aApp )
-
- LOCAL nBitMap, oButton
-
- IF nButton = 1
- nBitMap := IIF(COLLECT->(RecNo())>1,BITMAP_TOP_1,BITMAP_TOP_2)
- oButton := oTopButton
- ELSEIF nButton = 2
- oButton := oPrevButton
- nBitMap := IIF(COLLECT->(RecNo())>1,BITMAP_PREVIOUS_1,BITMAP_PREVIOUS_2)
- ELSEIF nButton = 3
- oButton := oNextButton
- nBitMap := IIF(COLLECT->(RecNo()) < COLLECT->(RecCount()), ;
- BITMAP_NEXT_1,BITMAP_NEXT_2)
- ELSEIF nButton = 4
- oButton := oBottButton
- nBitMap := IIF(COLLECT->(RecNo()) # COLLECT->(RecCount()), ;
- BITMAP_BOTTOM_1,BITMAP_BOTTOM_2)
- ENDIF
- IF oButton:caption # nBitMap
- oButton:setCaption(nBitMap)
- ENDIF
- RETURN .t.
-
- /* --------------------- */
-
- STATIC FUNCTION ;
- BrowseHandler ( nEvent, mp1, mp2, oXbp, oDialog, GetList, aApp )
-
- RETURN DCGUI_NONE
-
- * -----------------------
-
- STATIC FUNCTION DisplayHelp( cHelpCode )
-
- LOCAL aHelp, nFound
-
- aHelp := { { 'COLLECTION','This is the COLLECTION TabPage' }, ;
- { 'DESCRIPTION','Enter a Description of the Item' }, ;
- { 'TYPE','Enter the Type of the Item' }, ;
- { 'SUB_TYPE','Enter the Sub-Type of the Item' }, ;
- { 'LOCATION','Enter the Location of the Item' } }
-
- nFound := AScan( aHelp, {|a|a[1]==cHelpCode} )
- IF nFound > 0
- DC_MsgBox(aHelp[nFound])
- ELSE
- DC_WinAlert( 'Sorry! No Help Available for this object' )
- ENDIF
-
- RETURN nil
-
-
-