Fixed and enhanced SAMPLES

HMG Samples and Enhancements

Moderator: Rathinagiri

User avatar
serge_girard
Posts: 3162
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Contact:

Re: Fixed and enhanced SAMPLES

Post by serge_girard »

Thanks Pablo!

Serge
There's nothing you can do that can't be done...
User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil

Fixed and enhanced SAMPLES

Post by Pablo César »

Clip2Mania wrote:Suggestion: The HMG_CallDLL() function is not yet included in the forum documentation hmgdoc/data/index.htm. the old CallDLL32 is still there.
Hi Erik,

You are right ! Our hmgdoc at hosted is not updated, Mr. Rathinagiri is being advised to provide for us.

Because ou lasted HMG version is already updated which one you can access by our IDE at:
Screen1.png
Screen1.png (18.1 KiB) Viewed 6670 times
This will access in your HMG installed pack.

Thank you Erik for advising us. :)
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
luisvasquezcl
Posts: 1258
Joined: Thu Jul 31, 2008 3:23 am
Location: Chile
Contact:

Re: Fixed and enhanced SAMPLES

Post by luisvasquezcl »

Estimado,
Te comento que el ejemplo NETIO_02 no funciona. (hmgnetioserver).
versión hmg3.4.1 windows 7 64 bits.
Saludos cordiales,
Dear,
I commented that the example does not work NETIO_02. (hmgnetioserver).
hmg3.4.1 version windows 7 64 bits.
Best regards,
User avatar
luisvasquezcl
Posts: 1258
Joined: Thu Jul 31, 2008 3:23 am
Location: Chile
Contact:

Re: Fixed and enhanced SAMPLES

Post by luisvasquezcl »

Error NETIO_02
Date:07/21/15 Time: 15:51:18
Error BASE/1132 Bound error: array access
Called from EVENTPROCESSHMGWINDOWSMESSAGE(240)
Called from INIT(834)
Called from ERRORSYS(59)
Called from __HBVMINIT(0)
User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil

Fixed and enhanced SAMPLES

Post by Pablo César »

Hi Rathinagiri,

In C:\hmg.3.4.3\SAMPLES\Applications\AGENDA the source code sample was changed event in GRID to work more eficiently. Please note following code for your evaluation of replacement to next version:

Added later in red:
<Source code has removed because there is a newest version below>

Was added two new functions. Basically one is for typing control as a kind of MASK. Usefull for fields like telephone number, zip codes or any document with mask filling. In this demo, these masks can be tested in "Cep" field adding a slash in the 6th position automatically and in "Estado" field which fill up automactically according aEstado array.

Another function check as a VALID after filling field.

In original code LABELs were with so big sizes and was making impossible to make focus by mouse in fields: Cep, Estado and Fone. So it was corrected to work in good order.

I know this example could it make better. Feel you free for improvings and use what you need it. Enjoy ! :)
Last edited by Pablo César on Fri Oct 07, 2016 11:58 am, edited 3 times in total.
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
Rathinagiri
Posts: 5471
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Contact:

Re: Fixed and enhanced SAMPLES

Post by Rathinagiri »

Thank you Pablo.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil

Fixed and enhanced SAMPLES

Post by Pablo César »

Added later in red:
Rathinagiri wrote:Thank you Pablo.
You are welcome for you and for everybody that might interest it. :)
Have you tested already? At double-click in main grid, try to fill up fields "Estado" (with "B" fo Bahia "PX" for wrong state) and "Cep" ("12345-678" for slash autocomplete case).
Are nice samples, quite similar Clipper's routines effects... but probably useful for others may implement in GUI programming. It serves as learning material.
I do not know if HMG managers have interest for improvements in our SAMPLES\Demos :?:
Because I always see the chance for enriching examples and share with colleagues.


In this demo (C:\hmg.3.4.3\SAMPLES\Applications\AGENDA), I have add other two new functions:

ChngColorField(), which is in charge to change texbox backcolor when is focused
and EnabledThis(), recently I saw there was not possible to change fontcolor in textbox when are not Enabled :| then tis function do not allow user to make focus (simple solution).

See AGENDA source code:

Code: Select all

/*
 * Agenda de Contatos
 * Humberto Fornazier - Março/2003
 * hfornazier@brfree.com.br
 * Version 4
 *
 * Enhanced: Pablo César on Feb/2015 and Oct/2016
 */

#Include "hmg.ch"

#define MY_RED    { 204,   0,   0 }
#define MY_BLUE   {   0,   0, 102 }
#define MY_GRAY   { 188, 188, 188 }
#define MY_CYAN1  {  58, 110, 165 }
#define MY_CYAN2  { 153, 217, 234 }
#define MY_YELLOW { 255, 255, 153 }

Function Main()
LOCAL i := 0

PRIVATE lNovo := .F.
PRIVATE aEstados:={"AC","AL","AP","AM","BA","CE","DF","ES","GO","MA","MT","MS","MG","PA","PB","PR","PE","PI","RJ","RN","RS","RO","RR","SC","SP","SE","TO"}

SET DELETED ON
SET CENTURY ON

AgendaOpen()

DEFINE WINDOW Form_1                 ;
    AT 0,0                           ;
    WIDTH 480                        ;
    HEIGHT 470                       ;
    TITLE "Agenda de Contatos"       ;
    MAIN                             ;
    ICON "AGENDA"                    ;
    NOMAXIMIZE                       ;
    NOSIZE                           ;
    ON RELEASE Finaliza_Sistema(.F.) ;
    BACKCOLOR MY_CYAN1
   
    @ 010,415 Grid GIndice Of Form_1            ;
              WIDTH 48 HEIGHT 360               ;
              HEADERS {""} WIDTHS { 28 }        ;
              FONT "Arial" SIZE 09 BOLD         ;
              TOOLTIP "Click na Letra Desejada" ;
              ON CHANGE Pesquisa_Agenda()

    @ 010,010 GRID Grid_Agenda Of Form_1     ;
              WIDTH  398 HEIGHT 360          ;
              HEADERS {"Código","Nome"}      ;
              WIDTHS  {53,338}               ;
              FONT "Arial" SIZE 09           ;
              ON DBLCLICK Novo_Registro(.F.)

    @ 385,010 BUTTON Btn_Novo Of Form_1 ;
              CAPTION '&Novo'           ;
              ACTION Novo_Registro(.T.) ;
              WIDTH 120 HEIGHT 27       ;
              FONT "Arial" SIZE 09      ;
              TOOLTIP "Novo Registro"   ;
              FLAT

    @ 385,165 BUTTON Btn_Imprimir Of Form_1 ;
              CAPTION '&Imprimir'           ;
              ACTION Imprimir()             ;
              WIDTH 120 HEIGHT 27           ;
              FONT "Arial" SIZE 09          ;
              TOOLTIP "Imprime Contatos"    ;
              FLAT
           
    @ 385,318 BUTTON Btn_Sair Of Form_1    ;
              CAPTION '&Sair'              ;
              ACTION Finaliza_Sistema(.T.) ;
              WIDTH 120 HEIGHT 27          ;
              FONT "Arial" SIZE 09         ;
              TOOLTIP "Finalizar Sistema"  ;
              FLAT

    @ 418,16 ANIMATEBOX mensagem   ;
             WIDTH 440 HEIGHT 22   ;
             FILE 'MSG02' AUTOPLAY CENTER

END WINDOW
For i := 1 To 26
    ADD ITEM { CHR(i+64) } TO GIndice OF Form_1
Next
MODIFY CONTROL GIndice OF Form_1 VALUE 1

Pesquisa_Agenda()

CENTER WINDOW   Form_1
ACTIVATE WINDOW Form_1
Return Nil

Function Pesquisa_Agenda()
LOCAL cPesq

cPesq := ValorDaColuna( "GIndice" ,  "Form_1" , 1 )

cPesq := IIf( Empty(cPesq), "A" , cPesq )

Agenda->(DBSetOrder(2))
Agenda->(DBSeek(cPesq,.T.))
DELETE ITEM ALL FROM Grid_Agenda OF Form_1
Do While ! Agenda->(Eof())
   If Substr(Agenda->Nome,1,1) == cPesq
      ADD ITEM {Agenda->Codigo,Agenda->Nome} TO Grid_Agenda OF Form_1
   Else
      EXIT
   Endif
   Agenda->(DBSkip())
EndDo
Return Nil

Function Novo_Registro( lNovo_Registro  )
LOCAL cCodigo   := ""
LOCAL cNome     := ""
LOCAL cEndereco := ""
LOCAL cBairro   := ""
LOCAL cCep      := ""
LOCAL cCidade   := ""
LOCAL cEstado   := ""
LOCAL cFone1    := ""
LOCAL cFone2    := ""
LOCAL cEmail    := ""

