Fixed and enhanced SAMPLES
Moderator: Rathinagiri
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
Hellow HMGians,
I made this new topic, in order to keep all enhanced demos in SAMPLES.
Probably some will be not good enough or not be approved for any reason, but it could be useful for learning use.
And please, every body can contribute to post your improved demo or even correct any demo at our SAMPLES folder that is not working properly.
This C:\hmg.3.4.0\SAMPLES\Basics\MULTIPRG\demo.prg is still not building.
Passed long time and was not correct since last report on 2013 by Javier Tovar in this topic
Hereunder improved examples with new batch files for demo compilling.
Following are attached source files: I hope you enjoy it !
I made this new topic, in order to keep all enhanced demos in SAMPLES.
Probably some will be not good enough or not be approved for any reason, but it could be useful for learning use.
And please, every body can contribute to post your improved demo or even correct any demo at our SAMPLES folder that is not working properly.
This C:\hmg.3.4.0\SAMPLES\Basics\MULTIPRG\demo.prg is still not building.
Passed long time and was not correct since last report on 2013 by Javier Tovar in this topic
Hereunder improved examples with new batch files for demo compilling.
Following are attached source files: I hope you enjoy it !
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
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
SAMPLES corrections
Hi HMGians,
In C:\hmg.3.4.0\SAMPLES\Applications\AGENDA samples the source code is very unligned (not dented) and I also corrected following items:
Rgds
In C:\hmg.3.4.0\SAMPLES\Applications\AGENDA samples the source code is very unligned (not dented) and I also corrected following items:
- Width size of first grid which acts as an index list (was not displaying)
Reported by Javier Tovar on 2013 - Changed DOUBLECLICK for just CLICK
- Unicode mode
Code: Select all
/*
* Agenda de Contatos (2)
* Humberto Fornazier - Março/2003
* hfornazier@brfree.com.br
*
* HMG - Harbour Win32 GUI library - Release 60
* Copyright 2002 Roberto Lopez <mail.box.hmg@gmail.com>
* http://www.hmgforum.com//
*/
#Include "hmg.ch"
#define BLUE { 0, 0, 128 }
Function Main()
Local i := 0
SET DELETED ON
SET CENTURY ON
Private lNovo := .F.
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() ;
BACKCOLOR BLUE
@ 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 CLICK Pesquisa_Agenda()
@ 010,010 GRID Grid_Agenda ;
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 Form_1.Release ;
WIDTH 120 HEIGHT 27 ;
FONT "Arial" SIZE 09 ;
TOOLTIP "Finalizar Sistema" ;
FLAT
@ 418,16 ANIMATEBOX mensagem ;
WIDTH 390 ;
HEIGHT 20 ;
FILE 'MSG02' AUTOPLAY
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
Function Pesquisa_Agenda()
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
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 WHITE
@ 10,10 LABEL Label_Codigo ;
VALUE 'Código' ;
WIDTH 140 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 40,10 LABEL Label_Nome ;
VALUE 'Nome' ;
WIDTH 140 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 70,10 LABEL Label_Endereco ;
VALUE 'Endereço' ;
WIDTH 140 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 100,10 LABEL Label_Bairro ;
VALUE 'Bairro' ;
WIDTH 140 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 100,360 LABEL Label_Cep ;
VALUE 'Cep' ;
WIDTH 80 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 130,10 LABEL Label_Cidade ;
VALUE 'Cidade' ;
WIDTH 140 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 130,345 LABEL Label_Estado ;
VALUE 'Estado' ;
WIDTH 80 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 160,10 LABEL Label_Fone1 ;
VALUE 'Fone 1' ;
WIDTH 80 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 160,346 LABEL Label_Fone2 ;
VALUE 'Fone 2' ;
WIDTH 80 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 190,10 LABEL Label_Email ;
VALUE 'e-mail' ;
WIDTH 140 ;
HEIGHT 30 ;
FONT 'Arial' SIZE 09 ;
BACKCOLOR WHITE ;
FONTCOLOR BLUE BOLD
@ 13,70 TEXTBOX T_Codigo ;
WIDTH 40 ;
VALUE cCodigo ;
TOOLTIP 'Código do Contato'
@ 43,70 TEXTBOX T_Nome ;
OF Form_2 ;
WIDTH 400 ;
VALUE cNome ;
TOOLTIP 'Nome do Contato' ;
MAXLENGTH 40 ;
UPPERCASE ;
ON ENTER Iif( ! Empty( Form_2.T_Nome.Value ) , Form_2.T_Endereco.SetFocus , Form_2.T_Nome.SetFocus )
@ 73,70 TEXTBOX T_Endereco ;
OF Form_2 ;
WIDTH 400 ;
VALUE cEndereco ;
TOOLTIP 'Endereço do Contato';
MAXLENGTH 40 ;
UPPERCASE ;
ON GOTFOCUS Form_2.Btn_Salvar.Enabled := .T. ;
ON ENTER Form_2.T_Bairro.SetFocus
@ 103,70 TEXTBOX T_Bairro ;
OF Form_2 ;
WIDTH 250 ;
VALUE cBairro ;
TOOLTIP 'Bairro do Contato' ;
MAXLENGTH 25 ;
UPPERCASE ;
ON ENTER Form_2.T_Cep.SetFocus
@ 103,390 TEXTBOX T_Cep ;
OF Form_2 ;
WIDTH 80 ;
VALUE cCep ;
TOOLTIP 'Cep do Contato' ;
MAXLENGTH 08 ;
UPPERCASE ;
ON ENTER Form_2.T_Cidade.SetFocus
@ 133,70 TEXTBOX T_Cidade ;
OF Form_2 ;
WIDTH 250 ;
VALUE cCidade ;
TOOLTIP 'Bairro do Contato' ;
MAXLENGTH 25 ;
UPPERCASE ;
ON ENTER Form_2.T_Estado.SetFocus
@ 133,390 TEXTBOX T_Estado ;
OF Form_2 ;
WIDTH 30 ;
VALUE cEstado ;
TOOLTIP 'Estado do Contato';
MAXLENGTH 02 ;
UPPERCASE ;
ON ENTER Form_2.T_Fone1.SetFocus
@ 163,70 TEXTBOX T_Fone1 ;
OF Form_2 ;
WIDTH 110 ;
VALUE cFone1 ;
TOOLTIP 'Telefone do Contato';
MAXLENGTH 10 ;
UPPERCASE ;
ON ENTER Form_2.T_Fone2.SetFocus
@ 163,390 TEXTBOX T_Fone2 ;
OF Form_2 ;
WIDTH 80 ;
VALUE cFone2 ;
TOOLTIP 'Telefone do Contato';
MAXLENGTH 10 ;
UPPERCASE ;
ON ENTER Form_2.T_Email.SetFocus
@ 193,70 TEXTBOX T_Email ;
OF Form_2 ;
WIDTH 400 ;
VALUE cEmail ;
TOOLTIP 'E-mail do Contato' ;
MAXLENGTH 40 ;
LOWERCASE ;
ON ENTER Form_2.Btn_Salvar.SetFocus
@ 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.
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()
Agenda->(DBCloseArea())
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 := {}
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' , GetProperty( ParentForm , ControlName , 'Value' ) )
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
Last edited by Pablo César on Thu Oct 06, 2016 12:17 pm, edited 1 time 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
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
SAMPLES corrections
Hi HMGians,
Hereunder a new and enhanced version of C:\hmg.3.4.0\SAMPLES\Basics\MIXEDCONSOLE\demo2
This a simple test interacting between two modes.
Works with On ENTER event in TextBox and GET to alternate it.
With this I am not wanting to encourage this practice but can come help many.
There is another second sample, based on Grigory demo which uses Senddata, Getdata, STATIONNAME and COMMPATH that could be also good to mention at: viewtopic.php?p=40056#p40056
I hope you enjoy it !
Hereunder a new and enhanced version of C:\hmg.3.4.0\SAMPLES\Basics\MIXEDCONSOLE\demo2
Code: Select all
/*
New C:\hmg.3.4.0\SAMPLES\Basics\MIXEDCONSOLE demo2
By Pablo César Arrascaeta
February 23rd, 2015
*/
#include "hmg.ch"
REQUEST HB_GT_WIN_DEFAULT
Function Main()
Public hWnd1, hWnd2
DEFINE WINDOW form_1 AT 100 , 700 WIDTH 200 HEIGHT 200 TITLE "Mixed Mode Demo" MAIN
DEFINE BUTTON Button_1
ROW 10
COL 10
CAPTION "Test Console"
ACTION TestConsole()
END BUTTON
DEFINE TEXTBOX Text_1
ROW 110
COL 30
WIDTH 120
HEIGHT 24
FONTNAME "Arial"
FONTSIZE 9
TOOLTIP "Type your name"
ONENTER TestConsole()
VALUE ""
END TEXTBOX
END WINDOW
hWnd1:=GetFormHandle("Form_1")
Form_1.Text_1.SetFocus
ACTIVATE WINDOW form_1
Return Nil
Function TestConsole()
Local cName:=PadR(GetProperty("Form_1","Text_1","Value"),30)
If !ValType(hWnd2)="N"
hWnd2:=GetConsoleWindowHandle()
Endif
SetForeGroundWindow( hWnd2 )
SetMode(25,80)
CLS
@ 12,00 SAY "Name:" GET cName
READ
If LastKey()=27
TerminateProcess()
Endif
SetForeGroundWindow( hWnd1 )
Form_1.Text_1.SetFocus
Form_1.Text_1.Value:=cName
Return nil
#pragma BEGINDUMP
#define WINVER 0x0600 // for Vista
#define _WIN32_WINNT 0x0600 // for Vista
#include "windows.h"
#include "hbapi.h"
HB_FUNC( GETCONSOLEWINDOWHANDLE )
{
HWND hwnd;
AllocConsole();
hwnd = FindWindowA("ConsoleWindowClass",NULL);
hb_retnl( (LONG) hwnd );
}
/* Enable when need to compile with 3.1.14 older versions
HB_FUNC ( SETWINDOWPOS )
{
HWND hwnd = (HWND) hb_parnl(1); // handle to window or control
HWND hWndInsertAfter= (HWND) hb_parnl(2); // placement-order handle
int X = hb_parni(3); // horizontal position
int Y = hb_parni(4); // vertical position
int cx = hb_parni(5); // width
int cy = hb_parni(6); // height
UINT uFlags = (UINT) hb_parni(7); // window-positioning options
hb_retl( (BOOL) SetWindowPos( hwnd, hWndInsertAfter, X, Y, cx, cy, uFlags ) );
}
HB_FUNC ( TERMINATEPROCESS )
{
DWORD ProcessID = HB_ISNUM (1) ? (DWORD) hb_parnl(1) : GetCurrentProcessId();
UINT uExitCode = (UINT) hb_parnl (2);
HANDLE hProcess = OpenProcess ( PROCESS_TERMINATE, FALSE, ProcessID );
if ( hProcess != NULL )
{ if ( TerminateProcess (hProcess, uExitCode) == FALSE )
CloseHandle (hProcess);
}
}
*/
#pragma ENDDUMP
Works with On ENTER event in TextBox and GET to alternate it.
With this I am not wanting to encourage this practice but can come help many.
There is another second sample, based on Grigory demo which uses Senddata, Getdata, STATIONNAME and COMMPATH that could be also good to mention at: viewtopic.php?p=40056#p40056
I hope you enjoy it !
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
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
Hi all,
This C:\hmg.3.4.0\SAMPLES\Advanced\GRID_SORT is not compiling and some errors were fixed as follows:
Keeping you actualized with right demo in our SAMPLES !
Hi Dr. Soto,
In this fixed code demo when we Set New Columns Order grid's columns put in 3, 5, 4, 2, 1 order as defined in SetOrder() function. This function uses C ListView_SetColumnOrderArray function which set order in grid but seems not take duly effects when we push columns data doing by this way. IMHO this example should use this _GridEx_SetColumnDisplayPosition in place of that. Then I suppose to correct this problem, doesn't it ?
Would you tell use how is the right use of _GridEx_SetColumnDisplayPosition ?
This C:\hmg.3.4.0\SAMPLES\Advanced\GRID_SORT is not compiling and some errors were fixed as follows:
- Removed Memvar fColor at begining of code, because was causing an error during compiling:
MEMVAR declaration follows executable statement - GetOrder function been enhanced showing in one MsgInfo with result concatenated
Code: Select all
/*
* HMG Grid Demo
* (c) 2005 Roberto Lopez
*
* ListView SORT ORDER COLUMN
* Author: BADIK <badik@mail.ru>
*
* Fixed and enhanced by Pablo César Arrascaeta
* On February, 2015
*/
#include "hmg.ch"
// Memvar fColor // Error during compiling: MEMVAR declaration follows executable statement
Function Main()
Local aRows [20] [3]
Private fColor := { || if ( This.CellRowIndex/2 == int(This.CellRowIndex/2) , { 0,0,255 } , { 0,255,0 } ) }
DEFINE WINDOW Form_1 ;
AT 0,0 ;
WIDTH 640 ;
HEIGHT 400 ;
TITLE 'Mixed Data Type Grid Test' ;
MAIN
DEFINE MAIN MENU
DEFINE POPUP 'File'
MENUITEM 'Set New Columns Order' ACTION SetOrder()
MENUITEM 'Get Columns Order' ACTION GetOrder()
MENUITEM 'Refresh Grid' ACTION Form_1.Grid_1.Refresh
SEPARATOR
MENUITEM 'Exit' ACTION Form_1.Release
END POPUP
END MENU
aRows [1] := { 113.12, date()-1, 1, 1, .t. }
aRows [2] := { 123.12, date()-2, 2, 2, .f. }
aRows [3] := { 133.12, date(), 3, 3, .t. }
aRows [4] := { 143.12, date(), 1, 4, .f. }
aRows [5] := { 153.12, date(), 2, 5, .t. }
aRows [6] := { 163.12, date(), 3, 6, .f. }
aRows [7] := { 173.12, date(), 1, 7, .t. }
aRows [8] := { 183.12, date(), 2, 8, .f. }
aRows [9] := { 193.12, date(), 3, 9, .t. }
aRows [10] := { 113.12, date(), 1, 10, .f. }
aRows [11] := { 123.12, date(), 2, 11, .t. }
aRows [12] := { 133.12, date(), 3, 12, .f. }
aRows [13] := { 143.12, date(), 1, 13, .t. }
aRows [14] := { 153.12, date(), 2, 14, .f. }
aRows [15] := { 163.12, date(), 3, 15, .t. }
aRows [16] := { 173.12, date(), 1, 16, .f. }
aRows [17] := { 183.12, date(), 2, 17, .t. }
aRows [18] := { 193.12, date(), 3, 18, .f. }
aRows [19] := { 113.12, date(), 1, 19, .t. }
aRows [20] := { 123.12, date(), 2, 20, .f. }
@ 10, 10 GRID Grid_1 ;
WIDTH 620 ;
HEIGHT 330 ;
HEADERS {'Column 1','Column 2','Column 3','Column 4','Column 5'} ;
WIDTHS {140,140,140,140,140} ;
ITEMS aRows ;
EDIT ;
COLUMNCONTROLS { ;
{'TEXTBOX', 'NUMERIC', '$ 999,999.99'}, ;
{'DATEPICKER', 'DROPDOWN'}, ;
{'COMBOBOX', {'One', 'Two', 'Three'}}, ;
{'SPINNER', 1, 20 }, ;
{'CHECKBOX', 'Yes', 'No' } } ;
COLUMNWHEN { { || This.CellValue > 120 }, { || This.CellValue = Date() }, Nil, Nil, Nil } ;
DYNAMICFORECOLOR { fColor , fColor, fColor, fColor, fColor }
END WINDOW
CENTER WINDOW Form_1
ACTIVATE WINDOW Form_1
Return Nil
Function SetOrder()
Local i, aColumns := { 5, 4, 3, 2, 1 }
Form_1.Grid_1.DisableUpdate()
FOR i = 1 TO Form_1.Grid_1.ColumnCOUNT
Form_1.Grid_1.ColumnDISPLAYPOSITION (i) := aColumns [i]
NEXT
Form_1.Grid_1.EnableUpdate()
Form_1.Grid_1.Refresh
Return Nil
Function GetOrder()
Local nColumnCount := Form_1.Grid_1.ColumnCOUNT
Local a := LISTVIEW_GETCOLUMNORDERARRAY (GetControlHandle ("Grid_1", "Form_1"), nColumnCount)
Local cMsg:="", nLen := Len( a )
aEval( a, {|x,i| cMsg := cMsg + "Column " + LTrim( Str ( x ) ) + If(i=nLen,""," + ") } )
MsgInfo(cMsg,"Columns Order")
Return Nil
Hi Dr. Soto,
In this fixed code demo when we Set New Columns Order grid's columns put in 3, 5, 4, 2, 1 order as defined in SetOrder() function. This function uses C ListView_SetColumnOrderArray function which set order in grid but seems not take duly effects when we push columns data doing by this way. IMHO this example should use this _GridEx_SetColumnDisplayPosition in place of that. Then I suppose to correct this problem, doesn't it ?
Would you tell use how is the right use of _GridEx_SetColumnDisplayPosition ?
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
- srvet_claudio
- Posts: 2193
- Joined: Thu Feb 25, 2010 8:43 pm
- Location: Uruguay
- Contact:
Re: Fixed and enhanced SAMPLES
See viewtopic.php?f=43&t=3019&p=27352#p27352Pablo César wrote:Hi all,
This C:\hmg.3.4.0\SAMPLES\Advanced\GRID_SORT is not compiling and some errors were fixed as follows:
- Removed Memvar fColor at begining of code, because was causing an error during compiling:
MEMVAR declaration follows executable statement- GetOrder function been enhanced showing in one MsgInfo with result concatenated
- Mistake usage in C ListView_GetColumnOrderArray function with wrong 3rd parameter and
Keeping you actualized with right demo in our SAMPLES !Code: Select all
/* * HMG Grid Demo * (c) 2005 Roberto Lopez * * ListView SORT ORDER COLUMN * Author: BADIK <badik@mail.ru> * * Fixed and enhanced by Pablo César Arrascaeta * On February, 2015 */ #include "hmg.ch" // Memvar fColor // Error during compiling: MEMVAR declaration follows executable statement Function Main() Local aRows [20] [3] Private fColor := { || if ( This.CellRowIndex/2 == int(This.CellRowIndex/2) , { 0,0,255 } , { 0,255,0 } ) } DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 640 ; HEIGHT 400 ; TITLE 'Mixed Data Type Grid Test' ; MAIN DEFINE MAIN MENU DEFINE POPUP 'File' MENUITEM 'Set New Columns Order' ACTION SetOrder() MENUITEM 'Get Columns Order' ACTION GetOrder() MENUITEM 'Refresh Grid' ACTION Form_1.Grid_1.Refresh SEPARATOR MENUITEM 'Exit' ACTION Form_1.Release END POPUP END MENU aRows [1] := { 113.12, date()-1, 1, 1, .t. } aRows [2] := { 123.12, date()-2, 2, 2, .f. } aRows [3] := { 133.12, date(), 3, 3, .t. } aRows [4] := { 143.12, date(), 1, 4, .f. } aRows [5] := { 153.12, date(), 2, 5, .t. } aRows [6] := { 163.12, date(), 3, 6, .f. } aRows [7] := { 173.12, date(), 1, 7, .t. } aRows [8] := { 183.12, date(), 2, 8, .f. } aRows [9] := { 193.12, date(), 3, 9, .t. } aRows [10] := { 113.12, date(), 1, 10, .f. } aRows [11] := { 123.12, date(), 2, 11, .t. } aRows [12] := { 133.12, date(), 3, 12, .f. } aRows [13] := { 143.12, date(), 1, 13, .t. } aRows [14] := { 153.12, date(), 2, 14, .f. } aRows [15] := { 163.12, date(), 3, 15, .t. } aRows [16] := { 173.12, date(), 1, 16, .f. } aRows [17] := { 183.12, date(), 2, 17, .t. } aRows [18] := { 193.12, date(), 3, 18, .f. } aRows [19] := { 113.12, date(), 1, 19, .t. } aRows [20] := { 123.12, date(), 2, 20, .f. } @ 10, 10 GRID Grid_1 ; WIDTH 620 ; HEIGHT 330 ; HEADERS {'Column 1','Column 2','Column 3','Column 4','Column 5'} ; WIDTHS {140,140,140,140,140} ; ITEMS aRows ; EDIT ; COLUMNCONTROLS { ; {'TEXTBOX', 'NUMERIC', '$ 999,999.99'}, ; {'DATEPICKER', 'DROPDOWN'}, ; {'COMBOBOX', {'One', 'Two', 'Three'}}, ; {'SPINNER', 1, 20 }, ; {'CHECKBOX', 'Yes', 'No' } } ; COLUMNWHEN { { || This.CellValue > 120 }, { || This.CellValue = Date() }, Nil, Nil, Nil } ; DYNAMICFORECOLOR { fColor , fColor, fColor, fColor, fColor } END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil Function SetOrder() Local aColumns := { 3, 5, 4, 2, 1 } _SetColumnOrderArray( "Grid_1", "Form_1", aColumns ) Form_1.Grid_1.Refresh Return Nil Function GetOrder() Local a := _GetColumnOrderArray( "Grid_1", "Form_1" ) Local cMsg:="", nLen := Len( a ) aEval( a, {|x,i| cMsg := cMsg + "Column " + LTrim( Str ( x ) ) + If(i=nLen,""," + ") } ) MsgInfo(cMsg,"Columns Order") Return Nil Function _GetColumnOrderArray( ControlName , ParentForm ) Local i := GetControlIndex( ControlName , ParentForm ) Local nColumn := Len(_HMG_SYSDATA [ 33 ] [i]) Local aSort := ListView_GetColumnOrderArray( _HMG_SYSDATA [ 3 ] [i], nColumn ) // aSort := Array(nColumn) // Not necessary // ListView_GetColumnOrderArray( _HMG_SYSDATA [ 3 ] [i], nColumn, @aSort ) // This C function accept only 2 parameters Return aSort Function _SetColumnOrderArray( ControlName , ParentForm, aSort ) Local i := GetControlIndex( ControlName , ParentForm ) Local nColumn := Len(_HMG_SYSDATA [ 33 ] [i]) ListView_SetColumnOrderArray( _HMG_SYSDATA [ 3 ] [i], nColumn, aSort ) Return Nil
Hi Dr. Soto,
In this fixed code demo when we Set New Columns Order grid's columns put in 3, 5, 4, 2, 1 order as defined in SetOrder() function. This function uses C ListView_SetColumnOrderArray function which set order in grid but seems not take duly effects when we push columns data doing by this way. IMHO this example should use this _GridEx_SetColumnDisplayPosition in place of that. Then I suppose to correct this problem, doesn't it ?
Would you tell use how is the right use of _GridEx_SetColumnDisplayPosition ?
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
Now I have duly managed the field edition at grid even SORT ORDER COLUMN have been applied.
Very easy, fast ans safe use of Get/Set ColumnDisplayPosition functions.
Thanks Claudio for your explaining.
Very easy, fast ans safe use of Get/Set ColumnDisplayPosition functions.
Thanks Claudio for your explaining.
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
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
DLLs files now we count with a new and enhanced own CallDLL function which it was confliting with Harbour's core function.
This new function HMG_CallDLL() detects the current code page and appropriately called the ANSI or Unicode version of the function.
So all DLLs samples demos should be updated with following:
C:\hmg.3.4.1\SAMPLES\Controls\DLL\DLL_1:Source code re-edicted message. Removed a optional 2nd parameter [nRetType].
C:\hmg.3.4.1\SAMPLES\Controls\DLL\DLL_2:
C:\hmg.3.4.1\SAMPLES\Controls\DLL\DLL_3:
Enjoy !
Keeping update samples.
This new function HMG_CallDLL() detects the current code page and appropriately called the ANSI or Unicode version of the function.
So all DLLs samples demos should be updated with following:
C:\hmg.3.4.1\SAMPLES\Controls\DLL\DLL_1:
Code: Select all
/*
* HMG DLL 1st Demo
* Enhanced HMG_CallDLL function by Dr. Claudio
* Re-edited demo by Pablo César
*/
#include "hmg.ch"
#include "hbdyn.ch"
Function Main
DEFINE WINDOW Win_1 ;
AT 0,0 ;
WIDTH 400 ;
HEIGHT 400 ;
TITLE 'Hello World!' ;
MAIN
DEFINE MAIN MENU
DEFINE POPUP 'Test'
MENUITEM 'Test' ACTION HMG_CallDLL ( "WINMM.DLL", , "sndPlaySound", "sample.wav", 0)
END POPUP
END MENU
END WINDOW
ACTIVATE WINDOW Win_1
Return Nil
C:\hmg.3.4.1\SAMPLES\Controls\DLL\DLL_2:
Code: Select all
/*
* HMG DLL 2nd Demo
* Enhanced HMG_CallDLL function by Dr. Claudio
* Re-edited demo by Pablo César
*/
#include "hmg.ch"
#include "hbdyn.ch"
Function Main
DEFINE WINDOW Win_1 ;
AT 0,0 ;
WIDTH 400 ;
HEIGHT 400 ;
TITLE 'Hello World!' ;
MAIN
DEFINE MAIN MENU
DEFINE POPUP 'Test'
MENUITEM 'Test' ACTION HMG_CallDLL ( "USER32.DLL", HB_DYN_CTYPE_INT, "SetWindowText", Win_1.HANDLE, "New title")
END POPUP
END MENU
END WINDOW
ACTIVATE WINDOW Win_1
Return Nil
Code: Select all
/*
* HMG DLL 3rd Demo
* Enhanced HMG_CallDLL function by Dr. Claudio
* Re-edited demo by Pablo César
*/
#include "hmg.ch"
#include "hbdyn.ch"
Function Main
Local cBuffer := Space (128)
DEFINE WINDOW Win_1 ;
AT 0,0 ;
WIDTH 400 ;
HEIGHT 400 ;
TITLE 'Hello World!' ;
MAIN
DEFINE MAIN MENU
DEFINE POPUP 'Test'
MENUITEM 'Test' ACTION ( HMG_CallDLL ( "USER32.DLL", HB_DYN_CTYPE_INT, "GetWindowText", Win_1.HANDLE, @cBuffer, 512), MsgInfo(cBuffer) )
END POPUP
END MENU
END WINDOW
ACTIVATE WINDOW Win_1
Return Nil
Keeping update samples.
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
-
- Posts: 44
- Joined: Fri Jun 20, 2014 8:41 pm
Re: Fixed and enhanced SAMPLES
Pablo,
Thanks for updating the samples!
Regards,
Jeff
Thanks for updating the samples!
Regards,
Jeff
- Pablo César
- Posts: 4059
- Joined: Wed Sep 08, 2010 1:18 pm
- Location: Curitiba - Brasil
Fixed and enhanced SAMPLES
You're welcome Jeff.
More informations about hbdyn, please make consultation at hmgdoc.
And please note Source code in first demo was re-edicted message. Removed a optional 2nd parameter [nRetType].
When not informed any nRetType value will assume the default HB_DYN_CTYPE_DEFAULT value (0x0000000).
More informations about hbdyn, please make consultation at hmgdoc.
And please note Source code in first demo was re-edicted message. Removed a optional 2nd parameter [nRetType].
When not informed any nRetType value will assume the default HB_DYN_CTYPE_DEFAULT value (0x0000000).
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
- Clip2Mania
- Posts: 99
- Joined: Fri Jun 13, 2014 7:16 am
- Location: Belgium
Re: Fixed and enhanced SAMPLES
Suggestion: The HMG_CallDLL() function is not yet included in the forum documentation hmgdoc/data/index.htm. the old CallDLL32 is still there.