PC Toledo

Apenas teste simples
SEM ALTERAR fontes originais da HMG Extended
E com recursos limitados

#include <hmg.ch>
#include "hbclass.ch"

STATIC pClockThread, pProgThread // hold pointers of threads
STATIC nObject := 0

PROCEDURE Main

   LOCAL oMain, oFrame1, oLabel1, oProgbar1, oButton1, oButton2, oButton3
   LOCAL oButton31, oButton4, oButton5, oFrame2, oFrame3

   WITH OBJECT oMain := WindowClass():New( .T. )
      :nCol := 197
      :nRow := 437
      :nWidth := 550
      :nHEIGHT := 350
      :cCaption := "Multi threads Sample"
      :Create( .T. )
   ENDWITH

   WITH OBJECT oFrame1 := FrameClass():New()
      :nROW    := 10
      :nCOL    := 200
      :nWIDTH  := 315
      :nHEIGHT := 278
      :cCAPTION := "Threads"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oLabel1 := LabelClass():New()
      :nROW    := 60
      :nCOL    := 290
      :nWIDTH  := 120
      :nHEIGHT := 24
      :cCaption := "Clock Here!"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oProgbar1 := ProgbarClass():New()
      :nROW    := 150
      :nCOL    := 290
      :nWIDTH  := 150
      :nHEIGHT := 30
      :nRANGEMIN := 1
      :nRANGEMAX := 10
      :Create( oMain )
   ENDWITH

   WITH OBJECT oButton1 := ButtonClass():New()
      :nROW    := 10
      :nCOL    := 10
      :nWIDTH  := 160
      :nHEIGHT := 28
      :bACTION := { || main_button_1_action( @pClockThread ) }
      :cCAPTION := "Start Clock Thread"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oButton2 := ButtonClass():New()
      :nROW    := 50
      :nCOL    := 10
      :nWIDTH  := 160
      :nHEIGHT := 28
      :bACTION := { || main_button_2_action( @pProgThread ) }
      :cCAPTION := "Start ProgressBar Thread"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oButton3 := ButtonClass():New()
      :nROW    := 90
      :nCOL    := 10
      :nWIDTH  := 160
      :nHEIGHT := 28
      :bACTION := { || main_button_3_action( @pClockThread, @pProgThread ) }
      :cCAPTION := "Stop All Threads"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oButton31 := ButtonClass():New()
      :nROW    := 130
      :nCOL    := 10
      :nWIDTH  := 160
      :nHEIGHT := 28
      :bACTION := { || main_button_31_action( @pClockThread, @pProgThread ) }
      :cCAPTION := "Start All Threads"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oButton4 := ButtonClass():New()
      :nROW    := 220
      :nCOL    := 220
      :nWIDTH  := 260
      :nHEIGHT := 28
      :bACTION := { || main_button_4_action( pClockThread, pProgThread ) }
      :cCAPTION := "Main Thread Button"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oButton5 := ButtonClass():New()
      :nROW    := 250
      :nCOL    := 10
      :nWIDTH  := 160
      :nHEIGHT := 28
      :bACTION := {|| hb_threadTerminateAll(), DoMethod( "MainWin", "Release") }
      :cCAPTION := "Exit (closing all threads)"
      :Create( oMain )
   ENDWITH

   WITH OBJECT oFrame2 := FrameClass():New()
      :nROW    := 30
      :nCOL    := 220
      :nWIDTH  := 272
      :nHEIGHT := 75
      :cFONTNAME := 'Arial'
      :nFONTSIZE := 10
      :lFONTBOLD := .T.
      :cCAPTION := "Clock Thread - ID:"
      :lOPAQUE := .T.
      :Create( oMain )
   ENDWITH

   WITH OBJECT oFrame3 := FrameClass():New()
      :nROW    := 120
      :nCOL    := 220
      :nWIDTH  := 272
      :nHEIGHT := 75
      :cFONTNAME := 'Arial'
      :nFONTSIZE := 10
      :lFONTBOLD := .T.
      :cCAPTION := "Progressbar Thread - ID:"
      :lOPAQUE :=.T.
      :Create( oMain )
   ENDWITH

   END WINDOW

   oButton1:Cargo := .F.
   oButton2:Cargo := .F.

   // ShowThreadsIDs()

   oMain:Center()
   oMain:Activate()

   (oFrame1)
   (oLabel1)
   (oProgbar1)
   (oButton3)
   (oButton31)
   (oButton4)
   (oButton5)
   (oFrame2)
   (oFrame3)

   RETURN

FUNCTION Show_Time( oLabel1 )

   // please note that this function will NEVER return the control!
   // but do not 'locks' the user interface since it is running in a separate thread

   DO WHILE .T.
      oLabel1:cCaption := Time()
      hb_idleSleep( 0.1 )
   ENDDO

   RETURN NIL

FUNCTION Show_Progress( oProgbar1)

   LOCAL nValue

   DO WHILE .T.
      nValue := Val(oProgbar1:Caption)
      nValue ++
      if nValue > 10
         nValue := 1
      endif
      oProgbar1:cCaption := Ltrim(Str(nValue))
      hb_idleSleep( 0.2 )
   ENDDO

   RETURN NIL

PROCEDURE ShowThreadsIDs( oFrame2, oFrame3 )

   oFrame2:cCaption := "Clock (Thread pointer: " + hb_ntos( win_P2N( pClockThread ) ) +")"
   oFrame3:cCaption := "Progressbar (Thread pointer: " + hb_ntos( win_P2N( pProgThread ) ) +")"

   RETURN

jeito gambiarra, mas pra teste serve.

Controles, sem muitos detalhes, só variável a mais e o Create() usando a sintaxe original.

progressbar

Código: Selecionar todos

CREATE CLASS ProgbarClass INHERIT WindowClass

   VAR nRangeMin INIT 0
   VAR nRangeMax INIT 0
   METHOD Create( oMain )

   ENDCLASS

METHOD Create( oMain ) CLASS ProgbarClass

   ::oParent := oMain

   DEFINE PROGRESSBAR &(::cName)
      ROW      ::nRow
      COL      ::nCol
      WIDTH    ::nWidth
      HEIGHT   ::nHeight
      RANGEMIN ::nRangeMin
      RANGEMAX ::nRangeMax
   END PROGRESSBAR

   RETURN Nil

label

Código: Selecionar todos

CREATE CLASS LABELClass INHERIT WINDOWClass

   METHOD Create( oMain )

   ENDCLASS

METHOD Create( oMain ) CLASS LabelClass

   ::oParent := oMain

   DEFINE LABEL &(::cName)
      ROW    ::nRow
      COL    ::nCol
      WIDTH  ::nWidth
      HEIGHT ::nHeight
      VALUE  ::cCaption
   END LABEL

   RETURN Nil

button

Código: Selecionar todos

CREATE CLASS BUTTONClass INHERIT WINDOWClass

   METHOD Create( oMain )

   ENDCLASS

METHOD Create( oMain ) CLASS ButtonClass

   ::oParent := oMain

   DEFINE BUTTON &(::cName)
      ROW     ::nRow
      COL     ::nCol
      WIDTH   ::nWidth
      HEIGHT  ::nHeight
      ACTION  ::bAction
      CAPTION ::cCaption
   END BUTTON

   RETURN Nil

frame

Código: Selecionar todos

CREATE CLASS FRAMEClass INHERIT WINDOWClass

   VAR lOpaque INIT .F.
   METHOD Create( oMain )

   ENDCLASS

METHOD Create( oMain ) CLASS FrameClass

   ::oParent := oMain

   DEFINE FRAME &(::cName)
      ROW      ::nRow
      COL      ::nCol
      WIDTH    ::nWidth
      HEIGHT   ::nHeight
      CAPTION  ::cCaption
      FONTNAME ::cFontName
      FONTSIZE ::nFontSize
      FONTBOLD ::lFontBold
      CAPTION  ::cCaption
      OPAQUE   ::lOpaque
   END FRAME

   RETURN Nil

Todos recebem window por herança.

Como não funcionou por CLASSVAR, e não estou a fim de pesquisar, variável estática que vai fornecer os nomes

Código: Selecionar todos

STATIC nObject := 0

E uma classe só pra atender a tela de teste.

Código: Selecionar todos

CREATE CLASS WINDOWClass

   VAR oParent      INIT Nil
   VAR cName        INIT "X"
   VAR xCargo
   VAR nRow         INIT 0
   VAR nCol         INIT 0
   VAR nWidth       INIT 0
   VAR nHeight      INIT 0
   VAR cCaption     INIT ""
   VAR cFontName    INIT "Arial"
   VAR nFontSize    INIT 10
   VAR lFontBold    INIT .F.
   VAR bAction      INIT { || Nil }
   VAR aControlList INIT {}
   METHOD New()     INLINE nObject += 1, ::cName := "CTL" + StrZero( nObject, 6 ), Self
   METHOD Cargo( xValue )   SETGET
   METHOD Create( oMain )
   METHOD Center()   INLINE DoMethod( ::cName, "center" )
   METHOD Activate() INLINE DoMethod( ::cName, "activate" )

   ENDCLASS

METHOD Create( oMain ) CLASS WINDOWClass

   hb_Default( @oMain, .F. )
   IF oMain
      DEFINE WINDOW &(::cName) AT ::nCol, ::nRow WIDTH ::nWidth HEIGHT ::nHeight TITLE ::cCaption MAIN
   ENDIF

   RETURN Nil

METHOD Cargo( xValue ) CLASS WINDOWClass

   IF xValue != Nil
      ::xCargo := xValue
   ENDIF

   RETURN ::xCargo

os nomes são fornecidos aqui:

Código: Selecionar todos

   METHOD New()     INLINE nObject += 1, ::cName := "CTL" + StrZero( nObject, 6 ), Self

Como dá pra ver no teste, fod.a-se esse nome, é só pra atender minigui.
Só precisa ser nome exclusivo, porque a minigui cria variável pública com esses nomes.
Com número de 6 dígitos, vai limitar a 1 milhão de controles.

Mas o que tem de diferente ?
Acesso direto a tudo.
Não importa o nome, importa o nome da variável.

Como eu disse, limitado, só pra esse fonte.
É so ir expandindo.

o segundo fonte vai complicar um pouco, e vai precisar alterações no primeiro.

Código: Selecionar todos

#include "hmg.ch"

#define HB_THREAD_INHERIT_PUBLIC 1

DECLARE WINDOW MainWin


FUNCTION main_button_1_action( /*@*/ pClockThread )

   IF MainWin.Button_1.Cargo
   
      IF ! hb_threadQuitRequest( pClockThread )
         msgExclamation( "Can't stop thread!" )
      ELSE
         MainWin.Button_1.Cargo := .F.
         MainWin.label_1.FontBold := .F.
         MainWin.label_1.FontSize := 10
         MainWin.label_1.Value := "00:00:00"
         MainWin.button_1.Caption := "Start Clock Thread"
         pClockThread := NIL
      ENDIF

      ShowThreadsIDs()
      RETURN NIL

   ENDIF

   IF ! hb_mtvm()

      msgStop( "There is no support for multi-threading, clock will not be seen." )

   ELSE
      
      MainWin.label_1.FontBold := .T.
      MainWin.label_1.FontSize := 12
      MainWin.button_1.Caption := "Click to Stop Clock"

      pClockThread := hb_threadStart( HB_THREAD_INHERIT_PUBLIC, @Show_Time() )
      MainWin.Button_1.Cargo := .T.

   ENDIF
   
   ShowThreadsIDs()
   
   RETURN NIL


FUNCTION main_button_2_action( /*@*/ pProgThread )
   
   IF MainWin.Button_2.Cargo
   
      IF ! hb_threadQuitRequest( pProgThread )
         msgExclamation( "Can't stop thread!")
      ELSE
         MainWin.Button_2.Cargo := .F.
         MainWin.progressBar_1.value := 0
         MainWin.button_2.Caption := "Start ProgressBar Thread"
         pProgThread := NIL
      ENDIF

      ShowThreadsIDs()
      RETURN NIL

   ENDIF
   
   IF ! hb_mtvm()

      msgStop("There is no support for multi-threading, ProgressBar will not be seen.")

   ELSE

      MainWin.button_2.Caption := "Click to Stop progress"

      pProgThread := hb_threadStart( HB_THREAD_INHERIT_PUBLIC , @Show_Progress() )
      MainWin.Button_2.Cargo := .T.

   ENDIF

   ShowThreadsIDs()
   
   RETURN NIL


FUNCTION main_button_3_action( pClockThread, pProgThread )
   
   MainWin.Button_31.Enabled := .T.
   
   IF HB_ISPOINTER( pClockThread )
      main_button_1_action( @pClockThread )
   ENDIF
   IF HB_ISPOINTER( pProgThread )
      main_button_2_action( @pProgThread )
   ENDIF
   
   ShowThreadsIDs()
   
   RETURN hb_threadTerminateAll()


FUNCTION main_button_31_action( /*@*/ pClockThread, /*@*/ pProgThread )

   main_button_1_action( @pClockThread )
   main_button_2_action( @pProgThread )
   MainWin.Button_31.Enabled := !( MainWin.Button_1.Cargo .OR. MainWin.Button_2.Cargo )

   ShowThreadsIDs()
   
   RETURN NIL
   
   
FUNCTION main_button_4_action( pClockThread, pProgThread )

   LOCAL nClockID := Iif( HB_ISPOINTER( pClockThread ), hb_threadId( pClockThread ), 0 )
   LOCAL nProgID := Iif( HB_ISPOINTER( pProgThread ), hb_threadId( pProgThread ), 0 )
   LOCAL cClock := "", cProg := ""   

   IF ! Empty( pClockThread )
      cClock := "Clock"
   ENDIF
      
   IF ! Empty( pProgThread )
      cProg := "Progressbar"
   ENDIF
   
   msgInfo( hb_StrFormat( "Currently running threads: %s (ID: %d), %s (ID: %d)", ;
                          cClock, nClockID , cProg, nProgID ) ) 

   RETURN NIL

É.... porque não se trata apenas de atribuir valores às variáveis das classes, mas de repassar pra minigui.
Com certeza, alterar aquelas pra SETGET, e vai precisar de um teste se o controle já foi criado na minigui ou não.
Na criação apenas atribui, mas no uso tem que pegar/repassar pra minigui.
Sem problemas, cNAME tem o nome usado pela minigui, e oParent tem o nome do pai, é tudo que a classe e a minigui precisam saber.
Vai dar trabalho colocar tudo ? sim, do mesmo jeito que deve ter dado trabalho criar as gambiarras da HMGE.
Mas com uma grande diferença: OOP REAL, e não falsa como implementaram.
Vai funcionar em run-time, e não apenas no pré-processador.

SEM ALTERAR OS FONTES ORIGINAIS DA HMG EXTENDED.
SEM ALTERAR O FUNCIONAMENTO ATUAL.
É só ir recheando as classes, e se tiver versão nova da HMGE não precisa mexer em nada,a não ser que tenham criado recurso novo, método novo, variável nova, o que não costuma acontecer muito.

Para a questão anterior, talvez VAR lCreate := .F., e no método Create() ::lCreate := .T., assim dá pra saber se repassa pra HMGE ou não, bastando checar se foi criado.

