DLGAUTO Dialogs automáticas (não geração de fontes)

[JoséQuintas]

Achei um exemplo com GRID, e troquei de browse pra grid.
Falta o ENTER.

Situação atual:
- hwgui
- hmg extended
- oohg
- gtwvg
- hmg 3

5 LIBs, nem todas totalmente funcionais, mas... rodando.
O barato é doido.

[JoséQuintas]

Pra quem quiser acrescentar mais LIBs....
O que precisei pra acrescentar HMG 3

em frm_class.ch os includes.

Código: Selecionar todos

#ifdef HBMK_HAS_HMG3
   #include "hmg.ch"
   #include "i_altsyntax.ch"
   MEMVAR _HMG_SYSDATA
#endif

Em lib.prg o include

Código: Selecionar todos

#ifdef HBMK_HAS_HMG3
   #include "lib_hmg3.prg"
#endif

E lib_hmg3.prg, com a criação de um controle de cada, pegando lib_hmge.prg de referência pra ponto de partida.

Código: Selecionar todos

/*
lib_hmg3 - HMG 3 source selected by lib.prg
*/

#include "frm_class.ch"

FUNCTION gui_ButtonCreate( xDlg, xControl, nRow, nCol, nWidth, nHeight, cCaption, cResName, bAction )

   IF Empty( xControl )
      xControl := gui_newctlname( "BUTTON" )
   ENDIF

   DEFINE BUTTON ( xControl )
      PARENT ( xDlg )
      ROW         nRow
      COL         nCol
      WIDTH       nWidth
      HEIGHT      nHeight
      //ICON        cResName
      CAPTION     cCaption
      ACTION      Eval( bAction )
      //IMAGEWIDTH  nWidth - 20
      //IMAGEHEIGHT nHeight - 20
      //FONTNAME    DEFAULT_FONTNAME
      //FONTSIZE    9
      //FONTBOLD    .T.
      //FONTCOLOR   COLOR_BLACK
      //VERTICAL   .T.
      //BACKCOLOR  COLOR_WHITE
      //FLAT       .T.
      //NOXPSTYLE  .T.
   END BUTTON

   (xDlg);(xControl);(nRow);(nCol);(nWidth);(nHeight);(cCaption);(cResName);(bAction)

   RETURN Nil

FUNCTION gui_ButtonEnable( xDlg, xControl, lEnable )

   SetProperty( xDlg, xControl, "ENABLED", lEnable )

   RETURN Nil

FUNCTION gui_Browse( xDlg, xControl, nRow, nCol, nWidth, nHeight, oTbrowse, cField, xValue, workarea )

   LOCAL aHeaderList := {}, aWidthList := {}, aFieldList := {}, aItem

   IF Empty( xControl )
      xControl := gui_newctlname( "BROW" )
   ENDIF
   FOR EACH aItem IN oTbrowse
      AAdd( aHeaderList, aItem[1] )
      AAdd( aFieldList, aItem[3] )
      AAdd( aWidthList, Len( Transform(FieldGet(FieldNum(aItem[3])),"")) * 10 )
   NEXT
   @ nRow, nCol GRID ( xControl ) ;
      OF ( xDlg ) ;
      WIDTH nWidth ;
      HEIGHT nHeight ;
      HEADERS aHeaderList ;
      WIDTHS aWidthList ;
      ROWSOURCE ( workarea ) ;
      COLUMNFIELDS aFieldList

   (xDlg);(cField);(xValue);(workarea)

   RETURN Nil

FUNCTION gui_DialogActivate( xDlg, bCode )

   IF ! Empty( bCode )
      Eval( bCode )
   ENDIF
   DoMethod( xDlg, "CENTER" )
   ACTIVATE WINDOW ( xDlg )

   RETURN Nil

FUNCTION gui_DialogClose( xDlg )

   DoMethod( xDlg, "RELEASE" )

   RETURN Nil

