FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index WhatsNew / Novedades ObjectVision using FWH
Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:03 PM

Hello,

I am experimenting with an old idea: forms where every field is an input, a formula or a decision tree, all connected and recalculated in dependency order, a bit in the spirit of the form and decision-tree tools of the early 90s. This is an original prototype written in Harbour and FWH. It uses no third-party assets and it is not file-compatible with any product.

📎 objectvision_wine.png

The screenshot is a real run of the code below, built with Harbour + FWH and executed under Wine 11.19 on Linux (not tested on real Windows, not tested with xHarbour).

What you see: an MDI frame with six real MDICHILD windows (Actions, Form, Tree, Properties, Status, Components). The form has real GETs. The button "Sumar" is linked to the field "Cantidad": when it is pressed, its action tree runs first, then the link adds 1 to Cantidad, and the subtotal, net and total are recalculated.

What works in my tests:

  • Creating input, formula, decision-tree and button fields from the Components window.
  • Editing branches, operator, threshold and result of a tree (first matching branch wins).
  • Dragging a field onto the root of a tree to change the field it decides on (cycles are rejected, F12 undoes).
  • Dragging a button onto an input field to link its "on click" event to that field (set to zero or add 1). The link is drawn as an arrow, saved to a small INI file, and F12 undoes it.
  • Moving, resizing and minimizing the windows, with the layout saved.
  • Saving orders to a DBF.

Limits: it is a prototype. One event ("al pulsar"), one link per button, two link actions. The formula engine only evaluates numbers, field names, + - * / and parentheses (text is never evaluated as code). After resizing a window the content is clipped. UI texts are in Spanish.

The complete code follows in 7 replies to fit the forum posting limit: dtree.prg in 2 parts, dstore.prg in 1 part, and fwhforms.prg in 4 parts. Concatenate each file's code blocks in order, keeping a newline between blocks. The two supplied fwhforms sections belong to ONE file. Save the files as UTF-8 and compile the three PRG files together with your usual FWH build for Harbour.

Comments and ideas are welcome.

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:04 PM

dtree.prg - part 1 of 2
Lines 1-439 of the supplied source. Concatenate all 2 code blocks for dtree.prg in order into one file, with a newline between blocks. Do not add the headings.

// ===== dtree.prg =====
/* dtree.prg - field-network engine for "FWH Decision Forms" (original code, pure Harbour, no FWH, no macros).
   Fields: inputs (set by the user), formula fields (own mini evaluator: + - * / ( ) numbers and field names)
   and tree fields (first matching branch wins). Targets are recalculated in dependency order; cycles are rejected.
   Text is never evaluated as Harbour code (no &, no Eval of strings).                                          */

#include "hbclass.ch"

FUNCTION DT_Cond( cOp, xArg, xVal )
   DO CASE
   CASE cOp == "otherwise" ; RETURN .T.
   CASE cOp == ">"         ; RETURN xVal >  xArg
   CASE cOp == ">="        ; RETURN xVal >= xArg
   CASE cOp == "<"         ; RETURN xVal <  xArg
   CASE cOp == "<="        ; RETURN xVal <= xArg
   CASE cOp == "="         ; RETURN xVal == xArg
   CASE cOp == "<>"        ; RETURN !( xVal == xArg )
   CASE cOp == "between"   ; RETURN xVal >= xArg[ 1 ] .AND. xVal <= xArg[ 2 ]
   ENDCASE
RETURN .F.

/* ---- mini expression evaluator --------------------------------------------------------------------- */
STATIC FUNCTION EV_Tok( cE )
   LOCAL aT := {}, n := 1, nL := Len( cE ), c, nS
   DO WHILE n <= nL
      c := SubStr( cE, n, 1 )
      DO CASE
      CASE c == " "
         n++
      CASE c $ "+-*/()"
         AAdd( aT, { "op", c } ); n++
      CASE c $ "0123456789."
         nS := n
         DO WHILE n <= nL .AND. SubStr( cE, n, 1 ) $ "0123456789."; n++; ENDDO
         AAdd( aT, { "n", Val( SubStr( cE, nS, n - nS ) ), SubStr( cE, nS, n - nS ) } )
      CASE ( c >= "A" .AND. c <= "Z" ) .OR. ( c >= "a" .AND. c <= "z" ) .OR. c == "_"
         nS := n
         DO WHILE n <= nL .AND. ( SubStr( cE, n, 1 ) $ "0123456789_" .OR. ( Upper( SubStr( cE, n, 1 ) ) >= "A" .AND. Upper( SubStr( cE, n, 1 ) ) <= "Z" ) ); n++; ENDDO
         AAdd( aT, { "id", SubStr( cE, nS, n - nS ) } )
      OTHERWISE
         RETURN NIL
      ENDCASE
   ENDDO
RETURN aT

/* aS := { aTokens, nPos, hFields, lErr } */
STATIC FUNCTION EV_Peek( aS )
RETURN iif( aS[ 2 ] <= Len( aS[ 1 ] ), aS[ 1 ][ aS[ 2 ] ], NIL )

STATIC FUNCTION EV_Prim( aS )
   LOCAL t := EV_Peek( aS ), x := 0
   IF t == NIL; aS[ 4 ] := .T.; RETURN 0; ENDIF
   aS[ 2 ]++
   DO CASE
   CASE t[ 1 ] == "n"
      RETURN t[ 2 ]
   CASE t[ 1 ] == "id"
      IF t[ 2 ] $ aS[ 3 ] .AND. ValType( aS[ 3 ][ t[ 2 ] ] ) == "N"
         RETURN aS[ 3 ][ t[ 2 ] ]
      ENDIF
      aS[ 4 ] := .T.; RETURN 0
   CASE t[ 1 ] == "op" .AND. t[ 2 ] == "("
      x := EV_Expr( aS )
      t := EV_Peek( aS )
      IF t == NIL .OR. ! ( t[ 1 ] == "op" .AND. t[ 2 ] == ")" ); aS[ 4 ] := .T.; RETURN 0; ENDIF
      aS[ 2 ]++
      RETURN x
   ENDCASE
   aS[ 4 ] := .T.
RETURN 0

STATIC FUNCTION EV_Unary( aS )
   LOCAL t := EV_Peek( aS )
   IF t != NIL .AND. t[ 1 ] == "op" .AND. t[ 2 ] == "-"
      aS[ 2 ]++
      RETURN - EV_Unary( aS )
   ENDIF
RETURN EV_Prim( aS )

STATIC FUNCTION EV_Term( aS )
   LOCAL x := EV_Unary( aS ), t, y
   DO WHILE ! aS[ 4 ]
      t := EV_Peek( aS )
      IF t == NIL .OR. t[ 1 ] != "op" .OR. ! ( t[ 2 ] $ "*/" ); EXIT; ENDIF
      aS[ 2 ]++
      y := EV_Unary( aS )
      IF t[ 2 ] == "*"
         x := x * y
      ELSEIF y == 0
         aS[ 4 ] := .T.
      ELSE
         x := x / y
      ENDIF
   ENDDO
RETURN x

STATIC FUNCTION EV_Expr( aS )
   LOCAL x := EV_Term( aS ), t, y
   DO WHILE ! aS[ 4 ]
      t := EV_Peek( aS )
      IF t == NIL .OR. t[ 1 ] != "op" .OR. ! ( t[ 2 ] $ "+-" ); EXIT; ENDIF
      aS[ 2 ]++
      y := EV_Term( aS )
      x := iif( t[ 2 ] == "+", x + y, x - y )
   ENDDO
RETURN x

/* DT_Eval( cExpr, hFields, @lErr ) -> number (0 when lErr: bad syntax, unknown field, division by zero) */
FUNCTION DT_Eval( cE, hF, lErr )
   LOCAL aT := EV_Tok( cE ), aS, x
   IF aT == NIL .OR. Len( aT ) == 0; lErr := .T.; RETURN 0; ENDIF
   aS := { aT, 1, hF, .F. }
   x := EV_Expr( aS )
   IF aS[ 2 ] <= Len( aT ); aS[ 4 ] := .T.; ENDIF
   lErr := aS[ 4 ]
RETURN iif( lErr, 0, x )

/* Canonical text: single spaces between tokens, field names spelled as in aKnown (call after DT_Check). */
FUNCTION DT_Canon( cE, aKnown )
   LOCAL aT := EV_Tok( cE ), c := "", t, k
   IF aT == NIL; RETURN cE; ENDIF
   FOR EACH t IN aT
      IF t[ 1 ] == "id"
         k := AScan( aKnown, { | x | Upper( x ) == Upper( t[ 2 ] ) } )
         c += iif( Empty( c ), "", " " ) + iif( k > 0, aKnown[ k ], t[ 2 ] )
      ELSEIF t[ 1 ] == "n"
         c += iif( Empty( c ), "", " " ) + t[ 3 ]
      ELSE
         c += iif( Empty( c ), "", " " ) + t[ 2 ]
      ENDIF
   NEXT
RETURN c

/* names used by an expression (NIL when the text has invalid characters) */
FUNCTION DT_Names( cE )
   LOCAL aT := EV_Tok( cE ), aN := {}, t
   IF aT == NIL; RETURN NIL; ENDIF
   FOR EACH t IN aT
      IF t[ 1 ] == "id"; AAdd( aN, t[ 2 ] ); ENDIF
   NEXT
RETURN aN

/* Static check of an expression against known field names: returns "" or the reason.
   Division by zero is a run-time condition (values), not checked here, except literal 1/0 style constants. */
FUNCTION DT_Check( cE, aKnown )
   LOCAL aN, x, hT := { => }, lE := .F.
   IF Empty( AllTrim( cE ) ); RETURN "la fórmula está vacía"; ENDIF
   aN := DT_Names( cE )
   IF aN == NIL; RETURN "carácter no permitido (solo números, nombres de campo, + - * / y paréntesis)"; ENDIF
   FOR EACH x IN aN
      IF AScan( aKnown, { | k | Upper( k ) == Upper( x ) } ) == 0; RETURN "campo desconocido: " + x; ENDIF
   NEXT
   FOR EACH x IN aKnown; hT[ x ] := 7.3; NEXT
   DT_Eval( DT_Canon( cE, aKnown ), hT, @lE )
   IF lE; RETURN "sintaxis no válida o división por cero"; ENDIF
RETURN ""

/* ---- form model ------------------------------------------------------------------------------------- */
/* aNodes: { cTarget, "rule", cTest, aBranches } | { cTarget, "formula", cExpr } ; aOrder: node indexes in calc order */
CLASS TDForm
   DATA hF        INIT { => }
   DATA aRules    INIT {}          // { cTarget, cTest, aBranches }  (tree fields, same order as defined)
   DATA aForms    INIT {}          // { cTarget, cExpr }
   DATA aOrder    INIT {}          // { "R"|"F", index } in dependency order
   DATA lErr      INIT .F.         // last recalc had a formula error
   DATA aFields   INIT {}          // display order: { cName, cLabel, cKind "in"|"fx"|"tree", nDec, cUnit }
   DATA cTitle    INIT "Formulario"
   METHOD Rule( cTarget, cTest, aBranches )
   METHOD Formula( cTarget, cExpr )
   METHOD Order()
   METHOD SetFormulas( aPairs )
   METHOD FieldIdx( cName )
   METHOD AddInput( cName, cLabel, nDec, nDef )
   METHOD AddFormula( cName, cLabel, cExpr )
   METHOD AddTree( cName, cLabel, cTest, cUnit )
   METHOD AddButton( cName, cLabel, cTest )
   METHOD RemoveField( cName )
   METHOD UsedBy( cName )
   METHOD RuleIdx( cName )
   METHOD FormIdx( cName )
   METHOD Serialize()
   METHOD Set( cName, xVal )
   METHOD Get( cName )
   METHOD Recalc()
ENDCLASS

/* Returns "" if ok, otherwise the reason (the node is not added) */
METHOD Rule( cTarget, cTest, aBranches ) CLASS TDForm
   LOCAL cErr
   AAdd( ::aRules, { cTarget, cTest, aBranches } )
   cErr := ::Order()
   IF ! Empty( cErr ); ASize( ::aRules, Len( ::aRules ) - 1 ); ::Order(); ENDIF
RETURN cErr

METHOD Formula( cTarget, cExpr ) CLASS TDForm
   LOCAL cErr, aN := DT_Names( cExpr )
   IF aN == NIL .OR. Len( aN ) == 0 .AND. Empty( cExpr ); RETURN "formula invalida para " + cTarget; ENDIF
   AAdd( ::aForms, { cTarget, cExpr } )
   cErr := ::Order()
   IF ! Empty( cErr ); ASize( ::aForms, Len( ::aForms ) - 1 ); ::Order(); ENDIF
RETURN cErr

/* Dependency order (Kahn). Returns "" or "ciclo: A, B". Also rejects two nodes with the same target. */
METHOD Order() CLASS TDForm
   LOCAL aNode := {}, aDone := {}, aT := {}, n, m, k, lProg, aDep, cErr := "", aOut := {}, x, lOk, c
   FOR n := 1 TO Len( ::aRules ); AAdd( aNode, { "R", n, ::aRules[ n ][ 1 ], { ::aRules[ n ][ 2 ] } } ); NEXT
   FOR n := 1 TO Len( ::aForms ); AAdd( aNode, { "F", n, ::aForms[ n ][ 1 ], DT_Names( ::aForms[ n ][ 2 ] ) } ); NEXT
   FOR n := 1 TO Len( aNode )
      IF AScan( aT, aNode[ n ][ 3 ] ) > 0; RETURN "el campo " + aNode[ n ][ 3 ] + " tiene dos definiciones"; ENDIF
      AAdd( aT, aNode[ n ][ 3 ] )
   NEXT
   aDone := Array( Len( aNode ) ); AFill( aDone, .F. )
   DO WHILE Len( aOut ) < Len( aNode )
      lProg := .F.
      FOR n := 1 TO Len( aNode )
         IF aDone[ n ]; LOOP; ENDIF
         lOk := .T.
         FOR EACH x IN aNode[ n ][ 4 ]
            k := AScan( aT, x )
            IF k > 0 .AND. ! aDone[ k ]; lOk := .F.; EXIT; ENDIF
         NEXT
         IF lOk; aDone[ n ] := .T.; AAdd( aOut, { aNode[ n ][ 1 ], aNode[ n ][ 2 ] } ); lProg := .T.; ENDIF
      NEXT
      IF ! lProg
         FOR n := 1 TO Len( aNode )
            IF ! aDone[ n ]; cErr += iif( Empty( cErr ), "", ", " ) + aNode[ n ][ 3 ]; ENDIF
         NEXT
         RETURN "ciclo entre campos: " + cErr
      ENDIF
   ENDDO
   ::aOrder := aOut
RETURN ""

/* Replace the expression of EXISTING formula fields. aPairs = { { cTarget, cExpr }, ... }. Atomic: returns "" or the reason and leaves the model unchanged.
   Field names are matched ignoring case and stored with their canonical spelling. */
METHOD SetFormulas( aPairs ) CLASS TDForm
   LOCAL aOld := {}, p, k, cErr := "", aKnown := hb_HKeys( ::hF ), n
   FOR EACH p IN aPairs
      k := AScan( ::aForms, { | f | Upper( f[ 1 ] ) == Upper( p[ 1 ] ) } )
      IF k == 0; RETURN "no existe el campo calculado " + p[ 1 ]; ENDIF
      cErr := DT_Check( p[ 2 ], aKnown )
      IF ! Empty( cErr ); RETURN p[ 1 ] + ": " + cErr; ENDIF
   NEXT
   FOR n := 1 TO Len( ::aForms ); AAdd( aOld, ::aForms[ n ][ 2 ] ); NEXT
   FOR EACH p IN aPairs
      k := AScan( ::aForms, { | f | Upper( f[ 1 ] ) == Upper( p[ 1 ] ) } )
      ::aForms[ k ][ 2 ] := DT_Canon( p[ 2 ], aKnown )
   NEXT
   cErr := ::Order()
   IF ! Empty( cErr )
      FOR n := 1 TO Len( ::aForms ); ::aForms[ n ][ 2 ] := aOld[ n ]; NEXT
      ::Order()
      RETURN cErr
   ENDIF
   ::Recalc()
RETURN ""

METHOD Get( cName ) CLASS TDForm
RETURN iif( cName $ ::hF, ::hF[ cName ], NIL )

METHOD Set( cName, xVal ) CLASS TDForm
   ::hF[ cName ] := xVal
   ::Recalc()
RETURN Self

/* One pass in dependency order is enough (no cycles). Formula results are rounded to 2 decimals. */
METHOD Recalc() CLASS TDForm
   LOCAL a, aR, aB, lE, xV
   ::lErr := .F.
   FOR EACH a IN ::aOrder
      IF a[ 1 ] == "R"
         aR := ::aRules[ a[ 2 ] ]
         IF aR[ 2 ] $ ::hF
            FOR EACH aB IN aR[ 3 ]
               IF DT_Cond( aB[ 1 ], aB[ 2 ], ::hF[ aR[ 2 ] ] )
                  ::hF[ aR[ 1 ] ] := aB[ 3 ][ 2 ]
                  EXIT
               ENDIF
            NEXT
         ENDIF
      ELSE
         lE := .F.
         xV := DT_Eval( ::aForms[ a[ 2 ] ][ 2 ], ::hF, @lE )
         IF lE; ::lErr := .T.; ENDIF
         ::hF[ ::aForms[ a[ 2 ] ][ 1 ] ] := Round( xV, 2 )
      ENDIF
   NEXT
RETURN Self


/* ---- field management (the IDE builds the form with these) -------------------------------------------- */
#define DT_MAXFIELDS 10

FUNCTION DT_NameOk( c )
   LOCAL n, k
   IF Empty( c ) .OR. Len( c ) > 20; RETURN .F.; ENDIF
   FOR n := 1 TO Len( c )
      k := Upper( SubStr( c, n, 1 ) )
      IF ! ( ( k >= "A" .AND. k <= "Z" ) .OR. ( n > 1 .AND. ( k $ "0123456789_" ) ) ); RETURN .F.; ENDIF
   NEXT
RETURN .T.

STATIC FUNCTION DT_CleanLabel( c, cName )
   c := AllTrim( StrTran( StrTran( StrTran( c, "|", " " ), Chr( 10 ), " " ), Chr( 13 ), " " ) )
RETURN iif( Empty( c ), cName, Left( c, 40 ) )