Código: Selecionar todos

   METHOD Center()   INLINE DoMethod( ::cName, "center" )
   METHOD Activate() INLINE DoMethod( ::cName, "activate" )

Acima por exemplo, inserir um DoMethod() da clase intermediário a esse.
É... porque na minigui pode ser DoMethod( a,b,c,d,"nome" )

Uia, aceitou isto:

Código: Selecionar todos

METHOD DoMethod( cName ) CLASS WINDOWClass

   LOCAL aList
   
   aList := { ::cName }
   
   oThis := Self
   DO WHILE ( oThis := oThis:oParent ) != Nil
      AIns( aList, 1 )
      aList[ 1 ] := oThis:oParent:cName
   ENDDO
   DoMethod( hb_ArrayToParams( aList ), cName )
   
   RETURN Nil

Pra usar tipo: DoMethod( "form1", "tab1", "edit1", "setfocus" )
Deu pra mixar hb_ArrayToParams com outro, apesar que.... era só acrescentar cName ao array.

Com essa mudança, isto:

Código: Selecionar todos

   METHOD Center()   INLINE DoMethod( ::cName, "center" )
   METHOD Activate() INLINE DoMethod( ::cName, "activate" )
   METHOD DoMethod( cName )

virou isto

Código: Selecionar todos

   METHOD Center()   INLINE ::DoMethod( "center" )
   METHOD Activate() INLINE ::DoMethod( "activate" )
   METHOD DoMethod( cName )

Com a diferença de que não importa o nível.

Não entenderam?

Código: Selecionar todos

oButton2:DoMethod( "setfocus" )

a rotina vai traduzir isso pra

Código: Selecionar todos

DoMethod( "ctl000001", "ctl000005", "setfocus" )

Como eu disse, classe trabalha com variáveis e minigui com os nomes públicos ctlnnnnnn.
A classe traduziu pro equivalente minigui !!!

Código: Selecionar todos

METHOD DoMethod( cName ) CLASS WINDOWClass

   LOCAL aList, oThis

   aList := { ::cName }

   oThis := Self
   DO WHILE ( oThis := oThis:oParent ) != Nil
      AIns( aList, 1 )
      aList[ 1 ] := oThis:cName
   ENDDO
   DoMethod( hb_ArrayToParams( aList ), cName )

   RETURN Nil

METHOD GetProperty( cName ) CLASS WINDOWClass

   LOCAL aList, oThis

   aList := { ::cName }

   oThis := Self
   DO WHILE ( oThis := oThis:oParent ) != Nil
      AIns( aList, 1 )
      aList[ 1 ] := oThis:cName
   ENDDO
   GetProperty( hb_ArrayToParams( aList ), cName )

   RETURN Nil

METHOD SetProperty( cName, xValue ) CLASS WINDOWClass

   LOCAL aList, oThis

   aList := { ::cName }

   oThis := Self
   DO WHILE ( oThis := oThis:oParent ) != Nil
      AIns( aList, 1 )
      aList[ 1 ] := oThis:cName
   ENDDO
   SetProperty( hb_ArrayToParams( aList ), cName, xValue )

   RETURN Nil

Só preparando praquele segundo fonte, que faz parte do mesmo exemplo.

Ola Quintas

Se me permite uma opinião;

Tenho algo que funciona muito bem, não posso postá-lo por conta de ser dependente de outras coisas e estar num estado frankstain, mas consiste na seguinte ideia;

Basicamente o código do formulário (Visão) é gerado por um IDE, não faz muito sentido querer fazer isso na mão, no entanto, isso não me impede de usar classe na lógica;

Assim como em hwgui, na minigui você também consegue trabalhar usando a boa prática de programação, ou seja, não misturar visão com lógica;(embora nos viciamos em fazer um pacotão só);

Clássico código minigui:

Código: Selecionar todos

Function CadCliente
Load form frmcadcli as CadCliente
//X
Activate CadCliente
Return .t.