Form_1.Btn_Novo.Enabled := .F.
Form_1.Btn_Sair.Enabled := .F.

lNovo := lNovo_Registro

If ! lNovo
   cCodigo := ValorDaColuna( "Grid_Agenda", "Form_1", 1 )
   Agenda->(DBSetOrder(1))
   If ! Agenda->(DBSeek( cCodigo  ))
      MsgSTOP("Registro "+cCodigo+" não localizado!!","Agenda")
      Release Window ALL
   EndIf
   cNome     := AllTrim( Agenda->Nome)
   cEndereco := AllTrim( Agenda->Endereco)
   cBairro   := AllTrim( Agenda->Bairro)
   cCep      := AllTrim( Agenda->Cep)
   cCidade   := AllTrim( Agenda->Cidade)
   cEstado   := AllTrim( Agenda->Estado)
   cFone1    := AllTrim( Agenda->Fone1)
   cFone2    := AllTrim( Agenda->Fone2)
   cEmail    := AllTrim( Agenda->EMail)
EndIf

SET NAVIGATION EXTENDED
// DISABLEDFONTCOLOR MY_RED

DEFINE WINDOW Form_2   ;
    AT 0,0             ;
    WIDTH 490          ;
    HEIGHT 300         ;
    TITLE "Agenda de Contatos - "+Iif( lNovo , "Novo Registro" , "Alterando Registro");
    ICON "AGENDA"      ;
    MODAL              ;
    NOSIZE             ;
    ON RELEASE  {|| Form_1.Btn_Novo.Enabled := .T. , Form_1.Btn_Sair.Enabled := .T. , Form_2.Btn_Excluir.Enabled := .T. , Agenda->(DBSetOrder(2)) , Pesquisa_Agenda() , Form_1.Grid_Agenda.SetFocus } ;
    BACKCOLOR MY_CYAN2

    @ 14,10 LABEL Label_Codigo ;
        VALUE 'Código'         ;
        WIDTH 58               ;
        HEIGHT 20              ;
        FONT 'Arial' SIZE 09   ;
        BACKCOLOR MY_CYAN2     ;
        FONTCOLOR MY_BLUE BOLD

    @ 44,10 LABEL Label_Nome   ;
        VALUE 'Nome'           ;
        WIDTH 58               ;
        HEIGHT 20              ;
        FONT 'Arial' SIZE 09   ;
        BACKCOLOR MY_CYAN2     ;
        FONTCOLOR MY_BLUE BOLD

    @ 74,10 LABEL Label_Endereco ;
        VALUE 'Endereço'         ;
        WIDTH 58                 ;
        HEIGHT 20                ;
        FONT 'Arial' SIZE 09     ;
        BACKCOLOR MY_CYAN2       ;
        FONTCOLOR MY_BLUE BOLD

    @ 104,10 LABEL Label_Bairro ;
        VALUE 'Bairro'          ;
        WIDTH 58                ;
        HEIGHT 20               ;
        FONT 'Arial' SIZE 09    ;
        BACKCOLOR MY_CYAN2      ;
        FONTCOLOR MY_BLUE BOLD

    @ 104,325 LABEL Label_Cep   ;
        VALUE 'Cep'             ;
        WIDTH 58                ;
        HEIGHT 20               ;
        FONT 'Arial' SIZE 09    ;
        BACKCOLOR MY_CYAN2      ;
        FONTCOLOR MY_BLUE BOLD     ;
        RIGHTALIGN

    @ 134,10 LABEL Label_Cidade ;
        VALUE 'Cidade'          ;
        WIDTH 58                ;
        HEIGHT 20               ;
        FONT 'Arial' SIZE 09    ;
        BACKCOLOR MY_CYAN2      ;
        FONTCOLOR MY_BLUE BOLD

    @ 134,325 LABEL Label_Estado ;
        VALUE 'Estado'           ;
        WIDTH 58                 ;
        HEIGHT 20                ;
        FONT 'Arial' SIZE 09     ;
        BACKCOLOR MY_CYAN2       ;
        FONTCOLOR MY_BLUE BOLD      ;
        RIGHTALIGN

    @ 164,10 LABEL Label_Fone1  ;
        VALUE 'Fone 1'          ;
        WIDTH 58                ;
        HEIGHT 20               ;
        FONT 'Arial' SIZE 09    ;
        BACKCOLOR MY_CYAN2      ;
        FONTCOLOR MY_BLUE BOLD

    @ 164,325 LABEL Label_Fone2 ;
        VALUE 'Fone 2'          ;
        WIDTH 58                ;
        HEIGHT 20               ;
        FONT 'Arial' SIZE 09    ;
        BACKCOLOR MY_CYAN2      ;
        FONTCOLOR MY_BLUE BOLD     ;
        RIGHTALIGN

    @ 194,10 LABEL Label_Email  ;
        VALUE 'e-mail'          ;
        WIDTH 58                ;
        HEIGHT 20               ;
        FONT 'Arial' SIZE 09    ;
        BACKCOLOR MY_CYAN2      ;
        FONTCOLOR MY_BLUE BOLD
    
    @ 13,70 TEXTBOX T_Codigo        ;
        WIDTH 40                    ;
        VALUE cCodigo               ;
        TOOLTIP 'Código do Contato' ;
		FONTCOLOR MY_RED            ;
		BACKCOLOR MY_GRAY           ;
		ON GOTFOCUS EnabledThis()
		
    @ 43,70 TEXTBOX T_Nome           ;
        OF Form_2                    ;
        WIDTH 400                    ;
        VALUE cNome                  ;
        TOOLTIP 'Nome do Contato'    ;
        MAXLENGTH 40                 ;
        UPPERCASE                    ;
		ON GOTFOCUS ChngColorField() ;
        ON CHANGE TypingCheck()

    @ 73,70 TEXTBOX T_Endereco        ;
        OF Form_2                     ;
        WIDTH 400                     ;
        VALUE cEndereco               ;
        TOOLTIP 'Endereço do Contato' ;
        MAXLENGTH 40                  ;
        UPPERCASE                     ;
		ON GOTFOCUS ChngColorField()  ;
        ON CHANGE TypingCheck()

    @ 103,70 TEXTBOX T_Bairro        ;
        OF Form_2                    ;
        WIDTH 250                    ;
        VALUE cBairro                ;
        TOOLTIP 'Bairro do Contato'  ;
        MAXLENGTH 25                 ;
        UPPERCASE                    ;
		ON GOTFOCUS ChngColorField() ;
        ON CHANGE TypingCheck()
        
    @ 103,390 TEXTBOX T_Cep          ;
        OF Form_2                    ;
        WIDTH 80                     ;
        VALUE cCep                   ;
        TOOLTIP "Cep do Contato"     ;
        MAXLENGTH 09                 ;
        UPPERCASE                    ;
		ON GOTFOCUS ChngColorField() ;
        ON CHANGE TypingCheck()

    @ 133,70 TEXTBOX T_Cidade        ;
        OF Form_2                    ;
        WIDTH 250                    ;
        VALUE cCidade                ;
        TOOLTIP "Cidade do Contato"  ;
        MAXLENGTH 25                 ;
        UPPERCASE                    ;
		ON GOTFOCUS ChngColorField() ;
        ON CHANGE TypingCheck()

    @ 133,390 TEXTBOX T_Estado       ;
        OF Form_2                    ;
        WIDTH 30                     ;
        VALUE cEstado                ;
        TOOLTIP "Estado do Contato"  ;
        MAXLENGTH 02                 ;
        UPPERCASE                    ;
		ON GOTFOCUS ChngColorField() ;
        ON CHANGE TypingCheck()      ;
        ON LOSTFOCUS ExitCheck()

    @ 163,70 TEXTBOX T_Fone1          ;
        OF Form_2                     ;
        WIDTH 110                     ;
        VALUE cFone1                  ;
        TOOLTIP "Telefone do Contato" ;
        MAXLENGTH 10                  ;
        UPPERCASE                     ;
		ON GOTFOCUS ChngColorField()  ;
        ON CHANGE TypingCheck()

    @ 163,390 TEXTBOX T_Fone2               ;
        OF Form_2                           ;
        WIDTH 80                            ;
        VALUE cFone2                        ;
        TOOLTIP 'Outro Telefone do Contato' ;
        MAXLENGTH 10                        ;
        UPPERCASE                           ;
		ON GOTFOCUS ChngColorField()        ;
        ON CHANGE TypingCheck()

    @ 193,70 TEXTBOX T_Email         ;
        OF Form_2                    ;
        WIDTH 400                    ;
        VALUE cEmail                 ;
        TOOLTIP 'E-mail do Contato'  ;
        MAXLENGTH 40                 ;
        LOWERCASE                    ;
		ON GOTFOCUS ChngColorField() ;
        ON CHANGE TypingCheck()

    @ 232,70 BUTTON Btn_Salvar Of Form_2 ;
        CAPTION '&Salvar'                ;
        ACTION Salvar_Registro()         ;
        WIDTH 120 HEIGHT 27              ;
        FONT "Arial" SIZE 09             ;
        TOOLTIP "Salvar Registro"        ;
        FLAT       

    @ 232,210  BUTTON Btn_Excluir Of Form_2 ;
        CAPTION '&Deletar'                  ;
        ACTION Excluir_Registro()           ;
        WIDTH 120 HEIGHT 27                 ;
        FONT "Arial" SIZE 09                ;
        TOOLTIP "Excluir Registro"          ;
        FLAT

    @ 232,346  BUTTON Btn_Cancelar Of Form_2 ;
        CAPTION '&Cancelar'                  ;
        ACTION Sair_do_Form2()               ;
        WIDTH 120 HEIGHT 27                  ;
        FONT "Arial" SIZE 09                 ;
        TOOLTIP "Cancelar Operação"          ;
        FLAT

END WINDOW
// Form_2.T_Codigo.Enabled := .F.
// SetProperty("Form_2","T_Codigo","DISABLEDFONTCOLOR",MY_RED) // Not working
If lNovo
   Form_2.Btn_Salvar.Enabled := .F.
   Form_2.Btn_Excluir.Enabled := .F.   
EndIf

CENTER WINDOW   Form_2
ACTIVATE WINDOW Form_2
Return Nil

Function Salvar_Registro()
LOCAL ProximoCodigo := ""
LOCAL cCodigo       := ""

If Empty( Form_2.T_Nome.Value )
   MsgInfo( "Nome não foi Informado!!" , "Agenda" )
   Form_2.T_Nome.SetFocus
   Return Nil
EndIf       

If lNovo     
   Agenda->(DBSetOrder(1))
   Agenda->(DBGoBottom())
   ProximoCodigo    := StrZero(  Val( Agenda->Codigo ) + 1 , 4 )
   Agenda->(DBAppend())
   Agenda->Codigo   := ProximoCodigo
   Agenda->Nome     := Form_2.T_Nome.Value
   Agenda->Endereco := Form_2.T_Endereco.Value
   Agenda->Bairro   := Form_2.T_Bairro.Value
   Agenda->Cep      := Form_2.T_Cep.Value
   Agenda->Cidade   := Form_2.T_Cidade.Value
   Agenda->Estado   := Form_2.T_Estado.Value
   Agenda->Fone1    := Form_2.T_Fone1.Value
   Agenda->Fone2    := Form_2.T_Fone2.Value
   Agenda->EMail    := Form_2.T_Email.Value
Else
   cCodigo := Form_2.T_Codigo.Value
   Agenda->(DBSetOrder(1))
   If ! Agenda->(DBSeek( cCodigo ))
      MsgSTOP("Registro "+cCodigo+" não localizado!!","Agenda")
      Release Window ALL
   EndIf
   If BloqueiaRegistroNaRede( "Agenda" )
      Agenda->Nome     := Form_2.T_Nome.Value
      Agenda->Endereco := Form_2.T_Endereco.Value
      Agenda->Bairro   := Form_2.T_Bairro.Value
      Agenda->Cep      := Form_2.T_Cep.Value
      Agenda->Cidade   := Form_2.T_Cidade.Value
      Agenda->Estado   := Form_2.T_Estado.Value
      Agenda->Fone1    := Form_2.T_Fone1.Value
      Agenda->Fone2    := Form_2.T_Fone2.Value
      Agenda->EMail    := Form_2.T_Email.Value
      Agenda->(DBUnlock())
   EndIf
EndIf
MsgInfo( "Registo "+Iif( lNovo , "Incluído" ,"Alterado!!" ) )
PosicionaIndice( Left( Agenda->Nome , 1 ) )
Pesquisa_Agenda()
Form_2.Release
Return Nil

Function Sair_do_Form2()
Form_1.Btn_Novo.Enabled := .T.
Form_1.Btn_Sair.Enabled := .T.
Form_2.Btn_Excluir.Enabled := .T.
Form_2.Release
Agenda->(DBSetOrder(2))
Pesquisa_Agenda()
Form_1.Grid_Agenda.SetFocus
Return Nil

Function Excluir_Registro()
If MsgOkCancel ("Confirma Exclusão do Registro??", "Excluir "+AllTrim(Agenda->Nome))
   If BloqueiaRegistroNaRede( "Agenda" )
      Agenda->(DBDelete())
      Agenda->(DBUnlock())
      MsgInfo("Registro Excluído!!","Agenda")
      Sair_do_Form2()
   EndIf
EndIf
Form_1.Grid_Agenda.SetFocus
Return Nil

Function Finaliza_Sistema(lRelease)
If !Empty(Alias()) .and. !lRelease
   Agenda->(DBCloseArea())
Endif
If lRelease
   Form_1.Release
Endif
Return Nil
   
Function AgendaOpen()
LOCAL nArea  := Select( 'Agenda' )
LOCAL aarq   := {}       
LOCAL aDados := {}

If nArea == 0
   If ! File( "AGENDA.DBF" )
      Aadd( aArq , { 'CODIGO'   , 'C' , 04 , 0 } )
      Aadd( aArq , { 'NOME '    , 'C' , 40 , 0 } )
      Aadd( aArq , { 'ENDERECO' , 'C' , 40 , 0 } )
      Aadd( aArq , { 'BAIRRO'   , 'C' , 25 , 0 } )
      Aadd( aArq , { 'CEP'      , 'C' , 08 , 0 } )
      Aadd( aArq , { 'CIDADE'   , 'C' , 25 , 0 } )
      Aadd( aArq , { 'ESTADO'   , 'C' , 02 , 0 } )
      Aadd( aArq , { 'FONE1'    , 'C' , 10 , 0 } )
      Aadd( aArq , { 'FONE2'    , 'C' , 10 , 0 } )
      Aadd( aArq , { 'EMAIL'    , 'C' , 40 , 0 } )
      DBCreate( "AGENDA.DBF" , aArq  )     
   EndIf
   Use AGENDA Alias Agenda new shared
   If ! File( 'Agenda1.ntx' )
      Index on Codigo to Agenda1
   Endif
   If ! File( 'Agenda2.ntx' )
      Index on Nome  to Agenda2
   Endif
   Agenda->(DBCLearIndex())
   Agenda->(DBSetIndex( 'Agenda1'))
   Agenda->(DBSetIndex( 'Agenda2'))
Endif 
Return Nil

Function ValorDaColuna( ControlName, ParentForm , nCol )
LOCAL aRet := {}
LOCAL nRec := GetProperty( ParentForm , ControlName , 'Value' )

If GetControlType (ControlName,ParentForm) != "GRID"
   MsgBox( "Objeto não é um Grid!!")
   Return( aRet )
EndIf   
nCol := Iif( nCol == Nil .Or. nCol == 0 , 1 , nCol )
aRet := GetProperty ( ParentForm, ControlName, 'Item', nRec )
Return( aRet[ nCol ] ) 

Function BloqueiaRegistroNaRede( cArea )
Do While ! (cArea)->(RLock())
   If ! MSGRetryCancel("Registro em Uso na Rede Tenta Acesso??","Agenda")
      Return .F.
   EndIf
EndDo
Return .T.

Function PosicionaIndice(cLetra)
LOCAL i := 0

For i := 1 To 26
    If CHR(i+64) == cLetra
       MODIFY CONTROL GIndice OF Form_1 VALUE i
    EndIf
Next
Form_1.GIndice.SetFocus
Return Nil

Function Imprimir()
LOCAL nLinha := 0
LOCAL i      := 0
LOCAL cLetra := ""
LOCAL nReg   := 0

PRIVATE nFont := 11
PRIVATE cArquivo := ""

Set Printer TO REL.TMP
Set Printer ON
Set Console OFF

cLetra := ValorDaColuna( "GIndice" ,  "Form_1" , 1 )