/* branches: { cOp, xThr, { "const", nRes } }. Returns "" when coherent (>= and > descending together, or <= and < ascending together; "otherwise" last). */
FUNCTION DT_ValidateBranches( aB )
   LOCAL n, nDesc := 0, nAsc := 0, nPrev := NIL, lDesc
   FOR n := 1 TO Len( aB )
      IF aB[ n ][ 1 ] == "otherwise"
         IF n != Len( aB ); RETURN "'en otro caso' debe ser la última rama"; ENDIF
         LOOP
      ENDIF
      IF aB[ n ][ 1 ] $ ">=|>"; nDesc++; ELSE; nAsc++; ENDIF
   NEXT
   IF Len( aB ) < 2 .OR. aB[ Len( aB ) ][ 1 ] != "otherwise"; RETURN "Falta la rama final 'en otro caso'"; ENDIF
   IF nDesc > 0 .AND. nAsc > 0
      RETURN "Los operadores deben ir en el mismo sentido: >= y > juntos, o <= y < juntos"
   ENDIF
   lDesc := ( nDesc > 0 )
   FOR n := 1 TO Len( aB ) - 1
      IF nPrev != NIL
         IF lDesc .AND. aB[ n ][ 2 ] >= nPrev
            RETURN "El umbral de la rama " + LTrim( Str( n ) ) + " debe ser menor que el de la rama " + LTrim( Str( n - 1 ) ) + " (se evalúa en orden)"
         ENDIF
         IF ! lDesc .AND. aB[ n ][ 2 ] <= nPrev
            RETURN "El umbral de la rama " + LTrim( Str( n ) ) + " debe ser mayor que el de la rama " + LTrim( Str( n - 1 ) ) + " (se evalúa en orden)"
         ENDIF
      ENDIF
      nPrev := aB[ n ][ 2 ]
   NEXT
RETURN ""

METHOD FieldIdx( cName ) CLASS TDForm
RETURN AScan( ::aFields, { | f | Upper( f[ 1 ] ) == Upper( cName ) } )

METHOD RuleIdx( cName ) CLASS TDForm
RETURN AScan( ::aRules, { | r | Upper( r[ 1 ] ) == Upper( cName ) } )

METHOD FormIdx( cName ) CLASS TDForm
RETURN AScan( ::aForms, { | r | Upper( r[ 1 ] ) == Upper( cName ) } )

STATIC FUNCTION DT_CommonCheck( o, cName )
   IF ! DT_NameOk( cName ); RETURN "nombre no válido (letras, números y _, sin acentos ni espacios, empieza por letra, máx. 20)"; ENDIF
   IF o:FieldIdx( cName ) > 0; RETURN "ya existe un campo llamado " + cName; ENDIF
   IF Len( o:aFields ) >= DT_MAXFIELDS; RETURN "máximo " + LTrim( Str( DT_MAXFIELDS ) ) + " campos"; ENDIF
RETURN ""

METHOD AddInput( cName, cLabel, nDec, nDef ) CLASS TDForm
   LOCAL cErr := DT_CommonCheck( Self, cName )
   IF ! Empty( cErr ); RETURN cErr; ENDIF
   AAdd( ::aFields, { cName, DT_CleanLabel( cLabel, cName ), "in", iif( nDec > 0, 2, 0 ), "" } )
   ::hF[ cName ] := nDef
RETURN ""

METHOD AddFormula( cName, cLabel, cExpr ) CLASS TDForm
   LOCAL cErr := DT_CommonCheck( Self, cName )
   IF ! Empty( cErr ); RETURN cErr; ENDIF
   cErr := DT_Check( cExpr, hb_HKeys( ::hF ) )
   IF ! Empty( cErr ); RETURN cErr; ENDIF
   AAdd( ::aForms, { cName, DT_Canon( cExpr, hb_HKeys( ::hF ) ) } )
   cErr := ::Order()
   IF ! Empty( cErr ); ASize( ::aForms, Len( ::aForms ) - 1 ); ::Order(); RETURN cErr; ENDIF
   AAdd( ::aFields, { cName, DT_CleanLabel( cLabel, cName ), "fx", 2, "" } )
   ::hF[ cName ] := 0
   ::Recalc()
RETURN ""

METHOD AddTree( cName, cLabel, cTest, cUnit ) CLASS TDForm
   LOCAL cErr := DT_CommonCheck( Self, cName ), k := ::FieldIdx( cTest )
   IF ! Empty( cErr ); RETURN cErr; ENDIF
   IF k == 0; RETURN "el campo de prueba " + cTest + " no existe"; ENDIF
   IF ::aFields[ k ][ 3 ] == "btn"; RETURN "un botón no puede ser campo de prueba"; ENDIF
   cTest := ::aFields[ k ][ 1 ]
   AAdd( ::aRules, { cName, cTest, { { ">=", 1, { "const", 0 } }, { "otherwise", NIL, { "const", 0 } } } } )
   cErr := ::Order()
   IF ! Empty( cErr ); ASize( ::aRules, Len( ::aRules ) - 1 ); ::Order(); RETURN cErr; ENDIF
   AAdd( ::aFields, { cName, DT_CleanLabel( cLabel, cName ), "tree", 2, Left( StrTran( cUnit, "|", "" ), 4 ) } )
   ::hF[ cName ] := 0
   ::Recalc()
RETURN ""

/* button field: a decision tree whose result is an action code (0 nothing, 1 save order, 2 clear inputs) */
METHOD AddButton( cName, cLabel, cTest ) CLASS TDForm
   LOCAL cErr := ::AddTree( cName, cLabel, cTest, "" )
   IF Empty( cErr ); ::aFields[ Len( ::aFields ) ][ 3 ] := "btn"; ::aFields[ Len( ::aFields ) ][ 4 ] := 0; ENDIF
RETURN cErr

/* names of the fields whose formula or tree test uses cName */
METHOD UsedBy( cName ) CLASS TDForm
   LOCAL a := {}, f, r, aN, x
   FOR EACH f IN ::aForms
      aN := DT_Names( f[ 2 ] )
      FOR EACH x IN aN
         IF Upper( x ) == Upper( cName ); AAdd( a, f[ 1 ] ); EXIT; ENDIF
      NEXT
   NEXT
   FOR EACH r IN ::aRules
      IF Upper( r[ 2 ] ) == Upper( cName ); AAdd( a, r[ 1 ] ); ENDIF
   NEXT
RETURN a

METHOD RemoveField( cName ) CLASS TDForm
   LOCAL k := ::FieldIdx( cName ), aU, i, c := ""
   IF k == 0; RETURN "no existe el campo " + cName; ENDIF
   cName := ::aFields[ k ][ 1 ]
   aU := ::UsedBy( cName )
   IF ! Empty( aU )
      AEval( aU, { | x | c += iif( Empty( c ), "", ", " ) + x } )
      RETURN "no se puede quitar " + cName + ": lo usan " + c
   ENDIF
   IF Len( ::aFields ) <= 1; RETURN "debe quedar al menos un campo"; ENDIF
   i := ::FormIdx( cName ); IF i > 0; ADel( ::aForms, i ); ASize( ::aForms, Len( ::aForms ) - 1 ); ENDIF
   i := ::RuleIdx( cName ); IF i > 0; ADel( ::aRules, i ); ASize( ::aRules, Len( ::aRules ) - 1 ); ENDIF
   ADel( ::aFields, k ); ASize( ::aFields, Len( ::aFields ) - 1 )
   hb_HDel( ::hF, cName )
   ::Order(); ::Recalc()
RETURN ""

/* Project text. Branch numbers are written with up to 4 decimals. */
STATIC FUNCTION DT_Num( n )
   LOCAL c := LTrim( Str( n, 14, 4 ) )
   DO WHILE Right( c, 1 ) == "0" .AND. "." $ c; c := Left( c, Len( c ) - 1 ); ENDDO
   IF Right( c, 1 ) == "."; c := Left( c, Len( c ) - 1 ); ENDIF
RETURN c

METHOD Serialize() CLASS TDForm
   LOCAL c := "DFP|1" + Chr( 10 ) + "title|" + ::cTitle + Chr( 10 ), f, i, b, r
   FOR EACH f IN ::aFields
      DO CASE
      CASE f[ 3 ] == "in"
         c += "in|" + f[ 1 ] + "|" + f[ 2 ] + "|" + LTrim( Str( f[ 4 ] ) ) + "|" + DT_Num( ::hF[ f[ 1 ] ] ) + Chr( 10 )
      CASE f[ 3 ] == "fx"
         c += "fx|" + f[ 1 ] + "|" + f[ 2 ] + "|" + ::aForms[ ::FormIdx( f[ 1 ] ) ][ 2 ] + Chr( 10 )
      OTHERWISE
         r := ::aRules[ ::RuleIdx( f[ 1 ] ) ]
         c += iif( f[ 3 ] == "btn", "btn|", "tree|" ) + f[ 1 ] + "|" + f[ 2 ] + "|" + r[ 2 ] + "|" + f[ 5 ] + "|"
         FOR EACH b IN r[ 3 ]

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:04 PM

dtree.prg - part 2 of 2
Lines 440-515 of the supplied source. Concatenate all 2 code blocks for dtree.prg in order into one file, with a newline between blocks. Do not add the headings.

            c += b[ 1 ] + "," + iif( b[ 1 ] == "otherwise", "0", DT_Num( b[ 2 ] ) ) + "," + DT_Num( b[ 3 ][ 2 ] ) + ";"
         NEXT
         c += Chr( 10 )
      ENDCASE
   NEXT
RETURN c

/* DT_Load( cText ) -> { oModel | NIL, cErr }. Never evaluates text as code. */
FUNCTION DT_Load( cText )
   LOCAL o := TDForm():New(), a, cL, n := 0, p, cErr := "", aB, aBr, cB, q, nMax, lT := .F.
   cText := StrTran( cText, Chr( 13 ), "" )
   FOR EACH cL IN hb_ATokens( cText, Chr( 10 ) )
      n++
      IF Empty( AllTrim( cL ) ); LOOP; ENDIF
      p := hb_ATokens( cL, "|" )
      IF ! lT
         IF ! ( Len( p ) == 2 .AND. p[ 1 ] == "DFP" .AND. p[ 2 ] == "1" ); RETURN { NIL, "no es un proyecto DFP versión 1" }; ENDIF
         lT := .T.; LOOP
      ENDIF
      DO CASE
      CASE p[ 1 ] == "title" .AND. Len( p ) == 2
         o:cTitle := Left( p[ 2 ], 40 )
      CASE p[ 1 ] == "in" .AND. Len( p ) == 5
         cErr := o:AddInput( p[ 2 ], p[ 3 ], iif( Val( p[ 4 ] ) > 0, 2, 0 ), Val( p[ 5 ] ) )
      CASE p[ 1 ] == "fx" .AND. Len( p ) == 4
         cErr := o:AddFormula( p[ 2 ], p[ 3 ], p[ 4 ] )
      CASE ( p[ 1 ] == "tree" .OR. p[ 1 ] == "btn" ) .AND. Len( p ) == 6
         cErr := iif( p[ 1 ] == "btn", o:AddButton( p[ 2 ], p[ 3 ], p[ 4 ] ), o:AddTree( p[ 2 ], p[ 3 ], p[ 4 ], p[ 5 ] ) )
         IF Empty( cErr )
            aBr := {}
            cB := p[ 6 ]
            DO WHILE ( q := At( ";", cB ) ) > 0 .AND. Empty( cErr )
               a := hb_ATokens( Left( cB, q - 1 ), "," ); cB := SubStr( cB, q + 1 )
               IF Len( a ) != 3 .OR. ! ( a[ 1 ] $ ">=|>|<=|<|otherwise" ) .OR. Len( aBr ) >= 5
                  cErr := "ramas mal formadas en " + p[ 2 ]
               ELSE
                  AAdd( aBr, { a[ 1 ], iif( a[ 1 ] == "otherwise", NIL, Val( a[ 2 ] ) ), { "const", Val( a[ 3 ] ) } } )
               ENDIF
            ENDDO
            IF Empty( cErr ); cErr := DT_ValidateBranches( aBr ); ENDIF
            IF Empty( cErr ) .AND. o:aFields[ Len( o:aFields ) ][ 5 ] == "%"
               FOR EACH a IN aBr
                  IF a[ 3 ][ 2 ] < 0 .OR. a[ 3 ][ 2 ] > 100; cErr := "resultado fuera de 0-100 en " + p[ 2 ]; EXIT; ENDIF
               NEXT
            ENDIF
            IF Empty( cErr ) .AND. p[ 1 ] == "btn"
               FOR EACH a IN aBr
                  IF a[ 3 ][ 2 ] != Int( a[ 3 ][ 2 ] ) .OR. a[ 3 ][ 2 ] < 0 .OR. a[ 3 ][ 2 ] > 2; cErr := "acción fuera de 0-2 en " + p[ 2 ]; EXIT; ENDIF
               NEXT
            ENDIF
            IF Empty( cErr ); o:aRules[ o:RuleIdx( p[ 2 ] ) ][ 3 ] := aBr; ENDIF
         ENDIF
      OTHERWISE
         cErr := "línea desconocida"
      ENDCASE
      IF ! Empty( cErr ); RETURN { NIL, "línea " + LTrim( Str( n ) ) + ": " + cErr }; ENDIF
   NEXT
   IF ! lT .OR. Empty( o:aFields ); RETURN { NIL, "proyecto vacío" }; ENDIF
   o:Recalc()
RETURN { o, "" }

/* Default project: the sales-order example (same fields and rules as v0.9). */
FUNCTION DT_OrderModel()
   LOCAL o := TDForm():New()
   o:cTitle := "Pedido"
   o:AddInput( "Cantidad", "Cantidad", 0, 0 )
   o:AddInput( "Precio", "Precio", 2, 10 )
   o:AddFormula( "Subtotal", "Subtotal", "Cantidad * Precio" )
   o:AddTree( "Descuento", "Descuento", "Cantidad", "%" )
   o:aRules[ o:RuleIdx( "Descuento" ) ][ 3 ] := { { ">=", 100, { "const", 15 } }, { ">=", 25, { "const", 8 } }, { "otherwise", NIL, { "const", 0 } } }
   o:AddFormula( "Neto", "Neto", "Subtotal * ( 100 - Descuento ) / 100" )
   o:AddTree( "Envio", "Envío", "Neto", "€" )
   o:aRules[ o:RuleIdx( "Envio" ) ][ 3 ] := { { ">=", 500, { "const", 0 } }, { ">=", 200, { "const", 6 } }, { "otherwise", NIL, { "const", 12 } } }
   o:AddFormula( "Total", "Total", "Neto + Envio" )
RETURN o

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:04 PM

dstore.prg - part 1 of 1
Lines 1-139 of the supplied source. Concatenate all 1 code blocks for dstore.prg in order into one file, with a newline between blocks. Do not add the headings.

// ===== dstore.prg =====
/* dstore.prg - DBF persistence (pure Harbour, no FWH). One table per form structure:
   file orders_<crc of field names>.dbf, columns F01..Fnn N(14,4) in form field order. */

STATIC s_cCur := ""

FUNCTION DS_Open( cDir, o )
   LOCAL cSig := "", f, cFile, aS := {}, n := 0
   IF Select( "ORDERS" ) > 0; ORDERS->( dbCloseArea() ); ENDIF
   FOR EACH f IN o:aFields
      cSig += Upper( f[ 1 ] ) + ":"
      n++
      AAdd( aS, { "F" + StrZero( n, 2 ), "N", 14, 4 } )
   NEXT
   cFile := cDir + "\orders_" + LTrim( Str( hb_Crc32( cSig ) ) ) + ".dbf"
   IF ! hb_FileExists( cFile )
      dbCreate( cFile, aS, "DBFNTX" )
   ENDIF
   USE ( cFile ) VIA "DBFNTX" SHARED NEW ALIAS ORDERS
s_cCur := cFile
   IF Select( "ORDERS" ) > 0 .AND. ORDERS->( LastRec() ) == 0; DS_WriteMeta( cFile, o ); ENDIF
RETURN iif( Select( "ORDERS" ) > 0, cFile, "" )

/* Append the current values as a new record; returns record number or 0 */
FUNCTION DS_Save( o )
   LOCAL i
   ORDERS->( dbAppend() )
   IF NetErr(); RETURN 0; ENDIF
   FOR i := 1 TO Len( o:aFields )
      ORDERS->( FieldPut( i, o:hF[ o:aFields[ i ][ 1 ] ] ) )
   NEXT
   ORDERS->( dbCommit() ); ORDERS->( dbUnlock() )
RETURN ORDERS->( RecNo() )

FUNCTION DS_Count()
RETURN iif( Select( "ORDERS" ) > 0, ORDERS->( LastRec() ), 0 )