FUNCTION gui_DialogCreate( xDlg, nRow, nCol, nWidth, nHeight, cTitle, bInit )

   IF Empty( xDlg )
      xDlg := gui_newctlname( "DIALOG" )
   ENDIF

   IF Empty( bInit )
      bInit := { || Nil }
   ENDIF
   DEFINE WINDOW ( xDlg ) ;
      AT nCol, nRow ;
      WIDTH nWidth ;
      HEIGHT nHeight ;
      TITLE cTitle ;
      MODAL ;
      ON INIT Eval( bInit )
   END WINDOW

   RETURN Nil

FUNCTION gui_IsCurrentFocus( xDlg, xControl )

      RETURN _GetFocusedControl( xDlg ) == xControl

FUNCTION gui_LabelCreate( xDlg, xControl, nRow, nCol, nWidth, nHeight, xValue, lBorder )

   IF Empty( xControl )
      xControl := gui_newctlname( "LABEL" )
   ENDIF
   // não mostra borda
   //DEFINE LABEL ( xControl )
   //   PARENT ( xDlg )
   //   COL nCol
   //   ROW nRow
   //   WIDTH nWidth
   //   HEIGHT nHeight
   //   VALUE xValue
   //   BORDER lBorder
   //END LABEL

   IF lBorder
      @ nRow, nCol LABEL ( xControl ) PARENT ( xDlg ) ;
         VALUE xValue WIDTH nWidth HEIGHT nHeight BORDER
   ELSE
      @ nRow, nCol LABEL ( xControl ) PARENT ( xDlg ) ;
         VALUE xValue WIDTH nWidth HEIGHT nHeight
   ENDIF
   (xDlg)

   RETURN Nil

FUNCTION gui_LabelSetValue( xDlg, xControl, xValue )

   SetProperty( xDlg, xControl, "VALUE", xValue )

   RETURN Nil

FUNCTION gui_MLTextCreate( xDlg, xControl, nRow, nCol, nWidth, nHeight, xValue )

   IF Empty( xControl )
      xControl := gui_newctlname( "MLTEXT" )
   ENDIF
   DEFINE EDITBOX ( xControl )
      PARENT ( xDlg )
      COL nCol
      ROW nRow
      WIDTH nWidth
      HEIGHT nHeight
      VALUE xValue
      TOOLTIP 'EditBox'
      NOHSCROLLBAR .T.
   END EDITBOX
   (xDlg)

   RETURN Nil

FUNCTION gui_MsgGeneric( cText )

   RETURN Msgbox( cText )

FUNCTION gui_PanelCreate( xDlg, xControl, nRow, nCol, nWidth, nHeight )

   IF Empty( xControl )
      xControl := gui_newctlname( "PANEL" )
   ENDIF
   (xDlg); (xControl); (nRow); (nCol); (nWidth); (nHeight)

   RETURN Nil

FUNCTION gui_SetFocus( xDlg, xControl )

   DoMethod( xDlg, xControl, "SETFOCUS" )

   RETURN Nil

FUNCTION gui_TabCreate( xDlg, xControl, nRow, nCol, nWidth, nHeight )

   IF Empty( xControl )
      xControl := gui_newctlname( "TAB" )
   ENDIF
   DEFINE TAB ( xControl ) ;
      PARENT ( xDlg ) ;
      AT nRow, nCol;
      WIDTH nWidth ;
      HEIGHT nHeight
   (xDlg)

   RETURN Nil

FUNCTION gui_TabEnd()

   END TAB

   RETURN Nil

FUNCTION gui_TabNavigate( xDlg, oTab, aList )

   (xDlg);(oTab);(aList)

   RETURN Nil

FUNCTION gui_TabPageBegin( xDlg, xControl, cText )

   PAGE ( cText )
   (xDlg); (xControl); (cText)

   RETURN Nil

FUNCTION gui_TabPageEnd( xDlg, xControl )

   END PAGE
   (xDlg); (xControl)

   RETURN Nil

FUNCTION gui_TextCreate( xDlg, xControl, nRow, nCol, nWidth, nHeight, ;
            xValue, cPicture, nMaxLength, bValid )

   IF Empty( xControl )
      xControl := gui_newctlname( "TEXT" )
   ENDIF
   DEFINE TEXTBOX ( xControl )
      PARENT ( xDlg )
      ROW nRow
      COL nCol
      HEIGHT    nHeight
      WIDTH     nWidth
      FONTNAME DEFAULT_FONTNAME
      IF ValType( xValue ) == "N"
         NUMERIC .T.
         INPUTMASK cPicture
      ELSEIF ValType( xValue ) == "D"
         DATE .T.
      ELSE
         MAXLENGTH nMaxLength
      ENDIF
      VALUE     xValue
      ON LOSTFOCUS Eval( bValid )
   END TEXTBOX
   (bValid);(xDlg)

   RETURN Nil

FUNCTION gui_TextEnable( xDlg, xControl, lEnable )

   SetProperty( xDlg, xControl, "ENABLED", lEnable )

   RETURN Nil

FUNCTION gui_TextGetValue( xDlg, xControl )

   (xDlg)

   RETURN GetProperty( xDlg, xControl, "VALUE" )

FUNCTION gui_TextSetValue( xDlg, xControl, xValue )

   // NOTE: string value, except if declared different on textbox creation
   SetProperty( xDlg, xControl, "VALUE", iif( ValType( xValue ) == "D", hb_Dtoc( xValue ), xValue ) )

   RETURN Nil

STATIC FUNCTION gui_newctlname( cPrefix )

   STATIC nCount := 0

   nCount += 1
   hb_Default( @cPrefix, "ANY" )

   RETURN cPrefix + StrZero( nCount, 10 )

E tá rodando compilando com HMG3.
Criação de telas pra todos os DBFs da pasta, edição, validação, browse.

O que eu duvido é que alguém faça isso funcionar com HMG 3 original.

[JoséQuintas]

Na HMG Extended, tem lá o super.
Fiz um teste aplicando a técnica do simulador em mais de um fonte.
Já é o resultado.

No form:

Código: Selecionar todos

   oFrm := frmClass():New()
   oFrm:Dlg := "form_produtos"
   oFrm:acButtons := { ;
      { "Incluir", "F5 Incluir", { || Dados(1) } }, ;
      { "Alterar", "F6 Alterar", { || Dados(2) } }, ;
      { "Excluir", "F7 Excluir", { || Excluir() } }, ;
      { "Imprimir", "F8 Imprimir", { || Relacao() } }, ;
      { "Atualizar", "Atualizar", { || Atualizar() } }, ;
      { "Fornecedores", "Fornecedores", { || Fornecedores_produto() } }, ;
      { "Compor", "Compor Produto", { || Compor_Produto() } }, ;
      { "Sair", "ESC Voltar", { || gui_DialogClose( oFrm:Dlg ) } } }
...
      oFrm:CreateButtons()

A classe de tela é relativamente simples, porque só tem os buttons

Código: Selecionar todos

CREATE CLASS frmClass
   VAR Dlg
   VAR acButtons INIT {}
   METHOD CreateButtons()
   ENDCLASS

METHOD CreateButtons()

   LOCAL aButton, nCol := 5

   FOR EACH aButton IN ::acButtons
      DO CASE
      CASE aButton[1] == "Incluir"; cPicture := path_imagens + "incluir.bmp"
      CASE aButton[1] == "Alterar"; cPicture := Path_Imagens + "alterar.bmp"
      CASE aButton[1] == "Exclir"; Picture := Path_Imagens + "excluir.bmp"
      CASE aButton[1] == "Imprimir"; cPicture := Path_Imagens + "imprimir.bmp"
      CASE aButton[1] == "Atualizar"; cPicture := Path_Imagens + "atualizar.bmp"
      CASE aButton[1] == "Fornecedores"; cPicture := Path_Imagens + "fornecedores.bmp"
      CASE aButton[1] == "Compor Prod."; cPisture := Path_Imagens + "compor.bhp"
      CASE aButton[1] == "Sair"; cPicture := Path_Imagens + "sair.bmp"
      ENDCASE
      gui_ButtonCreate( ::Dlg, aButton[1], 2, nCol, 100, 100, aButton[2], cPicture, aButton[3] )
      nCol += 102
   NEXT

   RETURN Nil

