**************************************************
*-- Class:        updres (f:\wwnew\libs\baseform.vcx)
*-- ParentClass:  form
*-- BaseClass:    form
*-- Time Stamp:   12/11/05 04:30:06 PM
*-- Conflict Resolution Form Class
*
Define Class updres As Form


  Height = 210
  Width = 486
  DoCreate = .T.
  AutoCenter = .T.
  BorderStyle = 1
  Caption = "Update Conflict Detected"
  WindowType = 1
  AllowOutput = .F.
  *-- Alias Name of the Table being updated
  ctarget = ""
  Name = "updres"


  Add Object label1 As Label With ;
    BackStyle = 0, ;
    Caption = "Record Number:", ;
    Height = 17, ;
    Left = 12, ;
    Top = 5, ;
    Width = 93, ;
    Name = "Label1"


  Add Object label2 As Label With ;
    BackStyle = 0, ;
    Caption = "Original Value:", ;
    Height = 17, ;
    Left = 23, ;
    Top = 61, ;
    Width = 82, ;
    Name = "Label2"


  Add Object label3 As Label With ;
    BackStyle = 0, ;
    Caption = "Changed To:", ;
    Height = 17, ;
    Left = 32, ;
    Top = 90, ;
    Width = 73, ;
    Name = "Label3"


  Add Object label4 As Label With ;
    BackStyle = 0, ;
    Caption = "Your Change:", ;
    Height = 17, ;
    Left = 28, ;
    Top = 119, ;
    Width = 77, ;
    Name = "Label4"


  Add Object optusrchoice As OptionGroup With ;
    ButtonCount = 2, ;
    BackStyle = 0, ;
    Value = 2, ;
    Height = 26, ;
    Left = 106, ;
    Top = 147, ;
    Width = 274, ;
    Name = "OptUsrChoice", ;
    Option1.Caption = "Force Your Change", ;
    Option1.Value = 0, ;
    Option1.Height = 17, ;
    Option1.Left = 8, ;
    Option1.Top = 5, ;
    Option1.Width = 124, ;
    Option1.AutoSize = .T., ;
    Option1.Name = "Option1", ;
    Option2.Caption = "Undo Your Change", ;
    Option2.Value = 1, ;
    Option2.Height = 17, ;
    Option2.Left = 145, ;
    Option2.Top = 5, ;
    Option2.Width = 123, ;
    Option2.AutoSize = .T., ;
    Option2.Name = "Option2"


  Add Object txtrecnum As TextBox With ;
    Height = 23, ;
    Left = 106, ;
    ReadOnly = .T., ;
    Top = 5, ;
    Width = 64, ;
    Name = "txtRecNum"


  Add Object txtorgval As TextBox With ;
    Height = 23, ;
    Left = 106, ;
    ReadOnly = .T., ;
    Top = 61, ;
    Width = 368, ;
    ForeColor = Rgb(255,255,255), ;
    DisabledBackColor = Rgb(0,0,255), ;
    DisabledForeColor = Rgb(255,255,255), ;
    Name = "txtOrgVal"


  Add Object txtcurval As TextBox With ;
    Height = 23, ;
    Left = 106, ;
    ReadOnly = .T., ;
    Top = 90, ;
    Width = 368, ;
    DisabledBackColor = Rgb(128,255,255), ;
    DisabledForeColor = Rgb(0,0,0), ;
    Name = "txtCurVal"


  Add Object txtnewval As TextBox With ;
    FontBold = .T., ;
    Height = 23, ;
    Left = 106, ;
    ReadOnly = .T., ;
    Top = 119, ;
    Width = 368, ;
    DisabledBackColor = Rgb(128,128,255), ;
    DisabledForeColor = Rgb(255,255,255), ;
    Name = "txtNewVal"


  Add Object label5 As Label With ;
    BackStyle = 0, ;
    Caption = "Options:", ;
    Height = 17, ;
    Left = 57, ;
    Top = 147, ;
    Width = 48, ;
    Name = "Label5"


  Add Object label6 As Label With ;
    BackStyle = 0, ;
    Caption = "Conflict Number:", ;
    Height = 17, ;
    Left = 260, ;
    Top = 7, ;
    Width = 94, ;
    Name = "Label6"


  Add Object txtcfxrec As TextBox With ;
    BorderStyle = 0, ;
    Height = 23, ;
    Left = 357, ;
    ReadOnly = .T., ;
    Top = 5, ;
    Width = 48, ;
    Name = "txtCfxRec"


  Add Object label7 As Label With ;
    AutoSize = .T., ;
    BackStyle = 0, ;
    Caption = "OF", ;
    Height = 17, ;
    Left = 409, ;
    Top = 7, ;
    Width = 18, ;
    Name = "Label7"


  Add Object txtcfxtot As TextBox With ;
    BorderStyle = 0, ;
    Height = 23, ;
    Left = 427, ;
    ReadOnly = .T., ;
    Top = 5, ;
    Width = 48, ;
    Name = "txtCfxTot"


  Add Object cmdprev As CommandButton With ;
    Top = 176, ;
    Left = 106, ;
    Height = 27, ;
    Width = 84, ;
    Caption = "Previous", ;
    Name = "cmdPrev"


  Add Object cmdnext As CommandButton With ;
    Top = 176, ;
    Left = 201, ;
    Height = 27, ;
    Width = 84, ;
    Caption = "Next", ;
    Name = "cmdNext"


  Add Object cmdexit As CommandButton With ;
    Top = 147, ;
    Left = 391, ;
    Height = 27, ;
    Width = 84, ;
    Caption = "Finish", ;
    Name = "cmdExit"


  Add Object command1 As CommandButton With ;
    Top = 176, ;
    Left = 295, ;
    Height = 27, ;
    Width = 84, ;
    Caption = "Force All", ;
    Name = "Command1"


  Add Object label8 As Label With ;
    BackStyle = 0, ;
    Caption = "Field Name:", ;
    Height = 17, ;
    Left = 36, ;
    Top = 32, ;
    Width = 69, ;
    Name = "Label8"


  Add Object txtfldnam As TextBox With ;
    Height = 23, ;
    Left = 106, ;
    ReadOnly = .T., ;
    Top = 32, ;
    Width = 368, ;
    Name = "txtFldNam"


  *-- Routine to identify genuine update conflicts and to force updates through if changes are not on the same fields
  Procedure checkupdates
    Lparameters tuTable
    Local llRetval, lnBuffMode, lcTable, lnOldArea, lnNextRec, lnRows
    *** Check Parameters
    If Empty(tuTable)
      *** Nothing passed, use current table
      lcTable = Alltrim( Alias() )
      If Empty( lcTable )
        *** No table
        Return .F.
      Endif
    Else
      Do Case
        Case Type( "tuTable" ) = "C"
          *** Assume Character string is the Required Alias
          lcTable = Alltrim( tuTable)
        Case Type( "tuTable" ) = "N"
          *** Get the Alias for the specified work area
          lcTable = Alias( tuTable )
        Otherwise
          *** Invalid parameter - exit with error
          Return .F.
      Endcase
    Endif
    *** Check BufferMode
    llRetval = .T.
    lnBuffMode = CursorGetProp( 'Buffering', lcTable )
    If lnBuffMode < 2
      *** If Table is not buffered just return
      Return .F.
    Else
      *** Save current work area and select required table
      lnOldArea =  Select()
      Select (lcTable)
    Endif

    *** Need to handle Row Buffering and Table Buffering differently
    With Thisform
      *** Set form Caption and store target table to a Form property
      *** For use in the DoUpdates() method
      .Caption = "Update Conflicts in Table: " + lcTable
      .ctarget = Alias()
      *** Check buffering mode
      If lnBuffMode < 4
        *** Row Buffering
        llRetval = .ChkRec( Recno(), lcTable )
      Else
        *** Table Buffering - need to find all modified records
        lnNextRec = 0
        Do While .T.
          lnNextRec = Getnextmodified( lnNextRec )
          If lnNextRec = 0
            Exit
          Endif
          *** Try and update the record
          llRetval = .ChkRec( lnNextRec, lcTable )
          If ! llRetval
            *** If failed, exit
            Exit
          Endif
        Enddo
      Endif
      *** Check the Conflict Cursor
      If Reccount( "curcflix") = 0
        *** There are no unresolvable conflicts so just force the update
        *** By returning .F. to the Init() we prevent the object instantiating
        *** and the user will see nothing!
        llRetval = ! Tableupdate( .T., .T. )
      Else
        Go Top In curcflix
      Endif
    Endwith

    *** Tidy Up
    Select (lnOldArea)
    Return llRetval
  Endproc


  *-- Parses Record and checks for update conflicts,  Writes data that conflicts to the form's array
  Procedure ChkRec
    Lparameters tnRecNum, tcTable
    Local lnCnt, luCurVal, luOldVal, lnRows, llRetval, lcFldList, lcFldName, luUsrVal

    *** Force the correct record to be current
    Select (tcTable)
    If Recno() # tnRecNum
      Goto tnRecNum
    Endif
    *** Get the list of fields changed by the Current User
    lcFldList = ""
    lcFldList = Thisform.GetUserChanges( tcTable )
    *** Scan through the fields
    For lnCnt = 1 To Fcount()
      lcFldName = Field( lnCnt )
      luCurVal = Curval( Field( lnCnt ))
      luOldVal = Oldval( Field( lnCnt ))
      luUsrVal = Eval( Field( lnCnt ))
      *** Will this field cause a conflict?
      If luCurVal == luOldVal
        *** No Changes have been made to the field
        *** So no problem will arise
        Loop
      Endif
      *** Changes have been made to the field
      If ! Field( lnCnt ) $ lcFldList
        *** But The curent user has not modified the field
        *** So we can just update it from CurVal()
        Replace (Field(lnCnt)) With luCurVal
      Else
        *** Something has changed!  The question is WHAT?
        If Eval( Field(lnCnt) ) == luCurVal
          *** User has not actually changed anything
          Loop
        Else
          *** This is a conflict that we cannot resolve programmatically
          *** So add it to the Conflict Cursor
          With Thisform
            Insert Into curcflix ;
              ( cfxRecNum, ;
              cfxFldNam, ;
              cfxOldVal, ;
              cfxCurVal, ;
              cfxUsrVal, ;
              cfxForcit ) ;
              VALUES ;
              ( .ExpToStr(Recno()), ;
              lcFldName, ;
              .ExpToStr(luOldVal), ;
              .ExpToStr(luCurVal), ;
              .ExpToStr(luUsrVal), ;
              2 )
          Endwith
        Endif
      Endif
    Next
  Endproc


  *-- Convert Raw Data into the Appropriate Character String
  Procedure ExpToStr
    Lparameters tuExp, tcType
    Local lcRetVal, lcType
    *** If no type passed -- map to expression type
    lcType = Iif( Type('tcType')='C', Upper(Alltrim(tcType)), Type('tuExp') )
    *** Convert from type to char
    Do Case
      Case Inlist(lcType, 'I', 'N') And Int(tuExp)=tuExp && Integer
        lcRetVal = Alltrim(Str(Nvl( tuExp, 0 ),16,0))
      Case Inlist(lcType, 'N', 'Y')  && Numeric or Currency
        lcRetVal = Alltrim(Padl(Nvl( tuExp, 0 ),32))
      Case lcType = 'C'  && Character
        lcRetVal = '"' + Alltrim( Nvl( tuExp, [] ) ) + '"'
      Case lcType = 'L'  && Logical
        lcRetVal = Iif(!Empty( Nvl( tuExp, .F. )),'.T.','.F.')
      Case lcType = 'D'  && Date
        lcRetVal = '"' + Alltrim( Dtoc( Nvl( tuExp, {} ) ) ) + '"'
      Case lcType = 'T'  && DateTime
        lcRetVal = '"' + Alltrim( Ttoc( Nvl( tuExp, {} ) ) ) + '"'
    Endcase
    *** Return value as character
    Return lcRetVal
  Endproc


  *-- Resolve conflicts by forcing update or reverting it to Current Value
  Procedure doupdates
    Local lcTarget, llOk, lcField, lnRec, lcType, lcFld2Chk, luValue
    lcTarget = Thisform.ctarget
    Select curcflix
    Go Top
    Scan
      If cfxForcit = 2
        *** Revert the source table
        lnRec = Int( Val(cfxRecNum) )
        lcField = Alltrim( cfxFldNam )
        *** Convert the data back to the original data type
        lcFld2Chk = lcTarget + "." + Strtran(lcField, Chr(34), "")
        lcType = Type(lcFld2Chk)
        luValue = This.StrToExp( cfxCurVal, lcType )
        If Recno( lcTarget ) # lnRec
          Go (lnRec) In (lcTarget)
        Endif
        Replace ( lcField ) With  luValue In (lcTarget)
      Endif
    Endscan

    *** Now force all these changes through
    Select (lcTarget)
    llOk =Tableupdate( 2, .T. )

    Return llOk
  Endproc


  *-- Convert a string back to raw data
  Procedure StrToExp
    Lparameters tuExp, tcType
    Local luRetVal, lcType

    tuExp = Strtran(Alltrim(tuExp), Chr(34), "") && mga 3/1/98
    *** If no type passed -- map to expression type
    lcType = Iif( Type('tcType')='C', Upper(Alltrim(tcType)), Type(tuExp) )
    *** Convert from Char to type
    Do Case
      Case Inlist(lcType, 'I', 'N') And Int(Val(tuExp)) == Val(tuExp) && Integer
        luRetVal = Int(Val(tuExp))
      Case Inlist(lcType, 'N', 'Y')  && Numeric or Currency
        luRetVal = Val(tuExp)
      Case Inlist(lcType, 'C', 'M')  && Character or memo
        luRetVal = tuExp
      Case lcType = 'L'  && Logical
        luRetVal = Iif(!Empty(tuExp),.T.,.F.)
      Case lcType = 'D'  && Date
        luRetVal = Ctod(tuExp)
      Case lcType = 'T'  && DateTime
        luRetVal = Ctot(tuExp)
    Endcase
    *** Return value as Data Type
    Return luRetVal
  Endproc


  *-- Returns a list of fields changed by the current user
  Procedure GetUserChanges
    Lparameters tcTable
    Local lcTable, lcRetVal, lnBuffMode, lcFldState, lnCnt, lcStatus
    *** Check the parameter, assume current alias if nothing passed
    lcTable = Iif( Vartype(tcTable) # "C" Or Empty( tcTable ), Alias(), Alltrim( Upper( tcTable )))
    *** Check that the specified table name is used as an alias
    If Empty( lcTable ) Or ! Used( Juststem( lcTable) )
      *** We have an error - probably a developer error, so use an Error to report it!
      Error "9000: GetUserChanges() requires that the alias of an open table" + Chr(13) ;
        + "be passed, or that the current work area should contain an" + Chr(13) ;
        + "open table"
      Return .F.
    Endif
    lcRetVal = ''
    *** Check the buffering status
    lnBuffMode = CursorGetProp( 'Buffering', lcTable )
    If lnBuffMode = 1
      *** Not buffered, so can be no 'pending changes'
      Return lcRetVal
    Endif
    *** If we get this far, we have a buffered record which MAY have changes
    *** So check for fields that have changed values
    lcFldState = Nvl( Getfldstate( -1, lcTable ), "")
    If Empty( Chrtran( lcFldState, '1', ''))
      *** Nothing but '1', therefore nothing has changed
      Return lcRetVal
    Endif
    *** So, we HAVE got at least one changed field! But we need to handle the DELETED
    *** flag indicator first. We can use "DELETED()" as the field name here!
    If ! Inlist( Left( lcFldState, 1), "1", "3" )
      lcRetVal = "DELETED()"
    Endif
    *** Now Get Rid of the Deleted Flag indicator
    lcFldState = Substr( lcFldState, 2 )
    *** Get the field names for changed fields
    For lnCnt = 1 To Fcount()
      *** Loop through the fields
      lcStatus = Substr( lcFldState, lnCnt, 1 )
      If Inlist( lcStatus, "2", "4" )
        lcRetVal = lcRetVal + Iif( ! Empty( lcRetVal ), ",", "") + Field( lnCnt )
      Endif
    Next
    *** Return the list of changed fields
    Return lcRetVal
  Endproc


  *-- Initialise the Form's Cursor and Bind controls
  Procedure setupform
    With Thisform
      *** Create a local cursor for storing conflicts
      Create Cursor curcflix ( ;
        cfxRecNum  C (  8), ;  && Conflict Number
      cfxFldNam  C (200), ;  && Field Name
      cfxOldVal  C (200), ;  && Original Value
      cfxCurVal  C (200), ;  && Current Value on disk
      cfxUsrVal  C (200), ;  && Change in the buffer
      cfxForcit  N (  1) )  && User defined action
      *** Bind The Controls to it
      .txtrecnum.ControlSource = "curcflix.cfxRecNum"
      .txtfldnam.ControlSource = "curcflix.cfxFldNam"
      .txtorgval.ControlSource = "curcflix.cfxOldVal"
      .txtcurval.ControlSource = "curcflix.cfxCurVal"
      .txtnewval.ControlSource = "curcflix.cfxUsrVal"
      .optusrchoice.ControlSource = "curcflix.cfxforcit"
      .Refresh()
    Endwith
    Return .T.
  Endproc


  Procedure Refresh
    With Thisform
      .txtcfxrec.Value = Recno( "curcflix")
      .txtcfxtot.Value = Reccount( "curcflix")
    Endwith
  Endproc


  Procedure Init
    Lparameters tnDSID, tcTable
    Local llRetval
    With Thisform
      *** Set this form to the passed in DataSession
      .DataSessionId = tnDSID
      *** Ceate cursor and bind fields to it
      .setupform()
      *** Run the CheckUpdates() method for the specified table
      llRetval = .checkupdates( tcTable )
      Return llRetval
    Endwith
  Endproc


  Procedure cmdprev.Click
    Skip -1 In curcflix
    If Bof("curcflix")
      Go Top In curcflix
    Endif
    Thisform.Refresh()
  Endproc


  Procedure cmdnext.Click
    Skip In curcflix
    If Eof("curcflix")
      Go Bottom In curcflix
    Endif
    Thisform.Refresh()
  Endproc


  Procedure cmdexit.Click
    With Thisform
      .doupdates()
      .Release()
    Endwith
  Endproc


  Procedure command1.Click
    Local lnRec
    lnRec = Recno( 'curcflix' )
    Replace All cfxForcit With 1 In curcflix
    If CursorGetProp( 'Buffering', 'curcflix' ) > 1
      =Tableupdate( 2, .T., 'curcflix' )
    Endif
    Goto lnRec In curcflix
    Thisform.Refresh()
  Endproc


Enddefine
*
*-- EndDefine: updres
**************************************************