/* Other order tables on disk (previous structures), newest first by date; read-only use */
FUNCTION DS_Others( cDir )
   LOCAL aD := Directory( cDir + "\orders_*.dbf" ), aR := {}, x
   ASort( aD,,, { | p, q | DToS( p[ 3 ] ) + p[ 4 ] > DToS( q[ 3 ] ) + q[ 4 ] } )
   FOR EACH x IN aD
      IF ! ( Upper( cDir + "\" + x[ 1 ] ) == Upper( s_cCur ) ); AAdd( aR, cDir + "\" + x[ 1 ] ); ENDIF
   NEXT
RETURN aR

/* Open an old table read-only as alias HIST (closes a previous one). Returns field count or 0 */
FUNCTION DS_OpenHist( cFile )
   IF Select( "HIST" ) > 0; HIST->( dbCloseArea() ); ENDIF
   IF Empty( cFile ); RETURN 0; ENDIF
   USE ( cFile ) VIA "DBFNTX" SHARED READONLY NEW ALIAS HIST
RETURN iif( Select( "HIST" ) > 0, HIST->( FCount() ), 0 )

FUNCTION DS_CloseHist()
   IF Select( "HIST" ) > 0; HIST->( dbCloseArea() ); ENDIF
RETURN NIL

FUNCTION DS_HistCount()
RETURN iif( Select( "HIST" ) > 0, HIST->( LastRec() ), 0 )

FUNCTION DS_LastH( nMax, nF, nSkip )
   LOCAL aR := {}, nRec, i, a
   IF Select( "HIST" ) == 0; RETURN aR; ENDIF
   FOR nRec := HIST->( LastRec() ) - nSkip TO 1 STEP -1
      IF Len( aR ) >= nMax; EXIT; ENDIF
      HIST->( dbGoto( nRec ) )
      a := {}
      FOR i := 1 TO nF; AAdd( a, HIST->( FieldGet( i ) ) ); NEXT
      AAdd( aR, { nRec, a } )
   NEXT
RETURN aR

/* Read-only: newest first, up to nMax records of the current table. Returns { { recno, { v1, v2, ... } }, ... } */
FUNCTION DS_Last( nMax, nF, nSkip )
   LOCAL aR := {}, nRec, i, a
   IF nSkip == NIL; nSkip := 0; ENDIF
   IF Select( "ORDERS" ) == 0; RETURN aR; ENDIF
   FOR nRec := ORDERS->( LastRec() ) - nSkip TO 1 STEP -1
      IF Len( aR ) >= nMax; EXIT; ENDIF
      ORDERS->( dbGoto( nRec ) )
      a := {}
      FOR i := 1 TO nF; AAdd( a, ORDERS->( FieldGet( i ) ) ); NEXT
      AAdd( aR, { nRec, a } )
   NEXT
RETURN aR

/* Written only when the table is empty at open (no rows can predate the labels), never for a table that already has rows.
   Auxiliary additive metadata: orders_<crc>.meta, written only if absent (never overwritten), so old tables keep
   whatever meaning was recorded when they were first used. Lines: F01|Name|Label|kind|dec */
FUNCTION DS_MetaFile( cFile )
RETURN Left( cFile, Len( cFile ) - 4 ) + ".meta"

FUNCTION DS_WriteMeta( cFile, o )
   LOCAL c := "DFM|1" + Chr( 10 ), i, f
   IF hb_FileExists( DS_MetaFile( cFile ) ); RETURN .F.; ENDIF
   FOR i := 1 TO Len( o:aFields )
      f := o:aFields[ i ]
      c += "F" + StrZero( i, 2 ) + "|" + f[ 1 ] + "|" + StrTran( f[ 2 ], "|", " " ) + "|" + f[ 3 ] + "|" + LTrim( Str( f[ 4 ] ) ) + Chr( 10 )
   NEXT
RETURN hb_MemoWrit( DS_MetaFile( cFile ), c )

/* Returns array of { name, label, kind, dec } in column order, or {} if no valid .meta */
FUNCTION DS_ReadMeta( cFile )
   LOCAL aR := {}, c, aL, l, a
   IF ! hb_FileExists( DS_MetaFile( cFile ) ); RETURN aR; ENDIF
   c := StrTran( MemoRead( DS_MetaFile( cFile ) ), Chr( 13 ), "" )
   aL := hb_ATokens( c, Chr( 10 ) )
   IF Empty( aL ) .OR. ! ( aL[ 1 ] == "DFM|1" ); RETURN {}; ENDIF
   FOR EACH l IN aL
      IF Left( l, 1 ) == "F"
         a := hb_ATokens( l, "|" )
         IF Len( a ) == 5; AAdd( aR, { a[ 2 ], a[ 3 ], a[ 4 ], Val( a[ 5 ] ) } ); ENDIF
      ENDIF
   NEXT
RETURN aR

/* Export all rows of the current table to a NEW csv file (never overwrites): ; separator, . decimal, UTF-8 BOM.
   Returns the file name written or "" */
FUNCTION DS_ExportCsv( cDir, o )
   LOCAL n := 1, cF, c, i, r, f, cV
   DO WHILE hb_FileExists( cDir + "\export_" + LTrim( Str( n ) ) + ".csv" ); n++; ENDDO
   cF := cDir + "\export_" + LTrim( Str( n ) ) + ".csv"
   c := hb_BChar( 239 ) + hb_BChar( 187 ) + hb_BChar( 191 ) + "Pedido"
   FOR EACH f IN o:aFields
      IF f[ 3 ] != "btn"; c += ";" + StrTran( f[ 2 ], ";", " " ); ENDIF
   NEXT
   c += Chr( 13 ) + Chr( 10 )
   FOR r := 1 TO ORDERS->( LastRec() )
      ORDERS->( dbGoto( r ) )
      c += LTrim( Str( r ) )
      FOR i := 1 TO Len( o:aFields )
         IF o:aFields[ i ][ 3 ] != "btn"
            cV := LTrim( Str( ORDERS->( FieldGet( i ) ), 16, o:aFields[ i ][ 4 ] ) )
            c += ";" + cV
         ENDIF
      NEXT
      c += Chr( 13 ) + Chr( 10 )
   NEXT
RETURN iif( hb_MemoWrit( cF, c ), cF, "" )

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:05 PM

fwhforms.prg - part 1 of 4
Lines 1-401 of the supplied source. Concatenate all 4 code blocks for fwhforms.prg in order into one file, with a newline between blocks. Do not add the headings.

// ===== fwhforms.prg (part 1 of 2, lines 1-703) =====
/* fwhforms.prg - "FWH Decision Forms": prototype of connected forms + decision trees, as an FWH sample.
   Idea inspired by form/decision-tree tools of the early 90s (no third-party assets, no file-format compatibility).
   Real MDI frame with 6 MDICHILD windows; own-painted layout (C/GDI helpers at the end of this file) plus real FWH GETs.
   Harbour first; syntax kept xHarbour-friendly (NOT tested with xHarbour). See README.md for status and limits. */
#include "FiveWin.ch"

REQUEST DBFNTX

#define CL_BG    RGB( 238, 241, 246 )
#define CL_INK   RGB( 17, 24, 39 )
#define CL_MUTE  RGB( 100, 116, 139 )
#define CL_EDGE  RGB( 218, 224, 233 )
#define CL_ACC   RGB( 37, 99, 235 )
#define CL_ACCL  RGB( 219, 234, 254 )
#define CL_WHITE RGB( 255, 255, 255 )
#define CL_SOFT  RGB( 241, 245, 249 )
#define CL_PALE  RGB( 248, 250, 252 )
#define CL_RED   RGB( 185, 28, 28 )

STATIC oWC, oWnd, oWF, oWT, oWP, oWB, oWS, oM, oFont, oFontB, cDir, cProj, cRules
STATIC nDragF := 0, aDragPt := { 0, 0 }, nPre := 1, aWin := {}, aGets := {}, aVal := {}
STATIC oGLab, cLab := "", oGThr, oGRes, oGExp, oSink, cSink := " "
STATIC nThr := 0, nRes := 0, nSel := 1, nFSel := 1, cExp := ""
STATIC aLinks := {}, aLUndo := {}
STATIC cMsg := "", lBad := .F., lInvPend := .F., cBackup := "", lBackOk := .F.
STATIC nSaved := 0, nLast := 0, lReady := .F., lView := .F., nPage := 0, aOth := {}, nOth := 0, nHF := 0, aUndo := {}, nCol := 0

PROCEDURE Main()
   LOCAL i
   cDir := cFilePath( hb_argv( 0 ) ) + "demo_data"
   cProj := cDir + "\project.dfp"; cRules := cDir + "\rules.ini"
   IF ! lIsDir( cDir ); MakeDir( cDir ); ENDIF
   Msg( LoadProject(), .F. )
   IF Empty( DS_Open( cDir, oM ) ); MsgStop( "No se pudo abrir la tabla de pedidos" ); RETURN; ENDIF
   nSaved := DS_Count()

   DEFINE FONT oFont  NAME "Segoe UI" SIZE 0, -16
   DEFINE FONT oFontB NAME "Segoe UI" SIZE 0, -16 BOLD
   DEFINE WINDOW oWnd MDI FROM 0, 0 TO 850, 1240 PIXEL TITLE "FWH Decision Forms (prototipo MDI)"
   DEFINE WINDOW oWB MDICHILD FROM 2, 4 TO 86, 1196 PIXEL TITLE "Acciones" OF oWnd
   DEFINE WINDOW oWF MDICHILD FROM 90, 4 TO 575, 376 PIXEL TITLE "Formulario" OF oWnd
   DEFINE WINDOW oWT MDICHILD FROM 108, 384 TO 575, 502 PIXEL TITLE "Arbol" OF oWnd
   DEFINE WINDOW oWP MDICHILD FROM 90, 890 TO 600, 310 PIXEL TITLE "Propiedades" OF oWnd
   DEFINE WINDOW oWS MDICHILD FROM 692, 4 TO 84, 520 PIXEL TITLE "Estado" OF oWnd
   DEFINE WINDOW oWC MDICHILD FROM 692, 528 TO 84, 668 PIXEL TITLE "Componentes (clic: anadir campo)" OF oWnd
   FOR i := 1 TO 10; MakeGet( i ); NEXT
   @ 316-72, 908-884 GET oGThr VAR nThr PICTURE "9999999.99" OF oWP PIXEL SIZE 228, 24 FONT oFont NOBORDER COLOR CL_INK, CL_PALE VALID ApplyEdit()
   @ 396-72, 908-884 GET oGRes VAR nRes PICTURE "9999999.99" OF oWP PIXEL SIZE 228, 24 FONT oFont NOBORDER COLOR CL_INK, CL_PALE VALID ApplyEdit()
   @ 4, 4 GET oSink VAR cSink OF oWF PIXEL SIZE 2, 2 NOBORDER COLOR CL_BG, CL_BG
   @ 252-72, 908-884 GET oGLab VAR cLab PICTURE "@S34" OF oWP PIXEL SIZE 228, 24 FONT oFont NOBORDER COLOR CL_INK, CL_PALE VALID ApplyLabel()
   @ 172-116, 412-388 GET oGExp VAR cExp PICTURE "@S50" OF oWT PIXEL SIZE 432, 30 FONT oFont NOBORDER COLOR CL_INK, CL_WHITE VALID ApplyFormula()
   AAdd( aWin, { oWB, 0, 0 } ); AAdd( aWin, { oWF, 16, 100 } ); AAdd( aWin, { oWT, 388, 116 } ); AAdd( aWin, { oWP, 884, 72 } ); AAdd( aWin, { oWS, 0, 652 } ); AAdd( aWin, { oWC, 0, 9999 } )
   FOR i := 1 TO 6
      WireWin( i )
   NEXT
   SyncGets(); SelField( 1, .T. ); lReady := .T.
   LoadLayout(); LoadLinks()
   ACTIVATE WINDOW oWB
   ACTIVATE WINDOW oWT
   ACTIVATE WINDOW oWP
   ACTIVATE WINDOW oWS
   ACTIVATE WINDOW oWC
   ACTIVATE WINDOW oWF
   ACTIVATE WINDOW oWnd CENTERED VALID ( SaveLayout(), SaveProject(), Select( "ORDERS" ) > 0 .AND. ORDERS->( dbCloseArea() ), .T. )
RETURN

STATIC FUNCTION WireWin( i )
   LOCAL oC := aWin[ i ][ 1 ], nx := aWin[ i ][ 2 ], ny := aWin[ i ][ 3 ]
   oC:bPainted := { | hDC | PaintAll( hDC, oC, nx, ny ) }
   oC:bLClicked := { || ClickAt( oC, nx, ny ) }
   oC:bKeyDown := { | nKey | KeyAct( nKey ) }
   IF i == 2; oC:bLButtonUp := { || OnUp() }; ENDIF
RETURN NIL

STATIC FUNCTION LogW( i, oC )
   IF i == 3; hb_MemoWrit( "wlog.txt", MemoRead( "wlog.txt" ) + Chr(10) + hb_ntos( oC:nTop ) + "," + hb_ntos( oC:nLeft ) + "," + hb_ntos( oC:nWidth ) + "," + hb_ntos( oC:nHeight ) + " b=" + hb_ntos( oC:nBottom ) + " r=" + hb_ntos( oC:nRight ) ); ENDIF
RETURN NIL

STATIC FUNCTION SaveLayout()
   LOCAL i, c := "", n
   FOR i := 1 TO 6
      n := DF_ChildRect( aWin[ i ][ 1 ]:hWnd )
      IF ! Empty( n ); c += n + Chr( 13 ) + Chr( 10 ); ENDIF
   NEXT
   IF Len( c ) > 40; hb_MemoWrit( cDir + "\layout.ini", c ); ENDIF
RETURN NIL

STATIC FUNCTION LoadLayout()
   LOCAL i, a, c := iif( File( cDir + "\layout.ini" ), MemoRead( cDir + "\layout.ini" ), "" ), aL
   aL := hb_ATokens( StrTran( c, Chr( 13 ), "" ), Chr( 10 ) )
   FOR i := 1 TO 6
      IF i <= Len( aL ) .AND. ! Empty( aL[ i ] )
         a := hb_ATokens( aL[ i ], "," )
         IF Len( a ) == 4 .AND. Val( a[ 3 ] ) >= 120 .AND. Val( a[ 4 ] ) >= 60 .AND. Val( a[ 1 ] ) > -2000 .AND. Val( a[ 1 ] ) < 4000 .AND. Val( a[ 2 ] ) > -2000 .AND. Val( a[ 2 ] ) < 4000
            aWin[ i ][ 1 ]:Move( Val( a[ 2 ] ), Val( a[ 1 ] ), Val( a[ 3 ] ), Val( a[ 4 ] ), .F. )
         ENDIF
      ENDIF
   NEXT
RETURN NIL

STATIC FUNCTION RefAll()
   LOCAL i, cK
   IF Len( aWin ) < 6; RETURN NIL; ENDIF
   IF lReady
      cK := oM:aFields[ nFSel ][ 3 ]
      oWF:SetText( oM:cTitle + "  (editar)" )
      oWT:SetText( iif( lView, "Pedidos guardados", iif( cK == "btn", "Arbol de accion para  ", "Arbol de decision para  " ) + oM:aFields[ nFSel ][ 2 ] ) )
   ENDIF
   FOR i := 1 TO 6; aWin[ i ][ 1 ]:Refresh(); NEXT
RETURN NIL

STATIC FUNCTION Msg( c, lErr )
   cMsg := c; lBad := lErr
   IF oWnd != NIL; RefAll(); ENDIF
RETURN NIL

STATIC FUNCTION A( c )
RETURN DF_U8ANSI( c )

/* ---- field helpers ---------------------------------------------------------------------------------- */
STATIC FUNCTION FN( n )
RETURN oM:aFields[ n ][ 1 ]
STATIC FUNCTION FK( n )
RETURN oM:aFields[ n ][ 3 ]
STATIC FUNCTION ShortLab( c, n )
   IF hb_ULen( c ) > n; RETURN hb_USubStr( c, 1, n - 3 ) + "..."; ENDIF
RETURN c

STATIC FUNCTION RowY( i )
RETURN 138 + ( i - 1 ) * 46
STATIC FUNCTION TrimNum( n )
   LOCAL c := LTrim( Str( n, 16, 4 ) )
   DO WHILE Right( c, 1 ) == "0" .AND. "." $ c; c := Left( c, Len( c ) - 1 ); ENDDO
   IF Right( c, 1 ) == "."; c := Left( c, Len( c ) - 1 ); ENDIF
RETURN c
STATIC FUNCTION ValStr( i )
   LOCAL f := oM:aFields[ i ], n := oM:hF[ f[ 1 ] ]
   IF f[ 3 ] == "btn"; RETURN ActShort( n ); ENDIF
   IF f[ 3 ] == "tree"; RETURN TrimNum( n ) + iif( Empty( f[ 5 ] ), "", " " + f[ 5 ] ); ENDIF
RETURN LTrim( Str( n, 16, f[ 4 ] ) )
STATIC FUNCTION ActName( n )
RETURN iif( n == 1, "Guardar pedido", iif( n == 2, "Limpiar entradas", "No hace nada" ) )
STATIC FUNCTION ActShort( n )
RETURN iif( n == 1, "Guardar", iif( n == 2, "Limpiar", "Nada" ) )

STATIC FUNCTION ExecButton()
   LOCAL nA, i
   IF FK( nFSel ) != "btn"; RETURN NIL; ENDIF
   OnInput(); nA := Int( oM:hF[ FN( nFSel ) ] )
   DO CASE
   CASE nA == 1
      SaveOrder()
   CASE nA == 2
      FOR i := 1 TO Len( oM:aFields )
         IF FK( i ) == "in"; oM:hF[ FN( i ) ] := 0; aVal[ i ] := 0; aGets[ i ]:Refresh(); ENDIF
      NEXT
      oM:Recalc(); Msg( "Botón: entradas puestas a cero", .F. )
   OTHERWISE
      Msg( "Botón: con estos valores no hace nada", .F. )
   ENDCASE
   RunLinks( FN( nFSel ) )
RETURN NIL

/* ---- enlaces evento->objeto (diseño propio): botón + "al pulsar" + campo destino + acción ---------------- */
STATIC FUNCTION LinkAct( n )
RETURN iif( n == 2, "sumar 1", "poner a cero" )
STATIC FUNCTION FIdx( c )
RETURN AScan( oM:aFields, { | x | Upper( x[ 1 ] ) == Upper( c ) } )
STATIC FUNCTION LinkOf( c )
RETURN AScan( aLinks, { | x | Upper( x[ 1 ] ) == Upper( c ) } )
STATIC FUNCTION CopyLinks()
   LOCAL a := {}, x
   FOR EACH x IN aLinks; AAdd( a, AClone( x ) ); NEXT
RETURN a
STATIC FUNCTION PushLU()
   AAdd( aLUndo, { CopyLinks(), Len( aUndo ) } ); IF Len( aLUndo ) > 20; ADel( aLUndo, 1 ); ASize( aLUndo, 20 ); ENDIF
RETURN NIL
STATIC FUNCTION SaveLinks()
   LOCAL c := "", x
   FOR EACH x IN aLinks; c += x[ 1 ] + "," + x[ 2 ] + "," + LTrim( Str( x[ 3 ] ) ) + Chr( 13 ) + Chr( 10 ); NEXT
   hb_MemoWrit( cDir + "\links.ini", c )
RETURN NIL
STATIC FUNCTION LoadLinks()
   LOCAL l, a
   aLinks := {}
   IF ! File( cDir + "\links.ini" ); RETURN NIL; ENDIF
   FOR EACH l IN hb_ATokens( StrTran( MemoRead( cDir + "\links.ini" ), Chr( 13 ), "" ), Chr( 10 ) )
      a := hb_ATokens( l, "," )
      IF Len( a ) == 3 .AND. FIdx( a[ 1 ] ) > 0 .AND. FIdx( a[ 2 ] ) > 0
         IF FK( FIdx( a[ 1 ] ) ) == "btn" .AND. FK( FIdx( a[ 2 ] ) ) == "in"; AAdd( aLinks, { a[ 1 ], a[ 2 ], Val( a[ 3 ] ) } ); ENDIF
      ENDIF
   NEXT
RETURN NIL
STATIC FUNCTION DropLink( i, j )
   LOCAL n := LinkOf( FN( i ) )
   IF FK( i ) != "btn"; Msg( "Solo un Botón puede lanzar un enlace: arrastra un Botón sobre un campo de entrada", .T. ); RETURN NIL; ENDIF
   IF FK( j ) != "in"; Msg( "El destino debe ser un campo de Entrada", .T. ); RETURN NIL; ENDIF
   PushLU()
   IF n > 0; aLinks[ n ] := { FN( i ), FN( j ), 1 }; ELSE; AAdd( aLinks, { FN( i ), FN( j ), 1 } ); ENDIF
   SaveLinks(); SelField( i, .T. ); RefAll()
   Msg( "Enlace: al pulsar " + LabelOf( FN( i ) ) + " -> " + LabelOf( FN( j ) ) + ": poner a cero (F12 deshace)", .F. )
RETURN NIL
STATIC FUNCTION CycleLink()
   LOCAL n := LinkOf( FN( nFSel ) )
   IF n == 0; RETURN NIL; ENDIF
   PushLU(); aLinks[ n ][ 3 ] := iif( aLinks[ n ][ 3 ] == 1, 2, 1 ); SaveLinks(); RefAll()
   Msg( "Acción del enlace: " + LinkAct( aLinks[ n ][ 3 ] ), .F. )
RETURN NIL
STATIC FUNCTION DelLink()
   LOCAL n := LinkOf( FN( nFSel ) )
   IF n == 0; RETURN NIL; ENDIF
   PushLU(); ADel( aLinks, n ); ASize( aLinks, Len( aLinks ) - 1 ); SaveLinks(); RefAll()
   Msg( "Enlace quitado (F12 deshace)", .F. )
RETURN NIL
STATIC FUNCTION RunLinks( cBtn )
   LOCAL n := LinkOf( cBtn ), j, v
   IF n == 0; RETURN NIL; ENDIF
   j := FIdx( aLinks[ n ][ 2 ] ); IF j == 0 .OR. FK( j ) != "in"; RETURN NIL; ENDIF
   v := iif( aLinks[ n ][ 3 ] == 2, oM:hF[ FN( j ) ] + 1, 0 )
   oM:hF[ FN( j ) ] := v; aVal[ j ] := v; aGets[ j ]:Refresh(); oM:Recalc(); RefAll()
   Msg( "Al pulsar " + LabelOf( cBtn ) + ": " + LabelOf( FN( j ) ) + " " + LinkAct( aLinks[ n ][ 3 ] ), .F. )
RETURN NIL

STATIC FUNCTION Sym( c )
RETURN iif( c == ">=", "≥", iif( c == "<=", "≤", c ) )
STATIC FUNCTION RB()
RETURN oM:aRules[ oM:RuleIdx( FN( nFSel ) ) ][ 3 ]
STATIC FUNCTION RTest()
RETURN oM:aRules[ oM:RuleIdx( FN( nFSel ) ) ][ 2 ]
STATIC FUNCTION IsTree()
RETURN FK( nFSel ) == "tree" .OR. FK( nFSel ) == "btn"
STATIC FUNCTION LabelOf( cName )
   LOCAL k := oM:FieldIdx( cName )
RETURN iif( k > 0, oM:aFields[ k ][ 2 ], cName )

STATIC FUNCTION Branch()
   LOCAL n, aB := RB(), xT := oM:hF[ RTest() ]
   FOR n := 1 TO Len( aB )
      IF DT_Cond( aB[ n ][ 1 ], aB[ n ][ 2 ], xT ); RETURN n; ENDIF
   NEXT
RETURN Len( aB )

STATIC FUNCTION Anc( cName, aOut )
   LOCAL k := oM:FormIdx( cName ), r := oM:RuleIdx( cName ), a := {}, x, j
   IF k > 0; a := DT_Names( oM:aForms[ k ][ 2 ] ); ELSEIF r > 0; a := { oM:aRules[ r ][ 2 ] }; ENDIF
   FOR EACH x IN a
      j := oM:FieldIdx( x )
      IF j > 0 .AND. AScan( aOut, j ) == 0; AAdd( aOut, j ); Anc( oM:aFields[ j ][ 1 ], aOut ); ENDIF
   NEXT
RETURN aOut

/* ---- input GET pool ----------------------------------------------------------------------------------- */
STATIC FUNCTION MakeGet( i )
   LOCAL oG
   AAdd( aVal, 0 )
   @ 45, 176 GET oG VAR aVal[ i ] PICTURE "999999999" OF oWF PIXEL SIZE 142, 24 FONT oFontB NOBORDER COLOR CL_INK, CL_WHITE VALID ( OnInput(), .T. )
   oG:bGotFocus := { || SelField( i ) }
   oG:Hide()
   AAdd( aGets, oG )
RETURN NIL

STATIC FUNCTION SyncGets()
   LOCAL i, f
   FOR i := 1 TO 10
      IF i <= Len( oM:aFields ) .AND. FK( i ) == "in"
         f := oM:aFields[ i ]
         aVal[ i ] := oM:hF[ f[ 1 ] ]
         aGets[ i ]:oGet:Picture := iif( f[ 4 ] > 0, "99999999.99", "999999999" )
         aGets[ i ]:Move( RowY( i ) + 7 - 100, 192 - 16, 142, 24, .T. )
         aGets[ i ]:Show(); aGets[ i ]:Refresh()
      ELSE
         aGets[ i ]:Hide()
      ENDIF
   NEXT
RETURN NIL

STATIC FUNCTION OnInput()
   LOCAL i
   FOR i := 1 TO Len( oM:aFields )
      IF FK( i ) == "in"; aGets[ i ]:Assign(); oM:hF[ FN( i ) ] := aVal[ i ]; ENDIF
   NEXT
   oM:Recalc()
   IF oM:lErr; Msg( "Atención: una fórmula divide por cero con estos valores; ese campo queda en 0", .T. ); ENDIF
   RefAll()
RETURN .T.

/* ---- selection ---------------------------------------------------------------------------------------- */
STATIC FUNCTION SelField( n, lForce )
   LOCAL cK
   IF n < 1 .OR. n > Len( oM:aFields ); RETURN NIL; ENDIF
   IF lForce == NIL; lForce := .F.; ENDIF
   IF n == nFSel .AND. ! lForce; RETURN NIL; ENDIF
   IF lReady .AND. ! lForce
      IF FK( nFSel ) == "fx"
         oGExp:Assign()
         IF ! ( AllTrim( cExp ) == oM:aForms[ oM:FormIdx( FN( nFSel ) ) ][ 2 ] ) .AND. ! ApplyFormula( .T. ); RETURN NIL; ENDIF
      ELSEIF FK( nFSel ) == "tree" .OR. FK( nFSel ) == "btn"
         oGThr:Assign(); oGRes:Assign()
      ENDIF
      IF FK( nFSel ) == "in" .OR. FK( nFSel ) == "fx"; ApplyLabel( .T. ); ENDIF
   ENDIF
   nFSel := n; cK := FK( n )
   IF cK == "in" .OR. cK == "fx"
      cLab := PadR( DF_U8ANSI( oM:aFields[ n ][ 2 ] ), 60 ); oGLab:Show(); oGLab:Refresh()
   ELSE
      oGLab:Hide()
   ENDIF
   IF cK != "tree" .AND. cK != "btn"; oGThr:Hide(); oGRes:Hide(); ENDIF
   IF cK != "fx"; oGExp:Hide(); ENDIF
   IF cK == "tree" .OR. cK == "btn"
      oGThr:Show(); oGRes:Show(); SelBranch( 1 )
   ELSEIF cK == "fx"
      cExp := PadR( oM:aForms[ oM:FormIdx( FN( n ) ) ][ 2 ], 120 ); oGExp:Show(); oGExp:Refresh()
   ENDIF
   Msg( "", .F. )
RETURN NIL

STATIC FUNCTION SelBranch( n )
   LOCAL aB := RB()
   nSel := n
   nThr := iif( aB[ n ][ 1 ] == "otherwise", 0, aB[ n ][ 2 ] )
   nRes := aB[ n ][ 3 ][ 2 ]
   IF aB[ n ][ 1 ] == "otherwise"; oGThr:Disable(); ELSE; oGThr:Enable(); ENDIF
   oGThr:Refresh(); oGRes:Refresh()
   IF oWnd != NIL; RefAll(); ENDIF
RETURN NIL

/* ---- editing: trees ------------------------------------------------------------------------------------ */
STATIC FUNCTION UnitMax()
RETURN iif( FK( nFSel ) == "btn", 2, iif( oM:aFields[ nFSel ][ 5 ] == "%", 100, 999999999 ) )
STATIC FUNCTION UnitMin()
RETURN iif( FK( nFSel ) == "btn" .OR. oM:aFields[ nFSel ][ 5 ] == "%", 0, -999999999 )

STATIC FUNCTION ApplyEdit()
   LOCAL aB, nOld, cErr
   IF ! IsTree(); RETURN .T.; ENDIF
   aB := RB()
   oGThr:Assign(); oGRes:Assign()
   IF nRes == aB[ nSel ][ 3 ][ 2 ] .AND. ( aB[ nSel ][ 1 ] == "otherwise" .OR. nThr == aB[ nSel ][ 2 ] ); RETURN .T.; ENDIF
   IF ! ConfirmOverwrite(); RETURN .T.; ENDIF
   IF nRes < UnitMin() .OR. nRes > UnitMax() .OR. ( FK( nFSel ) == "btn" .AND. nRes != Int( nRes ) )
      Msg( "Resultado fuera de rango: use un valor entre " + LTrim( Str( UnitMin() ) ) + " y " + LTrim( Str( UnitMax() ) ) + " " + oM:aFields[ nFSel ][ 5 ], .T. )
      RETURN .F.
   ENDIF
   IF aB[ nSel ][ 1 ] != "otherwise"
      nOld := aB[ nSel ][ 2 ]; aB[ nSel ][ 2 ] := nThr
      cErr := DT_ValidateBranches( aB )
      IF ! Empty( cErr ); aB[ nSel ][ 2 ] := nOld; Msg( cErr, .T. ); RETURN .F.; ENDIF
   ENDIF
   aB[ nSel ][ 3 ][ 2 ] := nRes
   SaveProject(); oM:Recalc(); Msg( "Regla guardada en project.dfp", .F. )
RETURN .T.

STATIC FUNCTION CycleOp()
   LOCAL aB, aOps := { ">=", ">", "<=", "<" }, cOld, nI, n
   IF ! IsTree(); RETURN NIL; ENDIF
   aB := RB()
   IF aB[ nSel ][ 1 ] == "otherwise" .OR. ! ConfirmOverwrite(); RETURN NIL; ENDIF
   cOld := aB[ nSel ][ 1 ]; nI := AScan( aOps, cOld )
   FOR n := 1 TO 3
      aB[ nSel ][ 1 ] := aOps[ ( nI + n - 1 ) % 4 + 1 ]
      IF Empty( DT_ValidateBranches( aB ) )
         SaveProject(); oM:Recalc(); Msg( "Regla guardada (operador " + aB[ nSel ][ 1 ] + ")", .F. ); RETURN NIL
      ENDIF
   NEXT
   aB[ nSel ][ 1 ] := cOld
   Msg( "Con varias ramas el operador solo alterna dentro del mismo sentido", .T. )
RETURN NIL

STATIC FUNCTION AddBranch()
   LOCAL aB, nN, nL, cOp, nT, cErr
   IF ! IsTree(); RETURN NIL; ENDIF
   aB := RB(); nN := Len( aB ); nL := nN - 1
   IF nN >= 5; Msg( "Máximo 5 ramas (incluida 'en otro caso')", .T. ); RETURN NIL; ENDIF
   IF ! ConfirmOverwrite(); RETURN NIL; ENDIF
   cOp := aB[ nL ][ 1 ]
   IF cOp $ ">=|>"
      nT := iif( aB[ nL ][ 2 ] > 1, Int( aB[ nL ][ 2 ] / 2 ), aB[ nL ][ 2 ] - 1 )
   ELSE
      nT := iif( aB[ nL ][ 2 ] >= 1, aB[ nL ][ 2 ] * 2, aB[ nL ][ 2 ] + 1 )
   ENDIF
   ASize( aB, nN + 1 ); AIns( aB, nN )
   aB[ nN ] := { cOp, nT, { "const", UnitMin() * 0 } }
   cErr := DT_ValidateBranches( aB )
   IF ! Empty( cErr ); ADel( aB, nN ); ASize( aB, nN ); Msg( cErr, .T. ); RETURN NIL; ENDIF
   SaveProject(); oM:Recalc(); SelBranch( nN ); Msg( "Rama añadida; ajusta umbral y resultado a la derecha", .F. )
RETURN NIL

STATIC FUNCTION DelBranch()
   LOCAL aB
   IF ! IsTree(); RETURN NIL; ENDIF
   aB := RB()
   IF Len( aB ) <= 2 .OR. aB[ nSel ][ 1 ] == "otherwise"
      Msg( "No se puede quitar: queda al menos una condición y 'en otro caso'", .T. ); RETURN NIL
   ENDIF
   IF ! ConfirmOverwrite(); RETURN NIL; ENDIF
   ADel( aB, nSel ); ASize( aB, Len( aB ) - 1 )
   SaveProject(); oM:Recalc(); SelBranch( Min( nSel, Len( aB ) ) ); Msg( "Rama quitada", .F. )
RETURN NIL

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:05 PM

fwhforms.prg - part 2 of 4
Lines 402-715 of the supplied source. Concatenate all 4 code blocks for fwhforms.prg in order into one file, with a newline between blocks. Do not add the headings.

/* ---- editing: formulas ---------------------------------------------------------------------------------- */
STATIC FUNCTION ApplyFormula( lQuiet )
   LOCAL cErr, cNew, k, aK := hb_HKeys( oM:hF )
   IF FK( nFSel ) != "fx"; RETURN .T.; ENDIF
   k := oM:FormIdx( FN( nFSel ) )
   oGExp:Assign(); cNew := AllTrim( cExp )
   IF cNew == oM:aForms[ k ][ 2 ]; RETURN .T.; ENDIF
   cErr := DT_Check( cNew, aK )
   IF Empty( cErr ) .AND. DT_Canon( cNew, aK ) == oM:aForms[ k ][ 2 ]; cExp := PadR( oM:aForms[ k ][ 2 ], 120 ); oGExp:Refresh(); RETURN .T.; ENDIF
   IF Empty( cErr ) .AND. ! ConfirmOverwrite(); RETURN .F.; ENDIF
   IF Empty( cErr ); cErr := oM:SetFormulas( { { FN( nFSel ), cNew } } ); ENDIF
   IF ! Empty( cErr )
      Msg( "Fórmula no válida: " + cErr + ". Se mantiene la anterior.", .T. ); RETURN .F.
   ENDIF
   cExp := PadR( oM:aForms[ k ][ 2 ], 120 ); oGExp:Refresh()
   SaveProject(); Msg( "Fórmula guardada en project.dfp", .F. )
RETURN .T.

STATIC FUNCTION ApplyLabel( lQuiet )
   LOCAL f := oM:aFields[ nFSel ], c
   IF ! ( f[ 3 ] == "in" .OR. f[ 3 ] == "fx" ); RETURN .T.; ENDIF
   oGLab:Assign(); c := AllTrim( StrTran( StrTran( StrTran( DF_ANSI2U8( cLab ), "|", " " ), ";", " " ), Chr( 13 ), " " ) )
   IF Empty( c ); c := f[ 1 ]; ENDIF
   c := Left( c, 40 )
   IF c == f[ 2 ]; RETURN .T.; ENDIF
   IF ! ConfirmOverwrite(); RETURN .F.; ENDIF
   f[ 2 ] := c; cLab := PadR( DF_U8ANSI( c ), 60 ); oGLab:Refresh()
   SaveProject(); RefAll(); Msg( "Etiqueta guardada (solo cambia lo mostrado)", .F. )
RETURN .T.

STATIC FUNCTION ToggleDec()
   LOCAL f := oM:aFields[ nFSel ]
   IF f[ 3 ] != "in" .OR. ! ConfirmOverwrite(); RETURN NIL; ENDIF
   f[ 4 ] := iif( f[ 4 ] == 0, 2, 0 )
   SyncGets(); SaveProject(); RefAll(); Msg( "Decimales de " + f[ 1 ] + ": " + LTrim( Str( f[ 4 ] ) ) + " (solo cambia lo mostrado)", .F. )
RETURN NIL

/* ---- add / remove field --------------------------------------------------------------------------------- */
STATIC FUNCTION AddField()
   LOCAL oDlg, oGN, oGL, oGE, oGU, oGV, oCbK, oCbT, oErr, oBtn
   LOCAL cName := Space( 20 ), cLabel := Space( 40 ), cKind := A( "Entrada" ), cExpr := Space( 80 ), cTest, cUnit := Space( 2 ), nDef := 0
   LOCAL aKinds := { A( "Entrada" ), A( "Fórmula" ), A( "Árbol de decisión" ), A( "Botón (árbol de acciones)" ) }, aT := {}, f, lOk := .F., cE := ""
   cKind := aKinds[ nPre ]; nPre := 1
   FOR EACH f IN oM:aFields; AAdd( aT, f[ 1 ] ); NEXT
   cTest := aT[ 1 ]
   IF Len( oM:aFields ) >= 10; Msg( "Máximo 10 campos en este prototipo", .T. ); RETURN NIL; ENDIF
   IF ! ConfirmOverwrite(); RETURN NIL; ENDIF
   DEFINE DIALOG oDlg SIZE 520, 570 PIXEL TITLE A( "Nuevo campo" ) COLOR CL_INK, CL_WHITE
   @ 9, 12 SAY A( "Nombre (letras, números y _, sin acentos)" ) OF oDlg FONT oFont PIXEL SIZE 230, 10 TRANSPARENT
   @ 20, 12 GET oGN VAR cName OF oDlg FONT oFont PIXEL SIZE 110, 13
   @ 42, 12 SAY A( "Etiqueta que se muestra" ) OF oDlg FONT oFont PIXEL SIZE 110, 10 TRANSPARENT
   @ 53, 12 GET oGL VAR cLabel PICTURE "@S18" OF oDlg FONT oFont PIXEL SIZE 110, 13
   @ 75, 12 SAY A( "Tipo de campo" ) OF oDlg FONT oFont PIXEL SIZE 110, 10 TRANSPARENT
   @ 86, 12 COMBOBOX oCbK VAR cKind ITEMS aKinds OF oDlg FONT oFont PIXEL SIZE 110, 60 ON CHANGE KindChg( oCbK, oGV, oGE, oCbT, oGU )
   @ 108, 12 SAY A( "Valor inicial (solo Entrada)" ) OF oDlg FONT oFont PIXEL SIZE 110, 10 TRANSPARENT
   @ 119, 12 GET oGV VAR nDef PICTURE "99999999.99" OF oDlg FONT oFont PIXEL SIZE 110, 13
   @ 141, 12 SAY A( "Fórmula (solo Fórmula): campos, + - * / y paréntesis" ) OF oDlg FONT oFont PIXEL SIZE 230, 10 TRANSPARENT
   @ 152, 12 GET oGE VAR cExpr OF oDlg FONT oFont PIXEL SIZE 230, 13
   @ 173, 12 SAY A( "Decide según (Árbol, Botón)" ) OF oDlg FONT oFont PIXEL SIZE 110, 10 TRANSPARENT
   @ 184, 12 COMBOBOX oCbT VAR cTest ITEMS aT OF oDlg FONT oFont PIXEL SIZE 110, 60
   @ 173, 135 SAY A( "Unidad (Árbol)" ) OF oDlg FONT oFont PIXEL SIZE 60, 10 TRANSPARENT
   @ 184, 135 GET oGU VAR cUnit OF oDlg FONT oFont PIXEL SIZE 30, 13
   @ 205, 12 SAY oErr PROMPT "" OF oDlg FONT oFont PIXEL SIZE 235, 10 TRANSPARENT COLOR CL_RED, CL_WHITE
   @ 243, 12 SAY A( "Aviso: al cambiar los campos se abre una tabla de pedidos nueva. Los pedidos anteriores NO se borran: siguen en demo_data (orders_*.dbf), pero no se ven en esta ventana." ) OF oDlg FONT oFont PIXEL SIZE 235, 30 TRANSPARENT COLOR CL_MUTE, CL_WHITE
   @ 220, 135 BUTTON oBtn PROMPT A( "Crear campo" ) OF oDlg FONT oFont PIXEL SIZE 55, 16 ACTION ( cE := DoAdd( oGN, oGL, oGE, oGU, oGV, oCbK, oCbT ), ;
        iif( Empty( cE ), ( lOk := .T., oDlg:End() ), oErr:SetText( cE ) ) )
   @ 220, 196 BUTTON A( "Cancelar" ) OF oDlg FONT oFont PIXEL SIZE 50, 16 ACTION oDlg:End()
   ACTIVATE DIALOG oDlg CENTERED ON INIT KindChg( oCbK, oGV, oGE, oCbT, oGU )
   IF lOk
      lInvPend := .F.
      SyncGets(); DS_Open( cDir, oM ); nSaved := DS_Count(); nLast := 0; SaveProject()
      SelField( Len( oM:aFields ), .T. ); oM:Recalc()
      Msg( "Campo " + oM:aFields[ nFSel ][ 1 ] + " creado y guardado en project.dfp", .F. )
   ENDIF
RETURN NIL

STATIC FUNCTION KindChg( oCbK, oGV, oGE, oCbT, oGU )
   LOCAL n := oCbK:nAt
   IF n == 1; oGV:Enable(); ELSE; oGV:Disable(); ENDIF
   IF n == 2; oGE:Enable(); ELSE; oGE:Disable(); ENDIF
   IF n >= 3; oCbT:Enable(); ELSE; oCbT:Disable(); ENDIF
   IF n == 3; oGU:Enable(); ELSE; oGU:Disable(); ENDIF
RETURN NIL

STATIC FUNCTION MoveField( d )
   LOCAL n := nFSel, m := nFSel + d, t, r, cN
   IF m < 1 .OR. m > Len( oM:aFields ); Msg( iif( d < 0, "Ya es el primer campo", "Ya es el último campo" ), .F. ); RETURN NIL; ENDIF
   IF ! ConfirmOverwrite(); RETURN NIL; ENDIF
   OnInput(); cN := oM:aFields[ n ][ 1 ]
   t := oM:aFields[ n ]; oM:aFields[ n ] := oM:aFields[ m ]; oM:aFields[ m ] := t
   r := DT_Load( oM:Serialize() )
   IF r[ 1 ] == NIL
      t := oM:aFields[ n ]; oM:aFields[ n ] := oM:aFields[ m ]; oM:aFields[ m ] := t
      Msg( "No se puede mover: un campo quedaría antes del campo del que depende", .T. ); RETURN NIL
   ENDIF
   lInvPend := .F.
   nFSel := m
   SyncGets(); DS_Open( cDir, oM ); nSaved := DS_Count(); nLast := 0; SaveProject()
   SelField( m, .T. ); oM:Recalc()
   Msg( "Campo " + cN + " movido a la posición " + LTrim( Str( m ) ) + " (tabla de pedidos nueva)", .F. )
RETURN NIL

STATIC FUNCTION SaveCopy( lQuiet )
   LOCAL n := 1, cF
   IF lInvPend; Msg( "No se guarda copia: project.dfp está pendiente de confirmar", .T. ); RETURN ""; ENDIF
   OnInput()
   DO WHILE hb_FileExists( cDir + "\copia_proyecto_" + StrZero( n, 3 ) + ".dfp" ) .AND. n < 999; n++; ENDDO
   cF := cDir + "\copia_proyecto_" + StrZero( n, 3 ) + ".dfp"
   IF hb_FileExists( cF ); Msg( "Demasiadas copias (999): no se guarda otra", .T. ); RETURN ""; ENDIF
   IF ! hb_MemoWrit( cF, oM:Serialize() ); Msg( "No se pudo guardar la copia", .T. ); RETURN ""; ENDIF
   IF lQuiet == NIL .OR. ! lQuiet; Msg( "Copia guardada: copia_proyecto_" + StrZero( n, 3 ) + ".dfp (no se sobrescribe ni se carga sola)", .F. ); ENDIF
RETURN "copia_proyecto_" + StrZero( n, 3 ) + ".dfp"

STATIC FUNCTION OpenCopy()
   LOCAL oDlg, oCb, aD, aN := {}, x, cSel, lOk := .F., r, c, cBk, aOld := {}, f, k
   IF lInvPend; Msg( "No se abre copia: project.dfp está pendiente de confirmar", .T. ); RETURN NIL; ENDIF
   aD := Directory( cDir + "\copia_proyecto_*.dfp" )
   FOR EACH x IN aD; AAdd( aN, x[ 1 ] ); NEXT
   IF Empty( aN ); Msg( "No hay copias guardadas todavía (botón Copia)", .F. ); RETURN NIL; ENDIF
   ASort( aN,,, { | p, q | p > q } ); cSel := aN[ 1 ]
   DEFINE DIALOG oDlg SIZE 420, 190 PIXEL TITLE A( "Abrir copia del proyecto" ) COLOR CL_INK, CL_WHITE
   @ 9, 12 SAY A( "Copia (la más reciente primero)" ) OF oDlg FONT oFont PIXEL SIZE 190, 10 TRANSPARENT
   @ 22, 12 COMBOBOX oCb VAR cSel ITEMS aN OF oDlg FONT oFont PIXEL SIZE 190, 80
   @ 42, 12 SAY A( "Antes de sustituir, el proyecto actual se guarda como una copia nueva y también queda en Deshacer. Los pedidos no se tocan." ) OF oDlg FONT oFont PIXEL SIZE 190, 30 TRANSPARENT
   @ 76, 12 BUTTON A( "Abrir" ) OF oDlg FONT oFont PIXEL SIZE 55, 16 DEFAULT ACTION ( lOk := .T., oDlg:End() )
   @ 76, 74 BUTTON A( "Cancelar" ) OF oDlg FONT oFont PIXEL SIZE 55, 16 ACTION oDlg:End()
   ACTIVATE DIALOG oDlg CENTERED
   IF ! lOk; RETURN NIL; ENDIF
   cSel := aN[ Max( 1, oCb:nAt ) ]
   c := hb_MemoRead( cDir + "\" + cSel ); r := iif( Empty( c ), { NIL }, DT_Load( c ) )
   IF r[ 1 ] == NIL; Msg( "La copia no es válida: no se cambia nada", .T. ); RETURN NIL; ENDIF
   OnInput()
   cBk := SaveCopy( .T. )
   IF Empty( cBk ); Msg( "No se pudo guardar la copia previa: no se cambia nada", .T. ); RETURN NIL; ENDIF
   SaveProject()
   FOR EACH f IN oM:aFields
      IF f[ 3 ] == "in"; AAdd( aOld, { f[ 1 ], oM:hF[ f[ 1 ] ] } ); ENDIF
   NEXT
   AAdd( aUndo, oM:Serialize() ); IF Len( aUndo ) > 20; ADel( aUndo, 1 ); ASize( aUndo, 20 ); ENDIF
   oM := r[ 1 ]
   FOR EACH f IN aOld
      k := AScan( oM:aFields, { | y | Upper( y[ 1 ] ) == Upper( f[ 1 ] ) } )
      IF k > 0 .AND. oM:aFields[ k ][ 3 ] == "in"; oM:hF[ f[ 1 ] ] := f[ 2 ]; ENDIF
   NEXT
   hb_MemoWrit( cProj, oM:Serialize() )
   IF lView; lView := .F.; nOth := 0; DS_CloseHist(); ENDIF
   SyncGets(); DS_Open( cDir, oM ); nSaved := DS_Count(); nLast := 0
   nFSel := Min( nFSel, Len( oM:aFields ) ); nSel := 1
   SelField( nFSel, .T. ); oM:Recalc()
   Msg( "Abierta " + cSel + ". Proyecto anterior en " + cBk + " y en Deshacer", .F. )
RETURN NIL

STATIC FUNCTION DupField()
   LOCAL f := oM:aFields[ nFSel ], cN, n := 2, cErr, cL
   IF f[ 3 ] != "in"; RETURN NIL; ENDIF
   IF Len( oM:aFields ) >= 10; Msg( "Máximo 10 campos en este prototipo", .T. ); RETURN NIL; ENDIF
   IF ! ConfirmOverwrite(); RETURN NIL; ENDIF
   cN := Left( f[ 1 ], 17 ) + "_2"
   DO WHILE oM:FieldIdx( cN ) > 0 .AND. n < 9; n++; cN := Left( f[ 1 ], 17 ) + "_" + LTrim( Str( n ) ); ENDDO
   cL := Left( f[ 2 ], 30 ) + " (copia)"
   cErr := oM:AddInput( cN, cL, 2, 0 )
   IF ! Empty( cErr ); Msg( "No se pudo duplicar: " + cErr, .T. ); RETURN NIL; ENDIF
   oM:aFields[ Len( oM:aFields ) ][ 4 ] := f[ 4 ]
   lInvPend := .F.
   SyncGets(); DS_Open( cDir, oM ); nSaved := DS_Count(); nLast := 0; SaveProject()
   SelField( Len( oM:aFields ), .T. ); oM:Recalc()
   Msg( "Campo " + cN + " creado (copia de " + f[ 1 ] + ", valor 0)", .F. )
RETURN NIL

STATIC FUNCTION DoAdd( oGN, oGL, oGE, oGU, oGV, oCbK, oCbT )
   LOCAL cName, cLabel, cErr, nK := oCbK:nAt, cT, nDef
   oGN:Assign(); oGL:Assign(); oGE:Assign(); oGU:Assign(); oGV:Assign()
   cName := AllTrim( oGN:VarGet() ); cLabel := DF_ANSI2U8( AllTrim( oGL:VarGet() ) )
   cT := oM:aFields[ Max( 1, oCbT:nAt ) ][ 1 ]
   nDef := oGV:VarGet()
   DO CASE
   CASE nK == 1
      cErr := oM:AddInput( cName, cLabel, 2, nDef )
      IF Empty( cErr ) .AND. Int( nDef ) == nDef; oM:aFields[ Len( oM:aFields ) ][ 4 ] := 0; ENDIF
   CASE nK == 2
      cErr := oM:AddFormula( cName, cLabel, AllTrim( oGE:VarGet() ) )
   CASE nK == 4
      cErr := oM:AddButton( cName, cLabel, cT )
   OTHERWISE
      cErr := oM:AddTree( cName, cLabel, cT, DF_ANSI2U8( AllTrim( oGU:VarGet() ) ) )
   ENDCASE
RETURN cErr

STATIC FUNCTION RemoveField()
   LOCAL cErr, cN := FN( nFSel )
   IF ! ConfirmOverwrite(); RETURN NIL; ENDIF
   IF ! MsgYesNo( A( "¿Quitar el campo " + cN + " del formulario?" + Chr( 13 ) + Chr( 10 ) + Chr( 13 ) + Chr( 10 ) + "Se abrirá una tabla de pedidos nueva (sin ese campo). Los pedidos anteriores NO se borran: siguen en demo_data (orders_*.dbf) pero no se verán en esta ventana." ), "FWH Decision Forms" ); RETURN NIL; ENDIF
   cErr := oM:RemoveField( cN )
   IF ! Empty( cErr ); Msg( "No se pudo quitar: " + cErr, .T. ); RETURN NIL; ENDIF
   nFSel := 1
   SyncGets(); DS_Open( cDir, oM ); nSaved := DS_Count(); nLast := 0; SaveProject()
   SelField( 1, .T. ); oM:Recalc()
   Msg( "Campo " + cN + " quitado", .F. )
RETURN NIL

/* ---- project file --------------------------------------------------------------------------------------- */
STATIC FUNCTION SaveProject()
   LOCAL cOld, cNew
   IF lInvPend; RETURN NIL; ENDIF
   cNew := oM:Serialize(); cOld := iif( File( cProj ), hb_MemoRead( cProj ), "" )
   IF ! Empty( cOld ) .AND. ! ( cOld == cNew )
      AAdd( aUndo, cOld ); IF Len( aUndo ) > 20; ADel( aUndo, 1 ); ASize( aUndo, 20 ); ENDIF
   ENDIF
   hb_MemoWrit( cProj, cNew )
RETURN NIL

STATIC FUNCTION UndoLast()
   LOCAL c, r, aOld := {}, f, k
   IF lInvPend; Msg( "Deshacer no disponible: project.dfp pendiente de confirmar", .T. ); RETURN NIL; ENDIF
   IF ! Empty( aLUndo ) .AND. ATail( aLUndo )[ 2 ] == Len( aUndo )
      aLinks := ATail( aLUndo )[ 1 ]; ASize( aLUndo, Len( aLUndo ) - 1 ); SaveLinks(); RefAll()
      Msg( "Enlace deshecho", .F. ); RETURN NIL
   ENDIF
   IF Empty( aUndo ); Msg( "Nada que deshacer en esta sesión", .F. ); RETURN NIL; ENDIF
   c := ATail( aUndo ); r := DT_Load( c )
   IF r[ 1 ] == NIL; Msg( "No se pudo deshacer: la copia anterior no es válida", .T. ); RETURN NIL; ENDIF
   ASize( aUndo, Len( aUndo ) - 1 )
   OnInput()
   FOR EACH f IN oM:aFields
      IF f[ 3 ] == "in"; AAdd( aOld, { f[ 1 ], oM:hF[ f[ 1 ] ] } ); ENDIF
   NEXT
   oM := r[ 1 ]
   FOR EACH f IN aOld
      k := AScan( oM:aFields, { | x | Upper( x[ 1 ] ) == Upper( f[ 1 ] ) } )
      IF k > 0
         IF oM:aFields[ k ][ 3 ] == "in"; oM:hF[ f[ 1 ] ] := f[ 2 ]; ENDIF
      ENDIF
   NEXT
   hb_MemoWrit( cProj, oM:Serialize() )
   IF lView; lView := .F.; nOth := 0; DS_CloseHist(); ENDIF
   SyncGets(); DS_Open( cDir, oM ); nSaved := DS_Count(); nLast := 0
   nFSel := Min( nFSel, Len( oM:aFields ) ); nSel := 1
   SelField( nFSel, .T. ); oM:Recalc()
   Msg( "Cambio deshecho (quedan " + LTrim( Str( Len( aUndo ) ) ) + " para deshacer)", .F. )
RETURN NIL

STATIC FUNCTION ConfirmOverwrite()
   IF ! lInvPend; RETURN .T.; ENDIF
   IF MsgYesNo( A( "El project.dfp actual no es válido y se sobrescribirá con el proyecto nuevo." + Chr( 13 ) + Chr( 10 ) + ;
      iif( lBackOk, "Hay copia en " + cFileNoPath( cBackup ) + ".", "ATENCIÓN: no existe copia del original." ) + Chr( 13 ) + Chr( 10 ) + "¿Continuar?" ), "FWH Decision Forms" )
      lInvPend := .F.; RETURN .T.
   ENDIF
   Msg( "Cambio cancelado: project.dfp no se ha modificado", .T. )
RETURN .F.

/* "" when ok; else a warning. Missing file = first run: default project (+ import of a v0.9 rules.ini when present). */
STATIC FUNCTION LoadProject()
   LOCAL c, r, n, cB
   IF ! File( cProj )
      oM := DT_OrderModel()
      n := LegacyImport()
      hb_MemoWrit( cProj, oM:Serialize() )
      RETURN iif( n > 0, "Reglas de rules.ini (v0.9) importadas: " + LTrim( Str( n ) ), "Proyecto nuevo: pedido de ejemplo" )
   ENDIF
   c := hb_MemoRead( cProj )
   r := DT_Load( c )
   IF r[ 1 ] != NIL; oM := r[ 1 ]; RETURN ""; ENDIF
   cB := cProj + ".invalid"; n := 1
   DO WHILE File( cB ); n++; cB := cProj + ".invalid" + LTrim( Str( n ) ); ENDDO
   lBackOk := hb_MemoWrit( cB, c ); cBackup := cB
   oM := DT_OrderModel(); lInvPend := .T.
RETURN "project.dfp no es válido (" + r[ 2 ] + "). " + iif( lBackOk, "Copia: " + cFileNoPath( cB ) + ". ", "SIN COPIA. " ) + "Se usa el ejemplo; no se sobrescribe sin confirmar."

STATIC FUNCTION LegacyImport()
   LOCAL c, cL, nEq, n := 0, k, aBr, a, cB, q, aF := {}, cErr, aT, aRaw
   IF ! File( cRules ); RETURN 0; ENDIF
   c := StrTran( hb_MemoRead( cRules ), Chr( 13 ), "" )
   FOR EACH cL IN hb_ATokens( c, Chr( 10 ) )
      cL := AllTrim( cL ); nEq := At( "=", cL )
      IF nEq < 2; LOOP; ENDIF
      IF Lower( Left( cL, 2 ) ) == "f:"
         IF oM:FormIdx( AllTrim( SubStr( cL, 3, nEq - 3 ) ) ) > 0; AAdd( aF, { AllTrim( SubStr( cL, 3, nEq - 3 ) ), SubStr( cL, nEq + 1 ) } ); ENDIF
         LOOP
      ENDIF
      k := oM:RuleIdx( AllTrim( Left( cL, nEq - 1 ) ) )
      IF k == 0; LOOP; ENDIF
      aBr := {}; cB := SubStr( cL, nEq + 1 ); cErr := ""
      DO WHILE ( q := At( ";", cB ) ) > 0 .AND. Empty( cErr )
         a := hb_ATokens( Left( cB, q - 1 ), "|" ); cB := SubStr( cB, q + 1 )
         IF Len( a ) != 3 .OR. ! ( a[ 1 ] $ ">=|>|<=|<|otherwise" ) .OR. Len( aBr ) >= 5; cErr := "x"
         ELSE; AAdd( aBr, { a[ 1 ], iif( a[ 1 ] == "otherwise", NIL, Val( a[ 2 ] ) ), { "const", Val( a[ 3 ] ) } } ); ENDIF
      ENDDO
      IF Empty( cErr ); cErr := DT_ValidateBranches( aBr ); ENDIF
      IF Empty( cErr ); oM:aRules[ k ][ 3 ] := aBr; n++; ENDIF
   NEXT
   IF ! Empty( aF ) .AND. Empty( oM:SetFormulas( aF ) ); n += Len( aF ); ENDIF
   oM:Recalc()
RETURN n

/* ---- orders ------------------------------------------------------------------------------------------------ */
STATIC FUNCTION SaveOrder()
   OnInput()
   nLast := DS_Save( oM )
   IF nLast > 0; nSaved := DS_Count(); Msg( "Pedido #" + LTrim( Str( nLast ) ) + " guardado", .F. ); ENDIF
   RefAll()
RETURN NIL

/* ---- keys and mouse -------------------------------------------------------------------------------------------- */// ===== fwhforms.prg (part 2 of 2, from line 704) =====
STATIC FUNCTION KeyAct( nKey )
   IF lView .AND. nKey >= 114 .AND. nKey <= 120; ToggleView(); ENDIF
   IF lView .AND. nOth == 0 .AND. ( nKey == 37 .OR. nKey == 39 )
      nCol := Max( 0, nCol + iif( nKey == 39, 1, -1 ) ); RefAll(); RETURN NIL
   ENDIF
   IF lView .AND. ( nKey == 33 .OR. nKey == 34 )
      nPage := Max( 0, nPage + iif( nKey == 34, 1, -1 ) ); RefAll(); RETURN NIL
   ENDIF
   DO CASE
   CASE nKey == 113; SaveOrder()                                            // F2
   CASE nKey == 114; AddBranch()                                            // F3

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:06 PM

fwhforms.prg - part 3 of 4
Lines 716-1050 of the supplied source. Concatenate all 4 code blocks for fwhforms.prg in order into one file, with a newline between blocks. Do not add the headings.

   CASE nKey == 115; DelBranch()                                            // F4
   CASE nKey == 116; CycleOp()                                              // F5
   CASE nKey == 117; SelField( iif( nFSel >= Len( oM:aFields ), 1, nFSel + 1 ) )   // F6
   CASE nKey == 118; AddField()                                             // F7
   CASE nKey == 119; RemoveField()                                          // F8
   CASE nKey == 120; ExecButton()                                           // F9
   CASE nKey == 123 .AND. ! lView; UndoLast()                                // F12 (F10 is a Windows system key; Ctrl+Z belongs to the GET)
   CASE nKey == 122; ToggleView()
   CASE nKey == 123 .AND. lView; CycleTable()                                           // F11
   CASE nKey == 33 .AND. IsTree() .AND. nSel > 1; SelBranch( nSel - 1 )
   CASE nKey == 34 .AND. IsTree() .AND. nSel < Len( RB() ); SelBranch( nSel + 1 )
   ENDCASE
RETURN NIL

STATIC FUNCTION BranchY( n, nN )
RETURN 150 + ( n - 1 ) * iif( nN <= 3, 100, 64 )

STATIC FUNCTION ToggleView()
   lView := ! lView; nPage := 0; nOth := 0; nCol := 0; DS_CloseHist()
   IF lView
      aOth := DS_Others( cDir )
      oGExp:Hide(); oGLab:Hide(); oGThr:Hide(); oGRes:Hide(); oSink:SetFocus()
      RefAll()
   ELSE
      SelField( nFSel, .T. )
      RefAll()
   ENDIF
RETURN NIL

STATIC FUNCTION ExportOrders()
   LOCAL c := DS_ExportCsv( cDir, oM ), p
   IF Empty( c ); Msg( "No se pudo escribir el CSV", .T. ); RETURN NIL; ENDIF
   p := RAt( "\", c )
   Msg( "Exportado " + SubStr( c, p + 1 ) + " (" + LTrim( Str( DS_Count() ) ) + " pedidos) en demo_data", .F. )
RETURN NIL

STATIC FUNCTION CycleTable()
   IF Empty( aOth ); Msg( "No hay tablas de estructuras anteriores en disco", .F. ); RETURN NIL; ENDIF
   nOth := iif( nOth >= Len( aOth ), 0, nOth + 1 ); nPage := 0
   IF nOth > 0; nHF := DS_OpenHist( aOth[ nOth ] ); ELSE; DS_CloseHist(); nHF := 0; ENDIF
   RefAll()
RETURN NIL

STATIC FUNCTION PaintHist()
   LOCAL aR, i, j, y, nT := DS_HistCount(), aC := {}, cF := aOth[ nOth ], p, aMt := DS_ReadMeta( cF ), lMt, cH, c
   lMt := ( Len( aMt ) == nHF .AND. nHF > 0 )
   IF lMt
      FOR j := 1 TO nHF
         IF aMt[ j ][ 3 ] == "in" .AND. Len( aC ) < 4; AAdd( aC, j ); ENDIF
      NEXT
      FOR j := nHF TO 1 STEP -1
         IF aMt[ j ][ 3 ] != "btn"
            IF AScan( aC, j ) == 0; AAdd( aC, j ); ENDIF
            EXIT
         ENDIF
      NEXT
   ELSE
      FOR j := 1 TO Min( 4, nHF ); AAdd( aC, j ); NEXT
      IF nHF > 4; AAdd( aC, nHF ); ENDIF
   ENDIF
   p := RAt( "\", cF )
   Card( 388, 72, 868, 650, "Tabla anterior " + LTrim( Str( nOth ) ) + " de " + LTrim( Str( Len( aOth ) ) ), SubStr( cF, p + 1 ) + "  ·  solo lectura  ·  F12 siguiente" )
   DF_Text( "#", 408, 140, 448, 166, CL_MUTE, 1, 0 )
   FOR j := 1 TO Len( aC )
      DF_Text( iif( lMt, aMt[ aC[ j ] ][ 2 ], "col " + LTrim( Str( aC[ j ] ) ) ), 452 + ( j - 1 ) * 80, 140, 528 + ( j - 1 ) * 80, 166, CL_MUTE, 1, 2 )
   NEXT
   DF_Line( 408, 168, 848, 168, CL_EDGE, 1 )
   nPage := Max( 0, Min( nPage, Int( ( Max( nT, 1 ) - 1 ) / 14 ) ) ); aR := DS_LastH( 14, nHF, nPage * 14 )
   IF Empty( aR )
      DF_Text( "Esta tabla anterior no tiene pedidos.", 408, 190, 848, 220, CL_MUTE, 2, 0 )
   ENDIF
   FOR i := 1 TO Len( aR )
      y := 172 + ( i - 1 ) * 26
      IF i % 2 == 0; DF_Box( 404, y, 852, y + 24, CL_PALE, CL_PALE, 4 ); ENDIF
      DF_Text( LTrim( Str( aR[ i ][ 1 ] ) ), 408, y, 448, y + 26, CL_INK, 0, 0 )
      FOR j := 1 TO Len( aC )
         IF lMt .AND. aMt[ aC[ j ] ][ 3 ] != "tree"
            c := LTrim( Str( aR[ i ][ 2 ][ aC[ j ] ], 16, aMt[ aC[ j ] ][ 4 ] ) )
         ELSE
            c := TrimNum( aR[ i ][ 2 ][ aC[ j ] ] )
         ENDIF
         DF_Text( c, 452 + ( j - 1 ) * 80, y, 528 + ( j - 1 ) * 80, y + 26, CL_INK, 0, 2 )
      NEXT
   NEXT
   DF_Text( "Pedidos de una estructura anterior: " + LTrim( Str( nT ) ) + "  ·  página " + LTrim( Str( nPage + 1 ) ) + " de " + LTrim( Str( Max( 1, Int( ( nT + 13 ) / 14 ) ) ) ) + "  ·  AvPág / RePág", 408, 560, 850, 588, CL_INK, 2, 0 )
   IF lMt
      DF_Text( "Etiquetas del .meta guardado al abrir esa tabla vacía; pueden haber cambiado después.", 408, 588, 850, 612, CL_MUTE, 2, 0 )
      DF_Text( "Nada se edita ni se borra.", 408, 612, 850, 636, CL_MUTE, 2, 0 )
   ELSE
      DF_Text( "Sin .meta: las etiquetas de aquellos campos no se guardaron;", 408, 588, 850, 612, CL_MUTE, 2, 0 )
      DF_Text( "se muestran como columnas por orden. Nada se edita ni se borra.", 408, 612, 850, 636, CL_MUTE, 2, 0 )
   ENDIF
RETURN NIL

STATIC FUNCTION PaintOrders()
   LOCAL aR, i, j, a, y, x, aC := {}, f, nT := DS_Count(), r
   LOCAL aAll := {}, nAll
   FOR i := 1 TO Len( oM:aFields )
      IF oM:aFields[ i ][ 3 ] != "btn"; AAdd( aAll, i ); ENDIF
   NEXT
   nAll := Len( aAll ); nCol := Max( 0, Min( nCol, Max( 0, nAll - 5 ) ) )
   FOR i := nCol + 1 TO Min( nAll, nCol + 5 ); AAdd( aC, aAll[ i ] ); NEXT
   Card( 388, 72, 868, 650, "Pedidos guardados", "Solo lectura  ·  más recientes primero  ·  F11 vuelve · F12 anteriores" )
   IF nAll > 5; DF_Text( "Columnas " + LTrim( Str( nCol + 1 ) ) + " a " + LTrim( Str( nCol + 5 ) ) + " de " + LTrim( Str( nAll ) ) + "", 408, 538, 700, 558, CL_MUTE, 2, 0 )
      Pill( 716, 534, 776, 562, "<", nCol > 0 ); Pill( 788, 534, 848, 562, ">", nCol + 5 < nAll )
   ENDIF
   DF_Box( 728, 80, 848, 106, CL_WHITE, CL_ACC, 8 ); DF_Text( "Exportar CSV", 728, 80, 848, 106, CL_ACC, 1, 1 )
   DF_Text( "#", 408, 140, 448, 166, CL_MUTE, 1, 0 )
   FOR j := 1 TO Len( aC )
      DF_Text( oM:aFields[ aC[ j ] ][ 2 ], 460 + ( j - 1 ) * 80, 140, 524 + ( j - 1 ) * 80, 166, CL_MUTE, 1, 2 )
   NEXT
   DF_Line( 408, 168, 848, 168, CL_EDGE, 1 )
   nPage := Max( 0, Min( nPage, Int( ( nT - 1 ) / 14 ) ) ); aR := DS_Last( 14, Len( oM:aFields ), nPage * 14 )
   IF Empty( aR )
      DF_Text( "Todavía no hay pedidos en esta tabla. Pulsa Guardar pedido (F2).", 408, 190, 848, 220, CL_MUTE, 2, 0 )
   ENDIF
   FOR i := 1 TO Len( aR )
      y := 172 + ( i - 1 ) * 26; r := aR[ i ]
      IF i % 2 == 0; DF_Box( 404, y, 852, y + 24, CL_PALE, CL_PALE, 4 ); ENDIF
      DF_Text( LTrim( Str( r[ 1 ] ) ), 408, y, 448, y + 26, CL_INK, 0, 0 )
      FOR j := 1 TO Len( aC )
         f := oM:aFields[ aC[ j ] ]
         DF_Text( iif( f[ 3 ] == "tree", TrimNum( r[ 2 ][ aC[ j ] ] ), LTrim( Str( r[ 2 ][ aC[ j ] ], 16, f[ 4 ] ) ) ), 452 + ( j - 1 ) * 80, y, 528 + ( j - 1 ) * 80, y + 26, CL_INK, iif( aC[ j ] == aAll[ nAll ], 1, 0 ), 2 )
      NEXT
   NEXT
   DF_Text( "Pedidos " + iif( Empty( aR ), "0", LTrim( Str( aR[ Len( aR ) ][ 1 ] ) ) + " a " + LTrim( Str( aR[ 1 ][ 1 ] ) ) ) + " de " + LTrim( Str( nT ) ) + "  ·  página " + LTrim( Str( nPage + 1 ) ) + " de " + LTrim( Str( Max( 1, Int( ( nT + 13 ) / 14 ) ) ) ) + "  ·  AvPág / RePág", 408, 560, 850, 588, CL_INK, 2, 0 )
   DF_Text( "Si cambias los campos se abre otra tabla (F12 las lista):", 408, 588, 850, 612, CL_MUTE, 2, 0 )
   DF_Text( "los anteriores siguen en disco y se ven en solo lectura con F12.", 408, 612, 850, 636, CL_MUTE, 2, 0 )
RETURN NIL

STATIC FUNCTION ClickAt( oCW, nOx, nOy )
   LOCAL n := DF_MousePos( oCW:hWnd ), nX := Int( n / 10000 ) + nOx, nY := n % 10000 + nOy, i, k, nN
   IF nOy == 9999
      IF ! lView; nPre := Max( 1, Min( 4, Int( nX / 142 ) + 1 ) ); AddField(); ENDIF
      RETURN NIL
   ENDIF
   IF nY >= 12 .AND. nY <= 44 .AND. nX >= 330 .AND. nX <= 500
      Arrange()
   ELSEIF nY >= 12 .AND. nY <= 44 .AND. nX >= 580 .AND. nX <= 680
      OpenCopy()
   ELSEIF nY >= 12 .AND. nY <= 44 .AND. nX >= 690 .AND. nX <= 790
      SaveCopy()
   ELSEIF nY >= 12 .AND. nY <= 44 .AND. nX >= 800 .AND. nX <= 960
      IF lView; Msg( "Deshacer solo en el editor: pulsa F11 para volver", .F. ); ELSE; UndoLast(); ENDIF
   ELSEIF nY >= 12 .AND. nY <= 44 .AND. nX >= 980 .AND. nX <= 1160
      SaveOrder()
   ELSEIF lView .AND. nOth == 0 .AND. nX >= 728 .AND. nX <= 848 .AND. nY >= 80 .AND. nY <= 106
      ExportOrders()
   ELSEIF lView .AND. nOth == 0 .AND. nY >= 534 .AND. nY <= 562 .AND. nX >= 716 .AND. nX <= 848
      nCol := Max( 0, nCol + iif( nX >= 788, 1, -1 ) ); RefAll()
   ELSEIF lView .AND. nY >= 650
      ToggleView()
   ELSEIF nX >= 16 .AND. nX <= 342 .AND. nY >= 138 .AND. nY < 138 + 46 * Len( oM:aFields )
      i := Int( ( nY - 138 ) / 46 ) + 1
      IF nY - RowY( i ) <= 38
         nDragF := i; aDragPt := { nX, nY }; DF_Capture( oWF:hWnd, .T. )
      ENDIF
   ELSEIF nY >= 604 .AND. nY <= 636 .AND. nX >= 36 .AND. nX <= 176
      AddField()
   ELSEIF nY >= 604 .AND. nY <= 636 .AND. nX >= 188 .AND. nX <= 342
      RemoveField()
   ELSEIF ! lView .AND. nX >= 904 .AND. nX <= 1144 .AND. nY >= 556 .AND. nY <= 588
      MoveField( iif( nX < 1024, -1, 1 ) )
   ELSEIF ! IsTree() .AND. FK( nFSel ) == "in" .AND. ! lView .AND. nX >= 904 .AND. nX <= 1144 .AND. nY >= 598 .AND. nY <= 630
      DupField()
   ELSEIF ! IsTree() .AND. FK( nFSel ) == "in" .AND. nX >= 904 .AND. nX <= 1140 .AND. nY >= 336 .AND. nY <= 368
      ToggleDec()
   ELSEIF ! lView .AND. FK( nFSel ) == "btn" .AND. LinkOf( FN( nFSel ) ) > 0 .AND. nY >= 532 .AND. nY <= 554 .AND. nX >= 904 .AND. nX <= 1144
      IF nX <= 1020; CycleLink(); ELSEIF nX >= 1032; DelLink(); ENDIF
   ELSEIF IsTree()
      nN := Len( RB() )
      IF nX >= 904 .AND. nX <= 1012 .AND. nY >= 598 .AND. nY <= 630
         AddBranch()
      ELSEIF nX >= 1032 .AND. nX <= 1144 .AND. nY >= 598 .AND. nY <= 630
         DelBranch()
      ELSEIF nX >= 904 .AND. nX <= 1144 .AND. nY >= 476 .AND. nY <= 508
         ExecButton()
      ELSEIF nX >= 1076 .AND. nX <= 1144 .AND. nY >= 246 .AND. nY <= 274
         CycleOp()
      ELSEIF nX >= 600 .AND. nX <= 840
         FOR k := 1 TO nN
            IF nY >= BranchY( k, nN ) .AND. nY <= BranchY( k, nN ) + 44; SelBranch( k ); ENDIF
         NEXT
      ENDIF
   ENDIF
RETURN NIL

/* ---- painting --------------------------------------------------------------------------------------------------- */
STATIC FUNCTION Pill( l, t, r, b, cText, lOn )
   DF_Box( l, t, r, b, iif( lOn, CL_ACC, CL_SOFT ), iif( lOn, CL_ACC, RGB( 203, 213, 225 ) ), 8 )
   DF_Text( cText, l, t, r, b, iif( lOn, CL_WHITE, CL_MUTE ), 2, 1 )
RETURN NIL

STATIC FUNCTION Win( l, t, r, b, cTitle, cSub )
   DF_Box( l, t, r, b, CL_WHITE, CL_WHITE, 0 )
   IF ! Empty( cSub ); DF_Text( cSub, l + 20, t + 34, r - 20, t + 56, CL_MUTE, 2, 0 ); ENDIF
RETURN NIL

STATIC FUNCTION Card( l, t, r, b, cTitle, cSub )
   DF_Box( l, t, r, b, CL_WHITE, CL_EDGE, 14 )
   DF_Text( cTitle, l + 20, t + 14, r - 20, t + 44, CL_INK, 1, 0 )
   IF ! Empty( cSub ); DF_Text( cSub, l + 20, t + 40, r - 20, t + 62, CL_MUTE, 2, 0 ); ENDIF
RETURN NIL

STATIC FUNCTION PaintAll( hDC, oCW, nOx, nOy )
   LOCAL i, f, y, act, cK, nW, k
   DF_Begin( hDC, oCW:hWnd, CL_BG ); DF_Org( -nOx, iif( nOy == 9999, 0, -nOy ) )
   nW := DF_W()
   IF nOy == 9999
      PaintPalette(); DF_End(); RETURN NIL
   ENDIF
   // top bar
   DF_Box( 0, 0, nW, 56, CL_INK, CL_INK, 0 )
   DF_Text( "FWH Decision Forms", 20, 0, 300, 56, CL_WHITE, 3, 0 )
   DF_Box( 330, 12, 500, 44, CL_INK, RGB( 71, 85, 105 ), 10 ); DF_Text( "Ordenar ventanas", 330, 12, 500, 44, RGB( 203, 213, 225 ), 1, 1 )
   DF_Box( 580, 12, 680, 44, CL_INK, RGB( 71, 85, 105 ), 10 ); DF_Text( "Abrir copia", 580, 12, 680, 44, RGB( 203, 213, 225 ), 1, 1 )
   DF_Box( 690, 12, 790, 44, CL_INK, RGB( 71, 85, 105 ), 10 ); DF_Text( "Copia", 690, 12, 790, 44, RGB( 203, 213, 225 ), 1, 1 )
   DF_Box( 800, 12, 960, 44, CL_INK, RGB( 71, 85, 105 ), 10 )
   IF lView
      DF_Text( "Deshacer (editor)", 800, 12, 960, 44, RGB( 100, 116, 139 ), 1, 1 )
   ELSE
      DF_Text( "Deshacer  (F12)", 800, 12, 960, 44, RGB( 203, 213, 225 ), 1, 1 )
   ENDIF
   DF_Box( 980, 12, 1160, 44, CL_ACC, CL_ACC, 10 )
   DF_Text( "Guardar pedido", 980, 12, 1160, 44, CL_WHITE, 1, 1 )

   // form card
   Win( 16, 72, 372, 650, oM:cTitle + "  (editar)", "Campos del formulario  ·  clic para elegir" )
   FOR i := 1 TO Len( oM:aFields )
      f := oM:aFields[ i ]; y := RowY( i ); act := ( i == nFSel ); cK := f[ 3 ]
      IF act; DF_Box( 20, y, 25, y + 38, CL_ACC, CL_ACC, 4 ); ENDIF
      DF_Text( ShortLab( f[ 2 ], iif( act, 15, 17 ) ), 36, y, 182, y + 38, iif( cK == "in", CL_INK, CL_MUTE ), iif( act, 1, 0 ), 0 )
      IF cK == "in"
         DF_Box( 184, y, 342, y + 38, CL_WHITE, iif( act, CL_ACC, RGB( 203, 213, 225 ) ), 8 )
      ELSEIF i == Len( oM:aFields )
         DF_Box( 184, y, 342, y + 38, CL_ACC, iif( act, RGB( 147, 197, 253 ), CL_ACC ), 8 )
         DF_Text( ValStr( i ), 236, y, 334, y + 38, CL_WHITE, 1, 2 )
         DF_Box( 192, y + 9, 232, y + 29, CL_WHITE, CL_WHITE, 8 )
         DF_Text( iif( cK == "fx", "fx", iif( cK == "btn", "botón", "árbol" ) ), 192, y + 9, 232, y + 29, CL_ACC, 2, 1 )
      ELSE
         DF_Box( 184, y, 342, y + 38, iif( act, CL_ACCL, CL_SOFT ), iif( act, CL_ACC, RGB( 226, 232, 240 ) ), 8 )
         DF_Text( ValStr( i ), 236, y, 334, y + 38, RGB( 51, 65, 85 ), 0, 2 )
         DF_Box( 192, y + 9, 232, y + 29, iif( act, CL_ACC, RGB( 226, 232, 240 ) ), iif( act, CL_ACC, RGB( 203, 213, 225 ) ), 8 )
         DF_Text( iif( cK == "fx", "fx", iif( cK == "btn", "botón", "árbol" ) ), 192, y + 9, 232, y + 29, iif( act, CL_WHITE, CL_MUTE ), 2, 1 )
      ENDIF
   NEXT
   FOR i := 1 TO Len( aLinks )
      IF FIdx( aLinks[ i ][ 1 ] ) > 0 .AND. FIdx( aLinks[ i ][ 2 ] ) > 0
         y := RowY( FIdx( aLinks[ i ][ 1 ] ) ) + 19; k := RowY( FIdx( aLinks[ i ][ 2 ] ) ) + 19
         DF_Line( 344, y, 356, y, CL_ACC, 2 ); DF_Line( 356, y, 356, k, CL_ACC, 2 ); DF_Line( 356, k, 346, k, CL_ACC, 2 )
         DF_Line( 346, k, 352, k - 5, CL_ACC, 2 ); DF_Line( 346, k, 352, k + 5, CL_ACC, 2 )
      ENDIF
   NEXT
   DF_Line( 36, 594, 352, 594, CL_EDGE, 1 )
   Pill( 36, 604, 176, 636, "+ Campo  (F7)", .F. )
   Pill( 188, 604, 342, 636, "Quitar campo  (F8)", .F. )

   IF lView .AND. nOth > 0; PaintHist(); ELSEIF lView; PaintOrders(); ELSE; PaintCenter(); ENDIF
   PaintRight()

   // footer
   IF nOy == 652
   DF_Text( cMsg, 20, 652, 1160, 674, iif( lBad, CL_RED, CL_ACC ), 2, 0 )
   DF_Text( "Pedidos: " + LTrim( Str( nSaved ) ) + iif( nLast > 0, "  ·  último #" + LTrim( Str( nLast ) ), "" ) + "  ·  F2 guardar · F11 pedidos", 20, 676, 510, 698, CL_MUTE, 2, 0 )
   ENDIF
   DF_End()
RETURN NIL

STATIC FUNCTION RelXY( hW, nOx, nOy )
   LOCAL a := hb_ATokens( DF_RelPos( hW ), "," )
RETURN { Val( a[ 1 ] ) + nOx, Val( a[ 2 ] ) + nOy }

STATIC FUNCTION OnUp()
   LOCAL i := nDragF, pF, pT, nB, nStep, rcy
   IF i == 0; RETURN NIL; ENDIF
   nDragF := 0; DF_Capture( 0, .F. )
   pF := RelXY( oWF:hWnd, 16, 100 )
   IF Abs( pF[ 1 ] - aDragPt[ 1 ] ) + Abs( pF[ 2 ] - aDragPt[ 2 ] ) < 6
      IF lView; ToggleView(); ENDIF
      SelField( i )
      IF FK( i ) == "in"; aGets[ i ]:SetFocus(); ELSEIF FK( i ) == "fx"; oGExp:SetFocus(); ELSE; oSink:SetFocus(); ENDIF
      RETURN NIL
   ENDIF
   IF lView; Msg( "Arrastrar campos solo en el editor (F11 vuelve)", .F. ); RETURN NIL; ENDIF
   IF pF[ 1 ] >= 16 .AND. pF[ 1 ] <= 362 .AND. pF[ 2 ] >= 138 .AND. pF[ 2 ] < 138 + 46 * Len( oM:aFields )
      DropLink( i, Int( ( pF[ 2 ] - 138 ) / 46 ) + 1 ); RETURN NIL
   ENDIF
   pT := RelXY( oWT:hWnd, 388, 116 )
   IF pT[ 1 ] < 388 .OR. pT[ 1 ] > 868 .OR. pT[ 2 ] < 116 .OR. pT[ 2 ] > 650
      Msg( "Arrastre cancelado: suelta el campo sobre la raíz del árbol", .F. ); RETURN NIL
   ENDIF
   IF ! IsTree()
      Msg( "Elige primero un campo de tipo árbol o botón para recibir el campo", .T. ); RETURN NIL
   ENDIF
   nB := Len( RB() ); nStep := iif( nB <= 3, 100, 64 ); rcy := 150 + ( nB - 1 ) * nStep / 2 + 22
   IF pT[ 1 ] >= 398 .AND. pT[ 1 ] <= 548 .AND. pT[ 2 ] >= rcy - 26 .AND. pT[ 2 ] <= rcy + 26
      DropRoot( i )
   ELSE
      Msg( "Suelta el campo sobre el recuadro oscuro de la raíz del árbol", .T. )
   ENDIF
RETURN NIL

STATIC FUNCTION DropRoot( i )
   LOCAL r := oM:RuleIdx( FN( nFSel ) ), cNew := oM:aFields[ i ][ 1 ], cOld := oM:aRules[ r ][ 2 ], aRes, cT := FN( nFSel )
   IF Upper( cNew ) == Upper( cOld ); Msg( "El árbol ya decide según " + LabelOf( cNew ), .F. ); RETURN NIL; ENDIF
   IF Upper( cNew ) == Upper( cT ); Msg( "Un campo no puede decidir su propio árbol", .T. ); RETURN NIL; ENDIF
   IF ! ConfirmOverwrite(); RETURN NIL; ENDIF
   OnInput()
   AAdd( aUndo, oM:Serialize() ); IF Len( aUndo ) > 20; ADel( aUndo, 1 ); ASize( aUndo, 20 ); ENDIF
   oM:aRules[ r ][ 2 ] := cNew
   aRes := DT_Load( oM:Serialize() )
   IF aRes[ 1 ] == NIL
      oM:aRules[ r ][ 2 ] := cOld; ASize( aUndo, Len( aUndo ) - 1 )
      Msg( "No se puede: " + LabelOf( cNew ) + " depende de este árbol o está después en la lista (usa Subir/Bajar campo)", .T. ); RETURN NIL
   ENDIF
   lInvPend := .F.
   SaveProject(); oM:Recalc(); SelField( nFSel, .T. )
   Msg( cT + " decide ahora según " + LabelOf( cNew ) + " (F12 deshace)", .F. )
RETURN NIL

STATIC FUNCTION Arrange()
   LOCAL i, a := { { 2, 4, 1196, 86 }, { 90, 4, 376, 575 }, { 108, 384, 502, 575 }, { 90, 890, 310, 600 }, { 692, 4, 520, 84 }, { 692, 528, 668, 84 } }
   FOR i := 1 TO 6
      DF_Restore( aWin[ i ][ 1 ]:hWnd )
      aWin[ i ][ 1 ]:Move( a[ i ][ 1 ], a[ i ][ 2 ], a[ i ][ 3 ], a[ i ][ 4 ], .T. )
   NEXT
   aWin[ 2 ][ 1 ]:SetFocus()
   Msg( "Ventanas ordenadas", .F. )
RETURN NIL

STATIC FUNCTION PaintPalette()
   LOCAL i, x, aT := { { "Entrada", "numero que escribes" }, { "Formula", "+ - * / y campos" }, { "Arbol", "ramas Si / otro caso" }, { "Boton", "guardar o limpiar" } }
   FOR i := 1 TO 4
      x := 10 + ( i - 1 ) * 142
      DF_Box( x, 3, x + 134, 44, CL_SOFT, RGB( 203, 213, 225 ), 8 )

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 02:06 PM

fwhforms.prg - part 4 of 4
Lines 1051-1323 of the supplied source. Concatenate all 4 code blocks for fwhforms.prg in order into one file, with a newline between blocks. Do not add the headings.

      DF_Text( aT[ i ][ 1 ], x + 8, 4, x + 130, 24, CL_INK, 1, 0 )
      DF_Text( aT[ i ][ 2 ], x + 8, 23, x + 130, 42, CL_MUTE, 2, 0 )
   NEXT
RETURN NIL

STATIC FUNCTION PaintCenter()
   LOCAL c1, c2, p1, f := oM:aFields[ nFSel ], cK := f[ 3 ], aB, nB, nStep, by, rcy, i, br, lc, aU, cU, x, aA, k, aCh, nTot, lEl, w, cLbl, nCut
   IF cK == "tree" .OR. cK == "btn"
      Win( 388, 88, 868, 650, iif( cK == "btn", "Árbol de acción para  ", "Árbol de decisión para  " ) + f[ 2 ], "Se decide según " + LabelOf( RTest() ) + "  ·  gana la primera rama que se cumple" )
      aB := RB(); nB := Len( aB ); nStep := iif( nB <= 3, 100, 64 ); br := Branch()
      rcy := 150 + ( nB - 1 ) * nStep / 2 + 22
      DF_Box( 411, rcy - 18, 541, rcy + 24, RGB( 190, 197, 209 ), RGB( 190, 197, 209 ), 12 )
      DF_Box( 408, rcy - 21, 538, rcy + 21, RGB( 15, 23, 42 ), RGB( 15, 23, 42 ), 12 )
      DF_Text( LabelOf( RTest() ), 408, rcy - 21, 538, rcy + 21, CL_WHITE, 1, 1 )
      FOR k := 0 TO 1
         FOR i := 1 TO nB
            IF ( k == 1 ) != ( i == br ); LOOP; ENDIF
            by := 150 + ( i - 1 ) * nStep; lc := iif( i == br, CL_ACC, CL_EDGE )
            x := iif( i == br, 3, 1 )
            DF_Line( 538, rcy, 580, rcy, lc, x ); DF_Line( 580, rcy, 580, by + 22, lc, x ); DF_Line( 580, by + 22, 600, by + 22, lc, x ); DF_Line( 720, by + 22, 740, by + 22, lc, x )
            DF_Box( 603, by + 3, 723, by + 47, RGB( 203, 210, 222 ), RGB( 203, 210, 222 ), 10 )
            DF_Box( 600, by, 720, by + 44, iif( i == br, CL_ACCL, CL_PALE ), lc, 10 )
            DF_Text( iif( aB[ i ][ 1 ] == "otherwise", "en otro caso", LTrim( Str( i ) ) + ".  " + Sym( aB[ i ][ 1 ] ) + " " + TrimNum( aB[ i ][ 2 ] ) ), 600, by, 720, by + 44, CL_INK, 0, 1 )
            DF_Box( 740, by, 840, by + 44, iif( i == br, CL_ACC, CL_PALE ), lc, 10 )
            DF_Text( iif( cK == "btn", ActShort( aB[ i ][ 3 ][ 2 ] ), TrimNum( aB[ i ][ 3 ][ 2 ] ) + " " + f[ 5 ] ), 740, by, 840, by + 44, iif( i == br, CL_WHITE, CL_MUTE ), 1, 1 )
         NEXT
      NEXT
      by := 150 + ( nSel - 1 ) * nStep
      DF_DotBox( 596, by - 4, 844, by + 48, CL_INK )
      DF_Text( "Con " + LabelOf( RTest() ) + " " + TrimNum( oM:hF[ RTest() ] ) + " rama " + LTrim( Str( br ) ) + iif( cK == "btn", ": 1º árbol: " + ActShort( Int( oM:hF[ f[ 1 ] ] ) ) + iif( LinkOf( f[ 1 ] ) > 0, " · 2º enlace: " + LabelOf( aLinks[ LinkOf( f[ 1 ] ) ][ 2 ] ) + " " + LinkAct( aLinks[ LinkOf( f[ 1 ] ) ][ 3 ] ), "" ), ": " + f[ 2 ] + " = " + ValStr( nFSel ) ), 408, 468, 860, 492, CL_ACC, 2, 0 )
      DF_Text( "Rama " + LTrim( Str( nSel ) ) + " seleccionada (línea de puntos): edítala en el panel de la derecha.", 408, 494, 860, 518, CL_MUTE, 2, 0 )
   ELSEIF cK == "fx"
      Win( 388, 88, 868, 650, "Fórmula para  " + f[ 2 ], "Campo calculado: se recalcula al cambiar cualquier campo del que depende" )
      DF_Text( "EXPRESIÓN  (Enter aplica y guarda)", 408, 142, 848, 164, CL_MUTE, 2, 0 )
      DF_Box( 408, 168, 848, 206, CL_WHITE, CL_ACC, 8 )
      c1 := "Campos: " + FieldNames(); c2 := ""
      IF Len( c1 ) > 56
         p1 := RAt( ", ", Left( c1, 56 ) ); c2 := SubStr( c1, p1 + 2 ); c1 := Left( c1, p1 )
      ENDIF
      DF_Text( c1, 408, 213, 856, 229, CL_MUTE, 2, 0 )
      IF ! Empty( c2 ); DF_Text( c2, 408, 229, 856, 245, CL_MUTE, 2, 0 ); ENDIF
      DF_Text( "Operadores: + - * / ( )", 408, 245, 856, 263, CL_MUTE, 2, 0 )
      DF_Box( 408, 272, 848, 376, CL_PALE, CL_EDGE, 12 )
      DF_Text( "VALOR ACTUAL", 428, 282, 700, 302, CL_MUTE, 2, 0 )
      DF_Text( ValStr( nFSel ), 428, 306, 828, 362, CL_INK, 4, 0 )
      aU := oM:UsedBy( f[ 1 ] ); cU := ""
      AEval( aU, { | z | cU += iif( Empty( cU ), "", ", " ) + z } )
      DF_Text( "Lo usan: " + iif( Empty( cU ), "(ningún campo)", cU ), 408, 390, 856, 412, CL_MUTE, 2, 0 )
   ELSE
      Win( 388, 88, 868, 650, "Campo de entrada  " + f[ 2 ], "Lo escribe quien rellena el formulario (celda blanca a la izquierda)" )
      DF_Box( 408, 150, 848, 260, CL_PALE, CL_EDGE, 12 )
      DF_Text( "VALOR ACTUAL", 428, 162, 700, 184, CL_MUTE, 2, 0 )
      DF_Text( ValStr( nFSel ), 428, 190, 828, 246, CL_INK, 4, 0 )
      aU := oM:UsedBy( f[ 1 ] ); cU := ""
      AEval( aU, { | z | cU += iif( Empty( cU ), "", ", " ) + z } )
      DF_Text( "Lo usan: " + iif( Empty( cU ), "(ningún campo todavía)", cU ), 408, 280, 856, 304, CL_MUTE, 2, 0 )
      DF_Text( "Crea una fórmula o un árbol de decisión con + Campo para usarlo.", 408, 308, 856, 332, CL_MUTE, 2, 0 )
   ENDIF
   // dependency chain
   DF_Line( 408, 546, 848, 546, CL_EDGE, 1 )
   DF_Text( "DEPENDENCIAS", 408, 554, 700, 574, CL_MUTE, 2, 0 )
   aA := Direct( f[ 1 ] )
   IF Empty( aA )
      DF_Text( "Este campo no depende de otros.", 408, 586, 848, 614, CL_MUTE, 0, 0 )
   ELSE
      DF_Text( "Calculado con:", 408, 586, 520, 618, CL_MUTE, 2, 0 )
      aCh := {}; nCut := 0
      FOR EACH k IN aA
         cLbl := oM:aFields[ k ][ 2 ]; AAdd( aCh, { cLbl, 22 + 7 * Len( cLbl ), "dep" } )
      NEXT
      AAdd( aCh, { f[ 2 ], 22 + 7 * Len( f[ 2 ] ), "sel" } )
      DO WHILE Len( aCh ) > 2
         nTot := 0; AEval( aCh, { | z | nTot += z[ 2 ] + 22 } )
         IF nTot <= 320; EXIT; ENDIF
         ADel( aCh, 1 ); ASize( aCh, Len( aCh ) - 1 ); nCut++
      ENDDO
      x := 528
      IF nCut > 0; DF_Text( "+" + LTrim( Str( nCut ) ) + " más", 408, 620, 520, 640, CL_MUTE, 2, 0 ); ENDIF
      FOR i := 1 TO Len( aCh )
         w := aCh[ i ][ 2 ]
         IF aCh[ i ][ 3 ] == "sel"
            DF_Box( x, 584, x + w, 620, CL_ACC, CL_ACC, 12 ); DF_Text( aCh[ i ][ 1 ], x, 584, x + w, 620, CL_WHITE, 1, 1 )
         ELSE
            DF_Box( x, 584, x + w, 620, CL_SOFT, RGB( 203, 213, 225 ), 12 ); DF_Text( aCh[ i ][ 1 ], x, 584, x + w, 620, CL_INK, 0, 1 )
         ENDIF
         IF i < Len( aCh )
            IF i == Len( aCh ) - 1
               DF_Line( x + w + 3, 602, x + w + 18, 602, CL_MUTE, 2 ); DF_Line( x + w + 13, 597, x + w + 18, 602, CL_MUTE, 2 ); DF_Line( x + w + 13, 607, x + w + 18, 602, CL_MUTE, 2 )
            ELSE
               DF_Text( "", x + w, 584, x + w + 22, 620, CL_MUTE, 1, 1 )
            ENDIF
         ENDIF
         x += w + 22
      NEXT
   ENDIF
RETURN NIL

STATIC FUNCTION Direct( cName )
   LOCAL k := oM:FormIdx( cName ), r := oM:RuleIdx( cName ), a := {}, x, j, aO := {}
   IF k > 0; a := DT_Names( oM:aForms[ k ][ 2 ] ); ELSEIF r > 0; a := { oM:aRules[ r ][ 2 ] }; ENDIF
   FOR EACH x IN a
      j := oM:FieldIdx( x )
      IF j > 0 .AND. AScan( aO, j ) == 0; AAdd( aO, j ); ENDIF
   NEXT
   ASort( aO )
RETURN aO

STATIC FUNCTION FieldNames()
   LOCAL c := "", f, n := 0
   FOR EACH f IN oM:aFields
      IF f[ 1 ] != oM:aFields[ nFSel ][ 1 ]; c += iif( Empty( c ), "", ", " ) + f[ 1 ]; ENDIF
   NEXT
RETURN c

STATIC FUNCTION PaintRight()
   LOCAL f := oM:aFields[ nFSel ], aB, cK := f[ 3 ], cU, aU
   Card( 884, 72, 1164, 650, "Propiedades", "" )
   IF ! lView
      Pill( 904, 556, 1020, 588, "Subir campo", nFSel > 1 ); Pill( 1028, 556, 1144, 588, "Bajar campo", nFSel < Len( oM:aFields ) )
   ENDIF
   IF lView
      DF_Text( "Las propiedades del campo se editan en el editor.", 904, 124, 1140, 180, CL_MUTE, 2, 8 )
      DF_Text( "Pulsa F11 o haz clic en un campo de la lista para volver.", 904, 190, 1140, 250, CL_MUTE, 2, 8 )
      RETURN NIL
   ENDIF
   DF_Text( "NOMBRE", 904, 124, 1140, 142, CL_MUTE, 2, 0 )
   DF_Text( f[ 1 ], 904, 142, 1140, 164, CL_INK, 0, 0 )
   DF_Text( "TIPO", 904, 172, 1140, 190, CL_MUTE, 2, 0 )
   DF_Text( iif( cK == "in", "Entrada", iif( cK == "fx", "Fórmula", iif( cK == "btn", "Botón (árbol de acciones)", "Árbol de decisión" ) ) ), 904, 190, 1140, 212, CL_INK, 0, 0 )
   DF_Line( 904, 226, 1144, 226, CL_EDGE, 1 )
   IF cK == "tree" .OR. cK == "btn"
      aB := RB()
      DF_Text( "RAMA " + LTrim( Str( nSel ) ) + " DE " + LTrim( Str( Len( aB ) ) ), 904, 226, 1060, 246, CL_MUTE, 2, 0 )
      DF_Text( "Si " + LabelOf( RTest() ), 904, 250, 1070, 274, CL_INK, 0, 0 )
      IF aB[ nSel ][ 1 ] == "otherwise"
         Pill( 1076, 246, 1144, 274, "otro caso", .F. )
      ELSE
         Pill( 1076, 246, 1144, 274, Sym( aB[ nSel ][ 1 ] ), .T. )
      ENDIF
      DF_Text( "Umbral", 904, 284, 1140, 304, CL_MUTE, 2, 0 )
      DF_Box( 904, 310, 1140, 342, CL_PALE, RGB( 203, 213, 225 ), 8 )
      DF_Text( iif( cK == "btn", "Acción  (0 nada · 1 guardar · 2 limpiar)", "Resultado" + iif( Empty( f[ 5 ] ), "", " (" + f[ 5 ] + ")" ) ), 904, 364, 1140, 384, CL_MUTE, 2, 0 )
      DF_Box( 904, 390, 1140, 422, CL_PALE, RGB( 203, 213, 225 ), 8 )
      DF_Text( iif( cK == "btn", "Acciones: 0 no hace nada, 1 guarda el pedido, 2 pone las entradas a cero.", iif( f[ 5 ] == "%", "Admite 0 a 100.", "Admite cualquier número." ) + "  Umbrales: cualquier número, en orden." ), 904, 432, 1144, 470, CL_MUTE, 2, 8 )
      IF cK == "btn"; Pill( 904, 476, 1144, 508, "Pulsar botón  (F9)", .T. ); ENDIF
      IF cK == "btn" .AND. ! lView
         IF LinkOf( f[ 1 ] ) > 0
            DF_Text( "Al pulsar -> " + LabelOf( aLinks[ LinkOf( f[ 1 ] ) ][ 2 ] ), 904, 510, 1144, 530, CL_INK, 1, 0 )
            Pill( 904, 532, 1020, 554, ShortLab( LinkAct( aLinks[ LinkOf( f[ 1 ] ) ][ 3 ] ), 14 ), .T. )
            Pill( 1032, 532, 1144, 554, "Quitar enlace", .F. )
         ELSE
            DF_Text( "Enlace: arrastra este botón sobre un campo de Entrada", 904, 512, 1144, 552, CL_MUTE, 2, 8 )
         ENDIF
      ENDIF
      Pill( 904, 598, 1012, 630, "+ Rama  (F3)", .F. )
      Pill( 1032, 598, 1144, 630, "Quitar  (F4)", .F. )
   ELSE
      DF_Text( "ETIQUETA", 904, 226, 1140, 244, CL_MUTE, 2, 0 )
      IF ( cK == "in" .OR. cK == "fx" ) .AND. ! lView
         DF_Box( 904, 246, 1140, 280, CL_PALE, RGB( 203, 213, 225 ), 8 )
         DF_Text( "Enter o salir del cuadro: guarda", 904, 282, 1140, 300, CL_MUTE, 2, 0 )
      ENDIF
      IF cK == "in" .AND. ! lView
         Pill( 904, 598, 1144, 630, "Duplicar campo", .F. )
      ENDIF
      IF cK == "in"
         DF_Text( "DECIMALES  (clic para cambiar 0 / 2)", 904, 312, 1140, 332, CL_MUTE, 2, 0 )
         DF_Box( 904, 336, 1140, 368, CL_PALE, RGB( 203, 213, 225 ), 8 )
         DF_Text( LTrim( Str( f[ 4 ] ) ), 916, 336, 1130, 368, CL_INK, 0, 0 )
      ELSE
         DF_Text( "DEPENDE DE", 904, 312, 1140, 330, CL_MUTE, 2, 0 )
         aU := Direct( f[ 1 ] ); cU := ""
         AEval( aU, { | z | cU += iif( Empty( cU ), "", ", " ) + oM:aFields[ z ][ 1 ] } )
         DF_Text( cU, 904, 334, 1144, 394, CL_INK, 2, 8 )
      ENDIF
   ENDIF
RETURN NIL

#pragma BEGINDUMP
#include <windows.h>
#include "hbapi.h"
#include <stdio.h>

static HDC g_dc, g_dc0; static HBITMAP g_bmp; static HGDIOBJ g_obm, g_of; static HFONT g_f[ 5 ]; static int g_W, g_H;

HB_FUNC( DF_MOUSEPOS ){ POINT p; GetCursorPos( &p ); ScreenToClient( ( HWND ) ( ULONG_PTR ) hb_parnint( 1 ), &p ); hb_retnl( p.x * 10000L + p.y ); }

HB_FUNC( DF_BEGIN )
{
   HWND hw = ( HWND ) ( UINT_PTR ) hb_parnint( 2 ); RECT cr, r;
   HBRUSH hb;
   g_dc0 = ( HDC ) ( UINT_PTR ) hb_parnint( 1 );
   GetClientRect( hw, &cr ); g_W = cr.right; g_H = cr.bottom;
   g_dc = CreateCompatibleDC( g_dc0 ); g_bmp = CreateCompatibleBitmap( g_dc0, g_W, g_H ); g_obm = SelectObject( g_dc, g_bmp );
   g_f[ 0 ] = CreateFontW( -16, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET, 0, 0, CLEARTYPE_QUALITY, 0, L"Segoe UI" );
   g_f[ 1 ] = CreateFontW( -16, 0, 0, 0, FW_BOLD,   0, 0, 0, DEFAULT_CHARSET, 0, 0, CLEARTYPE_QUALITY, 0, L"Segoe UI" );
   g_f[ 2 ] = CreateFontW( -13, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET, 0, 0, CLEARTYPE_QUALITY, 0, L"Segoe UI" );
   g_f[ 3 ] = CreateFontW( -22, 0, 0, 0, FW_BOLD,   0, 0, 0, DEFAULT_CHARSET, 0, 0, CLEARTYPE_QUALITY, 0, L"Segoe UI" );
   g_f[ 4 ] = CreateFontW( -34, 0, 0, 0, FW_BOLD,   0, 0, 0, DEFAULT_CHARSET, 0, 0, CLEARTYPE_QUALITY, 0, L"Segoe UI" );
   g_of = SelectObject( g_dc, g_f[ 0 ] );
   r.left = 0; r.top = 0; r.right = g_W; r.bottom = g_H; hb = CreateSolidBrush( ( COLORREF ) hb_parnl( 3 ) ); FillRect( g_dc, &r, hb ); DeleteObject( hb );
   SetBkMode( g_dc, TRANSPARENT );
}
HB_FUNC( DF_W ){ hb_retni( g_W ); }
HB_FUNC( DF_END )
{
   int i;
   SetViewportOrgEx( g_dc, 0, 0, NULL ); BitBlt( g_dc0, 0, 0, g_W, g_H, g_dc, 0, 0, SRCCOPY );
   SelectObject( g_dc, g_of ); for( i = 0; i < 5; i++ ) DeleteObject( g_f[ i ] );
   SelectObject( g_dc, g_obm ); DeleteObject( g_bmp ); DeleteDC( g_dc );
}
HB_FUNC( DF_CHILDRECT )
{
   HWND h = ( HWND ) ( UINT_PTR ) hb_parnint( 1 ); RECT r; POINT p; char b[ 64 ];
   if( ! h || ! IsWindow( h ) ) { hb_retc( "" ); return; }
   GetWindowRect( h, &r ); p.x = r.left; p.y = r.top; ScreenToClient( GetParent( h ), &p );
   sprintf( b, "%ld,%ld,%ld,%ld", ( long ) p.x, ( long ) p.y, ( long ) ( r.right - r.left ), ( long ) ( r.bottom - r.top ) ); hb_retc( b );
}
HB_FUNC( DF_RELPOS )
{
   POINT p; char b[ 32 ]; GetCursorPos( &p ); ScreenToClient( ( HWND ) ( UINT_PTR ) hb_parnint( 1 ), &p );
   sprintf( b, "%ld,%ld", ( long ) p.x, ( long ) p.y ); hb_retc( b );
}
HB_FUNC( DF_CAPTURE ){ if( hb_parl( 2 ) ) SetCapture( ( HWND ) ( UINT_PTR ) hb_parnint( 1 ) ); else ReleaseCapture(); }
HB_FUNC( DF_RESTORE ){ HWND h = ( HWND ) ( UINT_PTR ) hb_parnint( 1 ); if( IsIconic( h ) || IsZoomed( h ) ) ShowWindow( h, SW_RESTORE ); }
HB_FUNC( DF_ORG ){ SetViewportOrgEx( g_dc, hb_parni( 1 ), hb_parni( 2 ), NULL ); }
/* DF_BOX( l, t, r, b, fill, edge, radius ) */
HB_FUNC( DF_BOX )
{
   HBRUSH hb = CreateSolidBrush( ( COLORREF ) hb_parnl( 5 ) ); HPEN hp = CreatePen( PS_SOLID, 1, ( COLORREF ) hb_parnl( 6 ) );
   HGDIOBJ ob = SelectObject( g_dc, hb ), op = SelectObject( g_dc, hp );
   if( hb_parni( 7 ) > 0 ) RoundRect( g_dc, hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ), hb_parni( 7 ), hb_parni( 7 ) );
   else Rectangle( g_dc, hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ) );
   SelectObject( g_dc, ob ); SelectObject( g_dc, op ); DeleteObject( hb ); DeleteObject( hp );
}
HB_FUNC( DF_DOTBOX )
{
   HGDIOBJ nb = GetStockObject( NULL_BRUSH ); HPEN hp = CreatePen( PS_DOT, 1, ( COLORREF ) hb_parnl( 5 ) );
   HGDIOBJ ob = SelectObject( g_dc, nb ), op = SelectObject( g_dc, hp );
   RoundRect( g_dc, hb_parni( 1 ), hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ), 12, 12 );
   SelectObject( g_dc, ob ); SelectObject( g_dc, op ); DeleteObject( hp );
}
HB_FUNC( DF_LINE )
{
   HPEN hp = CreatePen( PS_SOLID, hb_parni( 6 ), ( COLORREF ) hb_parnl( 5 ) ); HGDIOBJ op = SelectObject( g_dc, hp );
   MoveToEx( g_dc, hb_parni( 1 ), hb_parni( 2 ), NULL ); LineTo( g_dc, hb_parni( 3 ), hb_parni( 4 ) ); SelectObject( g_dc, op ); DeleteObject( hp );
}
/* DF_TEXT( cUtf8, l, t, r, b, color, font 0-4, align 0 left 1 center 2 right + 8 wordbreak ) */
HB_FUNC( DF_TEXT )
{
   WCHAR w[ 400 ]; RECT rc; int al = hb_parni( 8 ); UINT fl = DT_NOPREFIX | DT_END_ELLIPSIS;
   const char * s = hb_parc( 1 );
   if( ! s ) return;
   rc.left = hb_parni( 2 ); rc.top = hb_parni( 3 ); rc.right = hb_parni( 4 ); rc.bottom = hb_parni( 5 );
   MultiByteToWideChar( CP_UTF8, 0, s, -1, w, 400 );
   SelectObject( g_dc, g_f[ hb_parni( 7 ) ] ); SetTextColor( g_dc, ( COLORREF ) hb_parnl( 6 ) );
   fl |= ( ( al & 3 ) == 1 ) ? DT_CENTER : ( ( al & 3 ) == 2 ) ? DT_RIGHT : DT_LEFT;
   if( al & 8 ) { fl &= ~DT_END_ELLIPSIS; fl |= DT_WORDBREAK; } else fl |= DT_SINGLELINE | DT_VCENTER;
   DrawTextW( g_dc, w, -1, &rc, fl );
}
HB_FUNC( DF_U8ANSI )
{
   WCHAR w[ 600 ]; char b[ 600 ]; const char * s = hb_parc( 1 );
   if( ! s ) { hb_retc( "" ); return; }
   MultiByteToWideChar( CP_UTF8, 0, s, -1, w, 600 ); WideCharToMultiByte( CP_ACP, 0, w, -1, b, 600, NULL, NULL ); hb_retc( b );
}
HB_FUNC( DF_ANSI2U8 )
{
   WCHAR w[ 600 ]; char b[ 1200 ]; const char * s = hb_parc( 1 );
   if( ! s ) { hb_retc( "" ); return; }
   MultiByteToWideChar( CP_ACP, 0, s, -1, w, 600 ); WideCharToMultiByte( CP_UTF8, 0, w, -1, b, 1200, NULL, NULL ); hb_retc( b );
}
#pragma ENDDUMP

FiveTech AI

Posts: 269
Joined: Fri Sep 25, 2026 01:40 AM

Re: ObjectVision using FWH

Posted: Thu Oct 29, 2026 03:13 PM

The prototype now has an interactive field map: grey lines show dependencies, and blue arrows show event links. Clicking a node selects its field and opens the corresponding tree and properties.

Real screenshot under Wine 11.19, not tested on real Windows or with xHarbour. Work in progress.

📎 objectvision_field_map_wine.png

FiveTech AI

Continue the discussion