e a criação de button default do simulador atendeu, afinal, a imagem cobre o button e tem o texto, não há o que mexer em layout.

Apenas foi interessante poder aproveitar o fonte do simulador num aplicativo normal.

Isso mostra apenas que o simulador atende a finalidade: simular parte comum de um aplicativo, funcionou no simulador, funciona no aplicativo.

Nota: foi curiosidade, pra ver se funcionava e se mudava alguma coisa no tamanho de EXE, mas é pouca mudança pra isso.

[JoséQuintas]

Resolvido multilinhas na OOHG.

Não percebi, mas coloquei errado

BEGIN EDITBOX..... END TEXTBOX

Não há mensagem de erro pra isso.
Isso é atendido no i_AltSyntax.ch, e END EDITBOX e END TEXTBOX não fazem a mesma coisa.

Pelo menos usando as rotinas do simulador isso não vai ser problema, porque já fica fixo na gui_MLTextbox(), não tem mais como errar.

[JoséQuintas]

Voltando às mudanças no SUPER da HMG Extended:

O EXE ficou maior, coisa de 2KB, achei estranho.

O que notei é que a compilação com HMG Extended é demorada demais.
O processamento de arquivos CH pra simular OOP é pesado.
Acho que é isso que acaba forçando o Borland C.
Para o simulador sem problemas, só tem um fonte HMG pra compilar.

[JoséQuintas]

Lembram ? Tem configuração sobre pesquisar código em tabelas:

Código: Selecionar todos

   aSeekList := { ;
      { "DBCLIENT",  "CLSELLER",  "DBSELLER",  "IDSELLER",  "SENAME" }, ;
      { "DBCLIENT",  "CLBANK",    "DBBANK",    "IDBANK",    "BANAME" }, ;
      { "DBCLIENT",  "CLSTATE",   "DBSTATE",   "IDSTATE",   "STNAME" }, ;
      { "DBPRODUCT", "IEUNIT",    "DBUNIT",    "IDUNIT",    "UNNAME" }, ;
      { "DBSTOCK",   "STCLIENT",  "DBCLIENT",  "IDCLIENT",  "CLNAME" }, ;
      { "DBSTOCK",   "STPRODUCT", "DBPRODUCT", "IDPRODUCT", "PRNAME" }, ;
      { "DBSTOCK",   "STGROUP",   "DBGROUP",   "IDGROUP",   "GRNAME" }, ;
      { "DBFINANC",  "FICLIENT",  "DBCLIENT",  "IDCLIENT",  "CLNAME" }, ;
      { "DBFINANC",  "FIBANK",    "DBBANK",    "IDBANK",    "BANAME" } }

Com base nisso eu abria os DBFs pra validar códigos

Código: Selecionar todos

   // dbfs for code validation
   FOR EACH aItem IN ::aEditList
      IF ! Empty( aItem[ CFG_VTABLE ] ) .AND. Select( aItem[ CFG_VTABLE ] ) == 0
         SELECT 0
         USE ( aItem[ CFG_VTABLE ] )
         SET INDEX TO ( aItem[ CFG_VTABLE ] )
         SET ORDER TO 1
      ENDIF
   NEXT

com base nisso, agora eu faço também o contrário, abro dbfs que utilizam o atual pra validar

Código: Selecionar todos

   // dbfs for code in use validation
   FOR EACH aFile IN ::aAllSetup
      FOR EACH aItem IN aFile[ 2 ]
         IF aItem[ CFG_VTABLE ] == ::cFileDBF .AND. Select( aFile[ 1 ] ) == 0
            SELECT 0
            USE ( aFile[ 1 ] )
            SET INDEX TO ( aFile[ 1 ] )
            SET ORDER TO 1
         ENDIF
      NEXT
   NEXT

No primeiro caso, era pra validar o código digitado