Agenda->(DBSetOrder(2))
Agenda->(DBSeek(cLetra,.T.))   
Do While ! Agenda->(Eof())
   If Substr(Agenda->Nome,1,1) == cLetra
      If nLinha == 0
         ? PadC("     Agenda de Contatos",78)
         ? PadC("Contatos Cadastrados com letra "+cLetra,78)
         ? "Código  Nome"           
         ? Replicate("-",78)
      EndIf
      nLinha += 1
      nReg += 1
      ?   "  "+Agenda->Codigo +   "   "
      ?? Agenda->Nome                             
   Else
      EXIT
   Endif
   Agenda->(DBSkip())
EndDo
? Replicate("-",78)
? "Registros Impressos: "+StrZero(nReg,4)

Set Printer TO
Set Printer OFF
Set Console ON

cArquivo := MemoRead("REL.TMP")

DEFINE WINDOW Form_3 At 0,0 Width 450 Height 500   ;
    Title "Contatos Cadastrados com Letra "+cLetra ;
    ICON "AGENDA" CHILD NOSYSMENU NOSIZE BACKCOLOR WHITE

    @ 20,-1 EDITBOX Edit_1 ;
        WIDTH 460          ;
        HEIGHT 510         ;
        VALUE cArquivo     ;
        TOOLTIP "Contatos Cadastrados com Letra "+cLetra ;
        MAXLENGTH 255               

    @ 01,01 BUTTON Bt_Zoom_Mais  ;
        CAPTION '&Zoom(+)'       ;
        WIDTH 120 HEIGHT 17      ;
        ACTION ZoomLabel(1);
        FONT "MS Sans Serif" SIZE 09 FLAT

    @ 01,125 BUTTON Bt_Zoom_menos  ;
        CAPTION '&Zoom(-)'         ;
        WIDTH 120 HEIGHT 17        ;
        ACTION ZoomLabel(2);
        FONT "MS Sans Serif" SIZE 09 FLAT

    @ 01,321 BUTTON Sair_1     ;
        CAPTION '&Sair'        ;
        WIDTH 120 HEIGHT 17    ;
        ACTION Form_3.Release  ;
        FONT "MS Sans Serif" SIZE 09 FLAT

END WINDOW
MODIFY CONTROL Edit_1 OF Form_3 FONTSIZE nFont 
Center Window Form_3
Activate Window Form_3
Return Nil

Function ZoomLabel(nmm)         
If nmm == 1
   nFont++
Else
   nFont--
Endif
MODIFY CONTROL Edit_1 OF Form_3 FONTSIZE nFont
Return Nil

Function ChngColorField()
LOCAL cField := This.Name

SetProperty("Form_2","T_Nome"    ,"BACKCOLOR",If(cField=="T_Nome",    MY_YELLOW,WHITE))
SetProperty("Form_2","T_Endereco","BACKCOLOR",If(cField=="T_Endereco",MY_YELLOW,WHITE))
SetProperty("Form_2","T_Bairro"  ,"BACKCOLOR",If(cField=="T_Bairro",  MY_YELLOW,WHITE))
SetProperty("Form_2","T_Cep"     ,"BACKCOLOR",If(cField=="T_Cep",     MY_YELLOW,WHITE))
SetProperty("Form_2","T_Cidade"  ,"BACKCOLOR",If(cField=="T_Cidade",  MY_YELLOW,WHITE))
SetProperty("Form_2","T_Estado"  ,"BACKCOLOR",If(cField=="T_Estado",  MY_YELLOW,WHITE))
SetProperty("Form_2","T_Fone1"   ,"BACKCOLOR",If(cField=="T_Fone1",   MY_YELLOW,WHITE))
SetProperty("Form_2","T_Fone2"   ,"BACKCOLOR",If(cField=="T_Fone2",   MY_YELLOW,WHITE))
SetProperty("Form_2","T_Email"   ,"BACKCOLOR",If(cField=="T_Email",   MY_YELLOW,WHITE))
Return Nil

Function TypingCheck()
LOCAL cField := This.Name
LOCAL xValue := This.Value
LOCAL nLen := HMG_Len(AllTrim(xValue))
LOCAL cLast := hb_USubStr(xValue,nLen,1)
LOCAL nFound, i, nCount