Você concorda que em //x; você já tem acesso às propriedades da janela e objetos; então o que você precisa fazer é simplesmente criar um objeto principal que abrigue a janela e suas propriedades e a partir dai abrigue todos os objetos filhos; exemplo:

Código: Selecionar todos

Function CadCliente
    local w
    Load form frmcadcli as CadCliente
        w:=twindow()new("cadcliente")
        w:oinit := {||OnInit(w)} 
    Activate CadCliente ou w:activate
    Return .t.
*********************************************
    Declare window &(::Name)

CREATE CLASS TWindow

    DATA Name                    INIT _HMG_ActiveFormName
    DATA Id                      INIT 0
    Data Controls                //Controles do formulario
    
    Method Activate
    ACCESS Type                  INLINE GetWIndowType   (::Name)
    ACCESS Index                 INLINE  &(::Name).Index
    ACCESS Active                INLINE _IsWIndowActive (::Name)
    ACCESS ClientHeight          INLINE &(::name).ClientHeight
    ACCESS ClientWidth           INLINE &(::Name).ClientWidth
...
   END CLASS

use _GetArrayOfAllControlsForForm(::Name) para obter os objetos filhos e criar a referência a eles também;

Para não haver choque de propriedades de window com os objetos filhos, crie uma subclasse contêiner: ex: propriedade cargo x objeto cargo
w:cargo := hb_hash()
w:controls:cargo:cargo:=hb_hash()

ou seja, todos os objetos filhos ficam em w:controls

Partindo deste principio, você consegue generalizar tudo, deixando o código enxuto.

Por enquanto erro, mas acho que já sei o que é.

Aquele teste de lCreated precisa ser revisto, ou essa chamada de função.
Na classe ele existe, mas se a janela não está ativa, ele ainda não está na tela e não existe pra mexer.

Pensando bem..... considerar erro no fonte original.
Acabou de criar o frame, nem mostrou na tela, e já está alterando o caption?
Porque não criou com o caption que deveria ser ?
Ao mesmo tempo.... não dava erro antes... sei lá... apenas bloquear o uso ali.

O que significa {} no #command ?
Vai ser codeblock ? obriga codeblock ? vai ser array ?

Ok, significa considerar codeblock, e impede muita coisa de ser feita.

Parece piada, mas apanhando com coisa básica.

Aquele AIns()..... não deu certo.

AIns() insere, mas ele não altera o tamanho do array, então o array ficava sempre só com um elemento.

ivanil escreveu:use _GetArrayOfAllControlsForForm(::Name) para obter os objetos filhos e criar a referência a eles também;
Para não haver choque de propriedades de window com os objetos filhos, crie uma subclasse contêiner: ex: propriedade cargo x objeto cargo
w:cargo := hb_hash()
w:controls:cargo:cargo:=hb_hash()
ou seja, todos os objetos filhos ficam em w:controls
Partindo deste principio, você consegue generalizar tudo, deixando o código enxuto.

Deixei passar a sua mensagem.
É uma coisa demorada, a idéia é não depender de fontes da HMG, pra não perder tudo em atualização.

Inclusive, repensar e refazer, porque tem que funcionar o jeito velho e o jeito novo ao mesmo tempo.
Do jeito que fiz é pra funcionar só o novo.
Aliás... por enquanto é saber se funciona, antes de qualquer coisa a mais.

Olá Quintas;

Use hb_AIns( <aArray>, [<nPos>], [<xValue>], [<lAutoSize>] ) → aArray

Quanto ao assunto não depender do fonte HMG; é justamente o oposto do que penso, pois posso usar o designer para posicionar os objetos rapidamente sem interferir em absolutamente nada e quanto a mudanças no núcleo da minigui não faz muito sentido, qualquer coisa que venha a ser implementado seria uma propriedade, mas isso seria transparente... eu uso desta forma ha muitos anos e funciona bem.

De qualquer forma esse é seu projeto, foi só uma ideia;;

grande abraço.

PC Toledo

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop

hmg extend com oop