Código: Selecionar todos

   // if setup to find on another dbf
   IF ! Empty( aItem[ CFG_VTABLE ] )
      nSelect := Select()
      SELECT ( Select( aItem[ CFG_VTABLE ] ) )
      SEEK xValue
      lFound := ! Eof()
      xValue := FieldGet( FieldNum( aItem[ CFG_VSHOW ] ) )
      SELECT ( nSelect )
      IF ! lFound
         frm_Browse( Self, ::oDlg, @aItem[ CFG_FCONTROL ], aItem[ CFG_VTABLE ] )
         gui_SetFocus( ::oDlg, aItem[ CFG_FCONTROL ] ) // minigui need this
      ENDIF
      gui_LabelSetValue( ::oDlg, aItem[ CFG_VCONTROL ], xValue )
   ENDIF

No segundo caso, é pra ver se o código está em uso antes de permitir excluir

Código: Selecionar todos

METHOD Delete() CLASS frm_Class

   LOCAL aFile, aItem, cSearch, nSelect

   // check if code is in use, from validate setup
   FOR EACH aFile IN ::aAllSetup
      FOR EACH aItem IN aFile[ 2 ]
         IF aItem[ CFG_VTABLE ] == ::cFileDBF
            nSelect := Select()
            SELECT Select( aFile[ 1 ] )
            cSearch := aItem[ CFG_FNAME ] + [=("] + aItem[ CFG_VTABLE ] + [")->] + aItem[ CFG_VFIELD ]
            LOCATE FOR &cSearch
            IF ! Eof()
               gui_MsgBox( "Code in use on " + aFile[ 1 ] )
               SELECT ( nSelect )
               RETURN Nil
            ENDIF
            SELECT ( nSelect )
            EXIT
         ENDIF
      NEXT
   NEXT

   IF gui_MsgYesNo( "Delete" )
      IF rLock()
         DELETE
         SKIP 0
         UNLOCK
      ENDIF
   ENDIF

   RETURN Nil

Agora o simulador ficou bem completo, com tudo que se usa num cadastro.
Dá até pra pensar em usar direto no aplicativo, substituindo parte do que existe.

Então....

A gente não fica copiando o fonte de um cadastro pra fazer outro?
É o que o simulador faz, tá imitando a gente, mas com a classe frm_class.
E a classe tá preparada pra ter opções além das pré-definidas desde o começo.

Usando o que está "na moda", é como se fosse uma Inteligência Artificial criando os fontes pra gente.

[JoséQuintas]

E dá pra alterar pra SQL também.
Só usar os comandos equivalentes.

[paiva]

rs
uso a wvw com Hwgui
teria como fazer um teste com um dbf ?

cpaivasistemas@gmail.com

como tenho MUITA dificuldade em Fuçar, se tivesse um exe que selecionasse o dbf e geraria o prg ficaria BEM + facil testar

Paiva

[JoséQuintas]

rs
uso a wvw com Hwgui
teria como fazer um teste com um dbf ?
cpaivasistemas@gmail.com
como tenho MUITA dificuldade em Fuçar, se tivesse um exe que selecionasse o dbf e geraria o prg ficaria BEM + facil testar
Paiva

Testar com um DBF ?
Se a pasta tiver milhares de DBFs, vai rodar pra milhares de DBFs.
Também cria uns adicionais, com configuração adicional.

dlgauto.zip

(3.59 MiB) Baixado 743 vezes

Pode rodar test_hwgui.exe, test_hmge.exe, test_hmg3.exe, test_oohg.exe
é cada um compilado com a lib indicada.
Vai poder ver tudo funcionando.

Rode primeiro com os DBFs que já existem, porque tem configuração pronta pra fazer algo mais.
Depois pode copiar mais DBFs pra pasta e rodar, pra esses outros vai ser mais limitado, porque não tem indicação de campo chave ou validação.
Não se esqueça que se for DBF com campo memo, precisa o DBT ou FPT também pra não dar erro.

Vai ter tudo funcionando, não precisa compilar

Mas depois, se tiver as LIBs instaladas e quiser compilar:

hbmk2 test hwgui.hbc
hbmk2 test hmge.hbc
hbmk2 test hmg3.hbc
hbmk2 test oohg.hbc

Se não me engano, hwgui e oohg já tem hbc pronto, nas outras será criar um hbc fake e seguir a compilação normal da lib.