Do Case
   Case cField=="T_Nome"
           If Empty(xValue)
              MsgStop("Não pode deixar este campo em branco")
              InsertControlZ()
           Endif
   Case cField=="T_Endereco"
   Case cField=="T_Bairro"
   Case cField=="T_Cep"
        If HMG_IsAlpha(CharRem("0123456789-",xValue))
           MsgStop("Só é permitido números")
           InsertBackSpace()
        Else
           If nLen=6
              If !(cLast=="-")
                 SetProperty("Form_2",cField,"Value",hb_USubStr(xValue,1,nLen-1)+"-"+cLast)
                 SetProperty("Form_2",cField,"CaretPos",nLen+1)
              Endif
           Endif
           If GetProperty("Form_2",cField,"CaretPos")=9
              InsertTab()
           Endif
        Endif
   Case cField=="T_Cidade"
   Case cField=="T_Estado"
        If nLen=1
           nFound:=AScan(aEstados,cLast)
           If nFound>0
              nCount:=0
              For i=1 To 27
                  If hb_USubStr(aEstados[i],1,1)==cLast
                     nCount:=nCount+1
                  Endif
              Next
              If nCount=1
                 SetProperty("Form_2",cField,"Value",aEstados[nFound])
                 nLen++
              Endif
           Endif
        Else
           nFound:=Ascan(aEstados,xValue)
        Endif
        If nFound=0
           InsertBackSpace()
        Else
           If nLen>1
              InsertTab()
           Endif
        Endif
   Case cField=="T_Fone1"
   Case cField=="T_Fone2"
   Case cField=="T_Email"
EndCase
Return Nil

Function ExitCheck()
LOCAL cField := This.Name
LOCAL xValue := This.Value
LOCAL nLen := HMG_Len(AllTrim(xValue))

Do Case
   Case cField=="T_Nome"
   Case cField=="T_Endereco"
   Case cField=="T_Bairro"
   Case cField=="T_Cep"
   Case cField=="T_Cidade"
   Case cField=="T_Estado"
        If nLen=1
           MsgStop("Deve completar o prenchimento do estado")
           InsertShiftTab()
        Endif
   Case cField=="T_Fone1"
   Case cField=="T_Fone2"
   Case cField=="T_Email"
EndCase
Form_2.Btn_Salvar.Enabled := .T.
Return Nil

Function EnabledThis()
InsertTab()
Return Nil
Was centralized animated file and with this it has been reponsed with the real WIDTH of this control.

I also changed background colors to become more beautiful screens.
Screen12.png
Screen12.png (20 KiB) Viewed 6109 times
Insert keys (HMG C functions) were utilized for moveto next fields and to erase wrong data.

Enjoy ! :)
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
serge_girard
Posts: 3162
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Contact:

Re: Fixed and enhanced SAMPLES

Post by serge_girard »

Thanks Pablo !

Little improvement:

Code: Select all

	@ 240,1010 TEXTBOX tb_PIC_groot;
		WIDTH		 200 ;
		MAXLENGTH 80;
		VALUE     ''     ;
		BACKCOLOR SILVER   ;
		FONT 'Arial' SIZE 10 ; 
		ON GOTFOCUS  ChngColorField(1) ; 
		ON LOSTFOCUS ChngColorField(2)  
etc...


Function ChngColorField(x)
LOCAL cField := This.Name
IF x == 1 
   SetProperty("Form_1", cField    , "BACKCOLOR",    MY_YELLOW )
ELSE
   SetProperty("Form_1", cField    , "BACKCOLOR",    SILVER )
ENDIF
Return Nil


This will work for any field without mentioning fieldname, thanks to you!

Serge
There's nothing you can do that can't be done...
User avatar
serge_girard
Posts: 3162
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Contact:

Re: Fixed and enhanced SAMPLES

Post by serge_girard »

And another one to match all forms:

Code: Select all

FUNCTION ChngColorField(x)
/***************************/
LOCAL cField   := This.Name
LOCAL cForm    := ThisWindow.Name
IF x == 1 
   SetProperty(cForm, cField    , "BackColor",    MY_YELLOW )
ELSE
   SetProperty(cForm, cField    , "BackColor",    SILVER )
ENDIF
RETURN NIL

Serge
There's nothing you can do that can't be done...
User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil

Fixed and enhanced SAMPLES

Post by Pablo César »

serge_girard wrote: This will work for any field without mentioning fieldname, thanks to you!
Hi Serge, thanks for your interest and contribution. But in this specific case, we should take all other textboxes which need to be sweeped and returns to original color. And when we do not know which control was the previous one I'd choose for all controls except the current with different color. When I say "we do not know" is by the reason that user can click at any field without sequence.

Always there is a chance to improve codes, thank you.
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
Post Reply