Re: Treeviews
From: James J. Gavan (jgavandeletethis_at_shaw.ca)
Date: 02/25/05
- Next message: Kellie Fitton: "Re: Treeviews"
- Previous message: Richard: "Re: moving data from one place to another in a text file"
- In reply to: docdwarf_at_panix.com: "Re: Treeviews"
- Next in thread: Donald Tees: "Re: Treeviews"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Date: Fri, 25 Feb 2005 19:41:37 GMT
Ok Kellie, this is it :-
# 1 - This is invoked from a controlling class which I call CheeseDriver
- It's the Cheesedriver that displays the Treeview and Popup Menu. This
is handling all references to Cheese - COBOL files (which will be DB
Tables in the 'real world' application), creation of the Dialog using #
2 below, and at the bottom you see the events being returned from the
Dialog. (I'm in the middle of testing the logic for my Red and GreenBall
icons - so it's incomplete in that respect).
*>-----------------dbichees.cbl ------------------------------- -
Class-id. CheeseDBI
inherits from DBIMain.
Class-control. CheeseDBI is class "dbichees"
DBIMain is class "dbimain"
DialogParameters is class "dlgchees"
DroplistDialog is class "dlgdropl"
ErrorMessages is class "errmessg"
MakeAstring is class "makstrng"
*> TabbedDialog is class "dlgtabbd"
Callback is class "callback"
.
*>--------------------------------------------------------------
FACTORY.
*>--------------------------------------------------------------
END FACTORY.
*>-------------------------------------------------------------
OBJECT.
*>--------------------------------------------------------------
OBJECT-STORAGE SECTION.
*>--------------------------------------------------------------
copy "p2cevent.cpy".
copy "\copylib\RecordFlags.cpy".
copy "\copylib\dlgParams.cpy" replacing ==(tag)== by ==Dialog==.
copy "dlgcheese.cpy".
*> Note : "dlgxxxx.cpy" APPEARS AFTER "dlgParams.cpy"
01 Cheese-Info.
copy "\copylib\sqlResult.cpy"
replacing ==(tag)== by ==05 Cheese==.
copy "Cheese2.cpy" replacing ==(tag1)== by ==05 Cheese==
==(tag)== by ==Cheese==.
01 ws-Response pic x(4) comp-5.
78 TextLength value 30.
01 ws-Length pic x(4) comp-5 value TextLength.
01 ws-Text pic x(Textlength).
01 ws-TextsB.
05.
10 ws-OldCheeseKey pic 9(06).
10 ws-OldCheeseName pic x(20).
05.
10 ws-OldCountryKey pic x(02).
10 ws-OldCountryName pic x(14).
05.
10 ws-ContinentKey pic x(02).
*> Flags...
01 CheeseFlag pic 9 value 0.
88 CheeseNameChanged value 1.
88 CheeseNameNotChanged value 0.
01 CountryFlag pic 9.
88 CountryChanged value 1.
88 CountryNotChanged value 0.
01 ErrorCode pic x(4) comp-5.
88 ValidationOK value 0.
88 Error-BlankName value 1.
88 Error-Exists value 2.
88 Error-Info value 1 thru 5.
88 OKtoDelete value 6.
88 Error-YesNo value 6.
88 ValidationError value 1 thru 99.
01 Icon-Flag pic x(4) comp-5.
88 Level3-Add value 1.
88 Level3-Change value 2.
88 Level3-Delete value 3.
88 Level3-Move value 4.
01 LabelFlag pic x(4) comp-5.
88 ContinentLabel value 1.
88 CountryLabel value 2.
88 CheeseLabel value 3.
01 ProgramFlag pic 9(03) value 0.
88 ContinueProgram value 0.
88 CancelProgram value 99.
*> OBJECTS
01 os-CheeseDBI object reference value null.
01 os-CheeseFile object reference value null.
01 os-CountryDBI object reference value null.
01 os-CountryDropList object reference value null.
01 os-CurrentCheese object reference value null.
01 os-Dialog object reference value null.
01 os-NewContinent object reference value null.
01 os-NewCountry object reference value null.
01 os-NewCheese object reference value null.
01 os-OldContinent object reference value null.
01 os-OldCountry object reference value null.
01 os-Resource object reference value null.
01 os-Treeview object reference value null.
01 os-TvDialog object reference value null.
*>--------------------------------------------------------------
Method-id. "begin".
*>--------------------------------------------------------------
Linkage section.
01 lnk-CheeseFile object reference.
01 lnk-CountryDBI object reference.
01 lnk-CountryDropList object reference.
01 lnk-Resource object reference.
01 lnk-Treeview object reference.
01 lnk-TvDialog object reference.
Procedure Division using lnk-CheeseFile
lnk-CountryDBI
lnk-CountryDropList
lnk-Resource
lnk-Treeview
lnk-TvDialog
.
set os-CheeseFile to lnk-CheeseFile
set os-CountryDBI to lnk-CountryDBI
set os-CountryDropList to lnk-CountryDropList
set os-Resource to lnk-Resource
set os-Treeview to lnk-Treeview
set os-TvDialog to lnk-TvDialog
End Method "begin".
*>-------------------------------------------------------------
Method-id. "addRecord".
*>-------------------------------------------------------------
Linkage section.
01 lnk-TvCountry object reference.
Procedure Division using lnk-TvCountry.
if os-Dialog = null
invoke self "createDialog"
End-if
set os-OldCountry to lnk-TvCountry
set CountryLabel to true
invoke self "getTvLabel" using os-OldCountry
set RecordNotFound to true
set RecordNotChanged to true
initialize Cheese-Info
move ws-OldCountryKey to Cheese-CountryCode
invoke os-Dialog "clear"
invoke os-Dialog "setRecordFlags" using
RecordChangedFlag, RecordFoundFlag
invoke self "displayCountry"
set Field-EF-CheeseCode to true
invoke os-Dialog "setNextFocusEmpty" using Dialog-Params
End Method "addRecord".
*>-------------------------------------------------------------
Method-id. "changeRecord".
*>-------------------------------------------------------------
Linkage section.
01 lnk-TvCheese object reference.
Procedure Division using lnk-TvCheese.
if os-Dialog = null
invoke self "createDialog"
End-if
invoke lnk-TvCheese "getAncestor" returning os-OldCountry
invoke os-OldCountry "getAncestor" returning os-OldContinent
set CountryLabel to true
invoke self "getTvLabel" using os-OldCountry
set CheeseLabel to true
invoke self "getTvLabel" using lnk-TvCheese
set os-CurrentCheese to lnk-TvCheese
set RecordNotFound to true
set RecordNotChanged to true
set CheeseNameNotChanged to true
set CountryNotChanged to true
move ws-OldCheeseKey to Cheese-PrimeKey
invoke self "getRecord"
Evaluate true
when RecordFound
invoke os-Dialog "setRecordFlags"
using RecordChangedFlag, RecordFoundFlag
set Field-EF-CheeseCode to true
invoke os-Dialog "setDisable" using Dialog-Params
move length of Cheese-ProductCode1 to Dialog-Length
move Cheese-ProductCode1 to Dialog-Text
invoke os-Dialog "setEntryField" using Dialog-Params
set Field-EF-CheeseNAME to true
move length of Cheese-Name to Dialog-Length
move Cheese-Name to Dialog-Text
invoke os-Dialog "setEntryField" using Dialog-Params
invoke self "displayCountry"
invoke os-Dialog "setFocusDefault"
when CancelProgram
invoke self "PB-Exit"
when other
invoke self "PB-Cancel"
End-Evaluate
End Method "changeRecord".
*>-------------------------------------------------------------
Method-id. "createDialog".
*>-------------------------------------------------------------
01 ls-id pic x(4) comp-5.
01 ls-template object reference.
*> This dialog uses a Coloured ComboBox Droplist
move Cheese-Dialog to ls-id
invoke DropListDialog "start"
using os-TvDialog, os-Resource, ls-id,
returning os-Dialog
invoke os-Dialog "begin" using self
invoke DialogParameters "new" returning ls-template
invoke ls-template "begin" using os-Dialog
invoke ls-template "finalize" returning ls-template
++++++++++
***** ls-template - see #2 below -------->
++++++++++
End Method "createDialog".
*>-------------------------------------------------------------
Method-id. "deleteGroup".
*>-------------------------------------------------------------
*> Invoked from CountryDBI when a Country record is
*> to be deleted from the Treeview. Get collection of Cheeses
*> subordinate to Country. Delete individual chesse File/Table
*> records. Cheeses affected are removed from the Treeview when
*> the Parent Country label is 'destroyed'.
Local-storage section.
01 ls-number pic x(4) comp-5.
01 ls-size pic x(4) comp-5.
01 ls-string object reference.
01 ls-Callback object reference.
01 ls-CheeseTvList object reference.
Linkage section.
01 lnk-TvCountry object reference.
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 Lnk==.
Procedure Division using lnk-TvCountry
returning lnk-SqlResult.
move zeroes to lnk-SqlResult
invoke lnk-TvCountry "getItems" returning ls-CheeseTvList
invoke Callback "new"
using self "deleteGroup2 " returning ls-Callback
invoke ls-CheeseTvList "do" using ls-Callback
invoke ls-Callback "finalize" returning ls-Callback
End Method "deleteGroup".
*>-------------------------------------------------------------
Method-id. "deleteGroup2". *> Callback Method
*>-------------------------------------------------------------
Linkage section.
01 lnk-CheeseElement object reference.
Procedure Division using lnk-CheeseElement.
set CheeseLabel to true
invoke self "getTvLabel" using lnk-CheeseElement
move ws-OldCheeseKey to Cheese-PrimeKey
invoke os-CheeseFile "deleteRecord"
using Cheese-PrimeKey returning Cheese-SqlResult
if FileError
invoke self "PB-Exit"
End-If
End Method "deleteGroup2".
*>-------------------------------------------------------------
Method-id. "deleteRecord".
*>-------------------------------------------------------------
Linkage section.
01 lnk-TvCheese object reference.
Procedure Division using lnk-TvCheese.
invoke lnk-TvCheese "getAncestor" returning os-OldCountry
set CheeseLabel to true
invoke self "getTvLabel" using lnk-TvCheese
set os-CurrentCheese to lnk-TvCheese
set OkToDelete to true
invoke self "messagebox"
if ws-response <> mb-return-YES
invoke self "showTheTreeview"
EXIT METHOD
End-if
move ws-OldCheeseKey to Cheese-PrimeKey
invoke os-CheeseFile "deleteRecord"
using Cheese-PrimeKey returning Cheese-SqlResult
if FileError
invoke self "PB-Exit"
else invoke lnk-TvCheese "destroy"
set Level3-Delete to true
invoke self "showTheTreeview"
End-if
End Method "deleteRecord".
*>-------------------------------------------------------------
Method-id. "displayCountry".
*>-------------------------------------------------------------
01 n pic x(4) comp-5.
copy "\copylib\lnkObjVal.cpy" replacing ==(tag)== by ==ls==.
*> Country Droplist via os-CountryDBI
set Field-DL-CountryNAME to true
if RecordFound
invoke os-Dialog "setEnable" using Dialog-Params
else invoke os-Dialog "setDisable" using Dialog-Params
End-if
*> Display Coloured Droplist
move 1 to n
set Dialog-Object to os-CountryDropList
invoke os-Dialog "SetDropListContents" using Dialog-Params, n
*> Display current Country
invoke os-CountryDBI "getObjectfromKey"
using ws-OldCountryKey returning ls-ObjectValues
set Dialog-object to ls-Object
invoke os-Dialog "setComboBoxText" using Dialog-Params
End Method "displayCountry".
*>-------------------------------------------------------------
Method-id. "finalizeObjects".
*>-------------------------------------------------------------
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 ls==.
01 ls-object object reference.
*>01 os-Callback object reference value null.
*>01 os-CheeseDBI object reference value null.
*>01 os-CheeseFile object reference value null.
*>01 os-CountryDBI object reference value null.
*>01 os-CountryDropList object reference value null.
*>01 os-CurrentCheese object reference value null.
*>01 os-Dialog object reference value null.
*>01 os-Resource object reference value null.
*>01 os-Treeview object reference value null.
*>01 os-TvList object reference value null.
*>01 os-TvDialog object reference value null.
set ls-object to os-CurrentCheese
perform FINALIZE-SINGLE
set ls-object to os-Dialog
perform FINALIZE-DIALOG
invoke self "finalize" returning self
EXIT METHOD.
copy "\copylib\finalize.cpy".
End Method "finalizeObjects".
*>-------------------------------------------------------------
Method-id. "getRecord".
*>-------------------------------------------------------------
invoke os-CheeseFile "readRecord"
using Cheese-PrimeKey returning Cheese-Info
Evaluate true
when ResultOK set RecordFound to true
when FileError set CancelProgram to true
End-Evaluate
End Method "getRecord".
*>-------------------------------------------------------------
Method-id. "getTvLabel".
*>--------------------------------------------------------------
Local-storage section.
01 ls-length pic x(4) comp-5.
01 ls-string object reference.
01 ls-TempText pic x(TextLength).
Linkage section.
01 lnk-TvItem object reference.
Procedure Division using lnk-TvItem.
invoke lnk-TvItem "getLabel" returning ls-string
invoke ls-string "SizeInBytes" returning ls-length
invoke ls-string "getValueWithSize"
using ls-length returning ls-TempText
*> This gets rid of the x"00"
move ls-TempText(1:ls-length) to ws-Text
Evaluate true
when CheeseLabel
move ws-text(1:06) to ws-OldCheeseKey
move ws-text(8:20) to ws-OldCheeseName
when CountryLabel
move ws-text(1:02) to ws-OldCountryKey
move ws-text(4:14) to ws-OldCountryName
when ContinentLabel
move ws-Text(1:02) to ws-ContinentKey
End-Evaluate
*>inspect ws-TextsB replacing all x"00" by x"20"
End Method "getTvLabel".
*>--------------------------------------------------------------
Method-id. "makeTvLabel".
*>--------------------------------------------------------------
01 ls-Length pic x(4) comp-5.
01 ls-text pic x(textlength).
01 ls-ReturnedLength pic x(4) comp-5.
01 ls-Results.
05 ls-ReturnLength pic x(4) comp-5.
05 ls-string object reference.
Linkage section.
01 lnk-object object reference.
Procedure Division returning lnk-object.
move textlength to ls-length
initialize ls-text
move Cheese-ProductCode1 to ls-text(1:6)
move Cheese-Name to ls-text(8: )
invoke MakeaString "objectWithX00"
using ls-length, ls-text
returning ls-Results
if ls-ReturnLength <> zeroes
set lnk-Object to ls-string
End-if
End Method "makeTvLabel".
*>--------------------------------------------------------------
Method-id. "messageBox".
*>--------------------------------------------------------------
Working-storage section.
78 MC value 1.
78 ML value 40.
01 wa.
05 pic x(ML) value "Name can't be blank". *> 1
01 wb redefines wa.
05 ws-message occurs MC pic x(ML).
copy "\copylib\MessageParams.cpy" replacing ==(tag)== by ==ws==.
01 ws-WindowTitle pic x(20) value "Cheese Record".
initialize ws-messageparams
move ws-Windowtitle to MessageLabel
initialize MessageText
Evaluate true
when Error-Info
set TypeInformation to true
set OK to true
when other
set TypeWarning to true
set YesNo to true
End-evaluate
Evaluate true
when Error-BlankName
string ws-message (ErrorCode) delimited by " "
x"00" delimited by size
into MessageText
End-string
when Error-Exists
string
"This code is already in use for :- "
x'0d0a'
x'0d0a'
" "
Cheese-ProductCode1
" "
Cheese-Name
x"00"
into messagetext
End-string
when OKtoDelete
string
ws-OldCheeseKey
" "
ws-OldCheesename
x"0d0a"
x"0d0a"
"Are you sure you want to DELETE ? "
x"00"
into MessageText
End-string
End-Evaluate
invoke ErrorMessages "showMessage"
using os-TvDialog, ws-MessageParams
returning ws-Response
End Method "messageBox".
*>--------------------------------------------------------------
Method-id. "moveOneElement".
*>--------------------------------------------------------------
*> The simplest way to overcome the 'possible' problem below
*> would be to re-populate the Treeview from Files/DBs - BUT -
*> that is subject to volumes involved.
*> This method "moves" a Cheese product to appear under
*> os-NewCountry and destroys the reference to the
*> Cheese under os-OldCountry
*> Subject to Levels in the Treeview - assume 00035 - Colby was
*> incorrectly setup as being a sub-Level of 43 - Turkey; it
*> should have been coded under 23 - USA. Now we need to change
*> by 'moving'; but 23 - Turkey is a sub-Level of 'Continent'
*> ME - Middle East, whereas 23 - U.S.A. is a sub-Level of
*> 'Continent' NA - North America
*> ME - Middle East NA - North America
*> [+]--- 43 - Turkey [+]--- 23 - U.S.A.
*> --- 000035 Colby ----> "new" 000035 Colby
*>
*>---------------------------------------------------------------
01 ls-Keys.
05 ls-OldContinentKey pic x(02).
05 ls-NewContinentKey pic x(02).
01 n pic x(4) comp-5.
01 ls-index pic x(4) comp-5.
01 ls-size pic x(4) comp-5.
01 ls-ContinentElement object reference.
01 ls-ContinentTvList object reference.
01 ls-CountryElement object reference.
01 ls-CountryTvList object reference.
01 ls-NewContinent object reference.
01 ls-OldContinent object reference.
01 ls-Item object reference.
01 ls-Root object reference.
Procedure Division.
invoke os-CountryDBI "getContinents"
using ws-OldCountryKey, Cheese-CountryCode returning ls-Keys
if ls-OldContinentKey = ls-NewContinentKey
invoke self "SameContinent"
EXIT METHOD
End-if
invoke os-OldCountry "getAncestor" returning os-OldContinent
move zeroes to ls-index
move 1 to n
invoke os-Treeview "itemAtIndex" using n returning ls-Root
invoke ls-Root "children" returning ls-ContinentTvList
invoke ls-ContinentTvList "size" returning ls-size
perform varying n from 1 by 1 until n > ls-size
invoke ls-ContinentTvList "at"
using n returning ls-ContinentElement
set ContinentLabel to true
invoke self "getTvLabel" using ls-ContinentElement
if ls-NewContinentKey = ws-ContinentKey
set os-NewContinent to ls-ContinentElement
move n to ls-index
EXIT PERFORM
End-if
End-perform
invoke os-NewContinent "children" returning ls-CountryTvList
invoke ls-CountryTvList "size" returning ls-size
perform varying n from 1 by 1 until n > ls-size
invoke ls-CountryTvList "at"
using n returning ls-CountryElement
set CountryLabel to true
invoke self "getTvLabel" using ls-CountryElement
if Cheese-CountryCode = ws-OldCountryKey
set os-NewCountry to ls-CountryElement
move n to ls-index
EXIT PERFORM
End-if
End-perform
invoke self "moveGroup2" using os-CurrentCheese
invoke os-CurrentCheese "destroy"
invoke os-NewContinent "expand"
invoke os-NewCountry "expand"
set os-OldCountry to os-NewCountry
invoke self "showTheTreeview"
End Method "moveOneElement".
*>--------------------------------------------------------------
Method-id. "moveGroup".
*>-------------------------------------------------------------
01 ls-Callback object reference.
01 ls-CheeseTvList object reference.
Linkage section.
01 lnk-OldCountry object reference.
01 lnk-NewCountry object reference.
Procedure Division using lnk-OldCountry, lnk-NewCountry.
set os-NewCountry to lnk-NewCountry
invoke lnk-OldCountry "children" returning ls-CheeseTvList
invoke Callback "new"
using self "moveGroup2 " returning ls-Callback
invoke ls-CheeseTvList "do" using ls-Callback
End Method "moveGroup".
*>-------------------------------------------------------------
Method-id. "moveGroup2".
*>-------------------------------------------------------------
01 ls-string object reference.
Linkage section.
01 lnk-Element object reference.
Procedure Division using lnk-Element.
if CheeseNameNotChanged
set CheeseLabel to true
invoke self "getTvLabel" using lnk-Element
move ws-OldCheeseKey to Cheese-ProductCode1
move ws-OldCheeseName to Cheese-Name
End-if
invoke self "makeTvLabel" returning ls-string
invoke os-Treeview "addItem"
using os-NewCountry, ls-string, returning os-NewCheese
End Method "moveGroup2".
*>-------------------------------------------------------------
Method-id. "RewriteRecord".
*>--------------------------------------------------------------
01 ls-index pic x(4) comp-5.
01 ls-string object reference.
*> 1 : update File/Table - CHANGED record
move Cheese-ProductCode1 to Cheese-ProductCode2
invoke os-CheeseFile "RewriteRecord"
using Cheese-Record returning Cheese-SqlResult
*>-------------------------------------------
*> CountryChanged y y n n
*> CheeseNameChanged y n y n
*>-------------------------------------------
*> Set Label - - x -
*> Move Cheese x x - -
*>--------------------------------------------
Evaluate true also true
when FileError also any
invoke self "PB-Exit"
when CountryChanged also CheeseNameChanged
when CountryChanged also CheeseNameNotChanged
++++ Ignore this - this is me dabbling trying to figure out a way using
a generalised routine to check/change the values of the Icon displays
from Red to Green
set Level3-Move to true
++++++
invoke self "moveOneElement"
when CountryNotChanged also CheeseNameChanged
*> 2 - Change Cheese Label - only the name is being
*> changed; so we don't need to check prior level
invoke self "makeTvLabel" returning ls-string
invoke os-CurrentCheese "setLabel"
using ls-string
+++++ Ditto - ignore
set Level3-Change to true
+++++++++
move 2 to ls-Index
invoke os-CurrentCheese "SetNormalImage"
using ls-Index
End-Evaluate
End Method "RewriteRecord".
*>--------------------------------------------------------------
Method-id. "sameContinent".
*>--------------------------------------------------------------
01 n pic x(4) comp-5.
01 ls-size pic x(4) comp-5.
01 ls-ContinentTvList object reference.
01 ls-CountryElement object reference.
01 ls-Item object reference.
01 ls-string object reference.
Procedure Division.
*> The Continent is identical for both Countries so we need to
*> get a handle for the new Country (os-NewCountry).
*> (1) get parent Continent, then (2) a list of Countries
*> for the parent
invoke os-OldCountry "getAncestor" returning os-OldContinent
invoke os-OldContinent "children" returning ls-ContinentTvList
invoke ls-ContinentTvList "size" returning ls-size
Perform Varying n from 1 by 1 until n > ls-size
invoke ls-ContinentTvList "at" using n
returning ls-CountryElement
set CountryLabel to true
invoke self "getTvLabel" using ls-CountryElement
if ws-OldCountryKey = Cheese-CountryCode
set os-NewCountry to ls-CountryElement
invoke self "makeTvLabel" returning ls-string
invoke os-Treeview "addItem"
using os-NewCountry, ls-string returning ls-Item
invoke os-NewCountry "expand"
invoke os-CurrentCheese "destroy"
set os-OldCountry to os-NewCountry
*>invoke os-NewCountry "setSelected"
invoke self "showTheTreeview"
EXIT PERFORM
End-if
End-perform
End Method "sameContinent".
*>--------------------------------------------------------------
Method-id. "showTheTreeview".
*>--------------------------------------------------------------
invoke os-OldCountry "setSelected"
invoke os-Treeview "show"
End Method "showTheTreeview".
*>--------------------------------------------------------------
Method-id. "writeRecord".
*>--------------------------------------------------------------
01 ls-Index pic x(4) comp-5.
01 ls-Item object reference.
01 ls-string object reference.
*> 1 : update File/Table for NEW Record
set Level3-Add to true
move Cheese-ProductCode1 to Cheese-ProductCode2
invoke os-CheeseFile "writeRecord"
using Cheese-Record returning Cheese-SqlResult
*> 2 : Add to Treeview
Evaluate true
when ResultOK
invoke self "makeTvLabel" returning ls-string
invoke os-Treeview "addItem"
using os-OldCountry, ls-string returning ls-item
move 2 to ls-Index
invoke ls-Item "SetNormalImage" using ls-Index
invoke os-OldCountry "expand"
when FileError
invoke self "PB-Exit"
End-Evaluate
End Method "writeRecord".
*>--------------------------------------------------------------
*>
*> Events returned from Dialog :-
*>
*>-------------------------------------------------------------
Method-id. "DL-CountryNAME".
*>-------------------------------------------------------------
Linkage section.
copy "\copylib\lnkObjVal.cpy" replacing ==(tag)== by ==lnk==.
Procedure Division using lnk-ObjectValues.
set RecordChanged to true
move lnk-record(29:2) to Cheese-CountryCode
if Cheese-CountryCode <> ws-OldCountryKey
set CountryChanged to true
End-if
End Method "DL-CountryNAME".
*>-------------------------------------------------------------
Method-id. "EF-CheeseCode".
*>-------------------------------------------------------------
Local-storage section.
01 ls-code pic 9(06).
Linkage section.
copy "\copylib\dlgreturn.cpy" replacing ==(tag)== by ==lnk==.
Procedure Division using lnk-ReturnValues.
compute ls-code = function numval (lnk-Text(1:6))
Evaluate true
when ls-Code = zeroes
invoke self "PB-Cancel"
when other
move ls-code to Cheese-PrimeKey
invoke self "getRecord"
Evaluate true
when RecordFound
set Error-Exists to true
invoke self "messagebox"
invoke self "addRecord"
using os-OldCountry
when CancelProgram
invoke self "PB-Exit"
when other
set Field-EF-CheeseCode to true
invoke os-Dialog "SetDisable"
using Dialog-Params
End-Evaluate
End-Evaluate
End Method "EF-CheeseCode".
*>-------------------------------------------------------------
Method-id. "EF-CheeseName".
*>-------------------------------------------------------------
Local-storage section.
01 ls-code pic x(02).
Linkage section.
copy "\copylib\dlgreturn.cpy" replacing ==(tag)== by ==lnk==.
Procedure Division using lnk-ReturnValues.
set RecordChanged to true
Evaluate true
when lnk-Text <> spaces
move lnk-Text to Cheese-Name
if Cheese-Name <> ws-OldCheeseName
set CheeseNameChanged to true
End-if
when other
set Error-BlankName to true
invoke self "messagebox"
set Field-EF-CheeseName to true
invoke os-Dialog "setNextFocusEmpty" using Dialog-Params
End-Evaluate
End Method "EF-CheeseName".
*>-------------------------------------------------------------
Method-id. "PB-Cancel".
*>-------------------------------------------------------------
invoke os-Dialog "hide"
invoke self "showTheTreeview"
End Method "PB-Cancel".
*>-------------------------------------------------------------
Method-id. "PB-Exit".
*>-------------------------------------------------------------
set CancelProgram to true
if os-TvDialog <> null
invoke os-TvDialog "hide"
End-if
invoke self "finalizeObjects"
End Method "PB-Exit".
*>-------------------------------------------------------------
Method-id. "PB-OK".
*>-------------------------------------------------------------
Local-storage section.
01 n pic x(4) comp-5.
Linkage section.
01 lnk-Flag pic x(4) comp-5.
Procedure Division using lnk-Flag.
*> If individual entries have been returned before user clicks
*> PB-OK, then RecordChanged will have alredy been set
if RecordNotChanged
move lnk-Flag to RecordChangedFlag
End-if
if RecordNotChanged
invoke self "PB-Cancel"
EXIT METHOD
End-if
set ValidationOK to true
perform GET-FIELDS
Evaluate true also true
when ValidationOK also RecordFound
invoke self "rewriteRecord"
when ValidationOK also RecordNotFound
invoke self "writeRecord"
End-evaluate
if ContinueProgram
invoke os-Dialog "hide"
invoke self "showTheTreeview"
End-if
EXIT METHOD.
GET-FIELDS.
set DoReturn to true
perform varying n from 2 by 1 until n > 2
invoke os-Dialog "returnEntryField"
using n, Dialog-ReturnType
End-perform
move 3 to n
invoke os-Dialog "ReturnDropList"
using n, Dialog-ReturnType
End Method "PB-OK".
*>-------------------------------------------------------------
END OBJECT.
END CLASS CheeseDBI.
*>--------------------------------------------------------------
#2 - I've taken the parameters from the Resourcefile cheese.rc and
included them in a table here, plus some of the columns are specific
things I have added for generality.
*>-----------------dlgchees.cbl --------------------------------
Class-id. CheeseDialog
inherits from Base.
Class-control. CheeseDialog is class "dlgchees"
.
*>--------------------------------------------------------------
FACTORY.
*>--------------------------------------------------------------
END FACTORY.
*>-------------------------------------------------------------
OBJECT.
*>--------------------------------------------------------------
WORKING-STORAGE SECTION.
*>--------------------------------------------------------------
copy "\copylib\dlgparams.cpy" replacing ==(tag)== by ==Dialog==.
copy "dlgcheese.cpy".
01 n pic x(4) comp-5 value 0.
01 n1 pic x(4) comp-5 value 0.
01 n2 pic x(4) comp-5 value 0.
01 ColoredDroplistCount pic 99 value 0.
78 TL value 28.
78 ML value 30.
*> Resource Field Field
*> ID # Seq # Length A D R,C F P V MethodName
*> IIII SSS LLL 9,99,9,9,9,9,9,x-------30------------x
*> ---- --- --- - -- - - - - - -----------------------
+++++++++
+++++++++ One thing to note here - I am passing to the Dialog the
method-names to which events are to be returned to in # 1 above.
++++++++
01 ws-a.
*> Entryfields ID Seq Len X DF R C F P V
*> IIII,SSS,LLL,X,NN,N,N,N,N,N,
05.
10 pic x(TL) value '0301,001,006,0,00,2,0,0,0,0,'.
10 pic x(ML) value 'EF-CheeseCode'.
05.
10 pic x(TL) value '0302,002,020,3,00,0,0,0,0,0,'.
10 pic x(ML) value 'EF-CheeseName'.
*> Coloured Droplist ----------------! (Note '4' below)
05. *> * **
10 pic x(TL) value '0303,003,000,4,01,0,0,0,0,0,'.
10 pic x(ML) value 'DL-CountryName'.
*> Pushbuttons
05.
10 pic x(TL) value '0001,004,000,0,00,0,0,0,0,0,'.
10 pic x(ML) value 'PB-OK'.
05.
10 pic x(TL) value '0002,005,000,0,00,0,0,0,0,0,'.
10 pic x(ML) value 'PB-Cancel'.
01 ws-B redefines ws-A.
05 ws-C occurs MaxGadgets pic x(58).
01 os-Dialog object reference.
*>--------------------------------------------------------------
Method-id. "begin".
*>-------------------------------------------------------------
*> Note sequencing of entries below activates controls
*> in the same sequence as their field numbers, so that field
*> number = index position in the Dialog Control Collections
Linkage section.
01 lnk-Dialog object reference.
Procedure Division using lnk-Dialog.
set os-Dialog to lnk-Dialog
invoke self "ControlCollections"
invoke self "setXYcoords"
*> Using coloured Droplists so need to tell DropListDialog
*> how many DropLists
move 1 to n
invoke os-Dialog "passDropListCount" using n
++++ Why the two counters n1 and n2 ? I can invoke to send static Fields
1 through 5, then a separate method to create say dynamic entry fields 6
through 14, then set another count to send static Fields 15 through 40.
That gives me all my controls in a set ascending sequence, (held in an
OrderedCollection), so that the Dialog can be tabbed through.
++++++
move 1 to n1
move MaxGadgets to n2
invoke self "passToDialog"
invoke self "DropListColors"
invoke self "LastField"
invoke os-Dialog "zCloseEvent"
End Method "begin".
*>-----------------------------------------------------------
Method-id. "ControlCollections".
*>------------------------------------------------------------
Local-storage section.
01 ls-GadgetSize pic x(4) comp-5.
Procedure Division.
move MaxGadgets to ls-GadgetSize
invoke os-Dialog "zDialogCollections" using ls-GadgetSize
End Method "ControlCollections".
*>---------------------------------------------------------------
Method-id. "DropListColors".
*>---------------------------------------------------------------
Working-storage section.
01 n3 pic x(4) comp-5.
01 ws-Foreground. *> Black
05 RedF pic x(4) comp-5 value 0.
05 GreenF pic x(4) comp-5 value 0.
05 BlueF pic x(4) comp-5 value 0.
01 ws-Background. *> "Straw" (Yellow)
05 RedB pic x(4) comp-5 value 245.
05 GreenB pic x(4) comp-5 value 231.
05 BlueB pic x(4) comp-5 value 129.
*> Colours the text area of a droplist
set Field-DL-COUNTRYNAME to true
invoke os-Dialog "setRGBcolors"
using Dialog-Params, ws-foreground, ws-background
move 1 to n3
invoke os-Dialog "passDroplistRGB" using ws-background, n3
End Method "DropListColors".
*>---------------------------------------------------------------
Method-id. "LastField".
*>-------------------------------------------------------------
*> see method "CheckChangeFlag" in dlgTabbd - for 'new' Cheese
*> Records, the country is automatic from selection - therefore
*> the 'LastField' is the CheeseName = Field 2 - the dialog
*> defaults to the PB-OK button and Country Code is only changed
*> if user changes
set Field-EF-CheeseName to true
invoke os-Dialog "setLastField" using Dialog-Field
End Method "LastField".
*>-------------------------------------------------------------
Method-id. "passToDialog".
*>---------------------------------------------------------------
perform varying n from n1 by 1 until n > n2
invoke os-Dialog "ZpassToDialog" using ws-C (n)
End-perform
End Method "passToDialog".
*>-------------------------------------------------------------
Method-id. "setXYcoords".
*>---------------------------------------------------------------
Local-storage section.
01 x pic x(4) comp-5.
01 y pic x(4) comp-5.
move 290 to x
move 150 to y
invoke os-Dialog "zSetXY" using x, y
End Method "setXYcoords".
*>-------------------------------------------------------------
END OBJECT.
END CLASS CheeseDialog.
*>--------------------------------------------------------------
# 3 - WHERE'S THE REST ? - that's the whole point, using OO there isn't
a 'REST' that applies to Cheese - I'm using common support classes that
are used with this Cheese Dialog or umpteen other dialogs that I want to
create. Same principle applies with accessing files/DB tables - in the
case of files I use templates for ISAM and for SQL a separate class per
table.
So in the case of Continent or Country you would see a duplication of #1
and #2 above - worded of course to represent Continent or Country. And
an identical approach when I get around to using the Treeview with
oil/gas plant Vessels and Items. As I remarked the Vessel has a series
of Dialogs, so it is just a repeat of # 2 above, with the W/S table
applicable to a particular dialog.
# 4 - I'm not claiming the above is 'The be all and end all". There are
obviously other approaches, and others using N/E who might have an
interest in my approach could probably fine-tune it to make it even easier.
Jimmy
- Next message: Kellie Fitton: "Re: Treeviews"
- Previous message: Richard: "Re: moving data from one place to another in a text file"
- In reply to: docdwarf_at_panix.com: "Re: Treeviews"
- Next in thread: Donald Tees: "Re: Treeviews"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