[JoséQuintas]

tem esses DBFs que ele cria
E cria configuração especial

A execução é pra todos os DBFs da pasta

Sejam os originais

Sejam infinitos DBFs desconhecidos na pasta

[JoséQuintas]

Importante:

Dúvida sobre DLGAUTO é comigo.

Dúvida sobre as LIBs... aí é com quem usa LIB
Meu conhecimento em LIB gráfica é só isso que usei no dlgauto.
Meus testes estão todos aí.
Só tenho a mais um browse ADO HWGUI que não está no dlgauto.
Não me aprofundei mais que isso.

Conhecido em HMG Extended: é recomendado outro "GET", com mais opções de PICTURE/MASK.
O problema é que o outro get só funciona se for o harbour da minigui, não serve o oficial.
Trocar de harbour só por conta disso não dá.

[ivanil]

Olá Quintas;

Talvez não tenha entendido bem e outros podem não entender também esta frase:

O problema é que o outro get só funciona se for o harbour da minigui, não serve o oficial.
Trocar de harbour só por conta disso não dá.

A minigui extend possui recursos extras que a Minigui oficial não tem; no entanto, não tem nada a ver com harbour; eu por exemplo uso o harbour do Git;

[JoséQuintas]

A minigui extend possui recursos extras que a Minigui oficial não tem; no entanto, não tem nada a ver com harbour; eu por exemplo uso o harbour do Git;

Compile este exemplo, e veja se funciona: \samples\basic\consoletogui\demo2.prg.
Segundo o Grigory, precisa de uma GETSYS diferente da original do Harbour.
Não vejo outra explicação a não ser harbour diferente.
Esse erro acontece com qualquer fonte que use GETBOX.

Se souber outra solução, sem ser trocar de harbour, avise.

Nota: o Grigory se limitou a responder sobre a GETSYS diferente, sem detalhes.

[ivanil]

Código: Selecionar todos

/*
  MINIGUI - Harbour Win32 GUI library Demo/Sample
*/

ANNOUNCE RDDSYS

#include "minigui.ch"

STATIC cName, cStreet1, cStreet2, cCity, cState, cZipcode, lOk := .F.

/****************************************************************************/
FUNCTION Main()
   LOCAL nWidth := 58, nHeight := 22, n := 2, ;
      nCol := ColCharToPix( 1 ) + GetBorderWidth() / 2, ;
      nCtrlW := ColCharToPix( 40.5 ), nCtrlH := RowCharToPix( 1.4 )

   cName := Padr(hb_compiler(),40)
   cStreet1 := Padr(version(),40)
   cStreet2 := Miniguiversion()
   
   cCity := Space( 40 )
   cState := Space( 2 )
   cZipcode := Space( 5 )

   SET Font TO "Courier", 10

Compilo normalmente; usando o git do harbour compilado com mingw;
Talvez algum conflito de include em sua rota de compilação;


at.
Ivanil

[JoséQuintas]

Valeu Ivanil, sua indicação de funcionar ajudou a resolver.

Saí procurando alguma coisa que tem na GETSYS e cheguei a fontes, na pasta SOURCE\TGET
Depois procurei o uso de " TGET" pra confirmar.

Solução relativamente simples:
Acrescentar os fontes que minigui deixou de fora
No HBP DE GERAÇÃO DA HMG EXTENDED acrescentar:
tget/tget.prg
tget/tgetint.prg

Explicação:
Ao compilar GETBOX.PRG sem -m, GETBOX.OBJ vai conter GETBOX + TGET + TGETINT
Ao compilar com -m, GETBOX.OBJ só contém GETBOX.PRG
Não dá erro de falta de função, porque o harbour tem essas funções dentro dele, só que não servem pra HMG Extended.

A próxima dúvida é:
resolve minigui e estraga o resto ? ou não ?


Antes que digam que o certo é usar os arquivos de geração da LIB......
O certo é indicar TODOS os fontes que entram na LIB, sem deixar nenhum de fora.

Agora estudar o DLGAUTO pra usar GETBOX ao invés do atual.