Fixed and enhanced SAMPLES
Moderator: Rathinagiri
- serge_girard
- Posts: 3162
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
Hi Erik,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.
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:
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
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
- luisvasquezcl
- Posts: 1258
- Joined: Thu Jul 31, 2008 3:23 am
- Location: Chile
- Contact:
Re: Fixed and enhanced SAMPLES
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,
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,
- luisvasquezcl
- Posts: 1258
- Joined: Thu Jul 31, 2008 3:23 am
- Location: Chile
- Contact:
Re: Fixed and enhanced SAMPLES
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)
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)
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
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 !
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
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
- 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
Thank you Pablo.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
South or North HMG is worth.
...the possibilities are endless.
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
Added later in red:
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:
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. Insert keys (HMG C functions) were utilized for moveto next fields and to erase wrong data.
Enjoy !
You are welcome for you and for everybody that might interest it.Rathinagiri wrote:Thank you Pablo.
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
I also changed background colors to become more beautiful screens. 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
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
- 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
Thanks Pablo !
Little improvement:
This will work for any field without mentioning fieldname, thanks to you!
Serge
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...
- 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
And another one to match all forms:
Serge
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
There's nothing you can do that can't be done...
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
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.serge_girard wrote: This will work for any field without mentioning fieldname, thanks to you!
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
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein