Fixed and enhanced SAMPLES

HMG Samples and Enhancements

Moderator: Rathinagiri

Post Reply
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 »

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.
Screen2.png
Screen2.png (14.34 KiB) Viewed 9844 times
Screen1.png
Screen1.png (11.37 KiB) Viewed 9844 times
Following are attached source files:
MULTIPRG.rar
(5.85 KiB) Downloaded 390 times
I hope you enjoy it ! :D
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil

SAMPLES corrections

Post by Pablo César »

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:
Tela03.png
Tela03.png (15.18 KiB) Viewed 9832 times
Source code was aligned (indented) as follows:

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
Rgds
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
User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil

SAMPLES corrections

Post by Pablo César »

Hi HMGians,

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
This a simple test interacting between two modes.
Screen1.png
Screen1.png (255.17 KiB) Viewed 9819 times
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 ! :D
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
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 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

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
Keeping you actualized with right demo in our SAMPLES ! :D

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.
Screen1.png
Screen1.png (25.11 KiB) Viewed 9762 times
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
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: Fixed and enhanced SAMPLES

Post by srvet_claudio »

Pablo 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

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
Keeping you actualized with right demo in our SAMPLES ! :D

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.
Screen1.png
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 ?
See viewtopic.php?f=43&t=3019&p=27352#p27352
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
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 »

Now I have duly managed the field edition at grid even SORT ORDER COLUMN have been applied.
Screen1.png
Screen1.png (23.92 KiB) Viewed 9724 times
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
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 »

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:

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
Source code re-edicted message. Removed a optional 2nd parameter [nRetType].

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
C:\hmg.3.4.1\SAMPLES\Controls\DLL\DLL_3:

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
Enjoy !

Keeping update samples. :D
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
Jeff Stone
Posts: 44
Joined: Fri Jun 20, 2014 8:41 pm

Re: Fixed and enhanced SAMPLES

Post by Jeff Stone »

Pablo,

Thanks for updating the samples!

Regards,

Jeff
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 »

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).
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
Clip2Mania
Posts: 99
Joined: Fri Jun 13, 2014 7:16 am
Location: Belgium

Re: Fixed and enhanced SAMPLES

Post by Clip2Mania »

Suggestion: The HMG_CallDLL() function is not yet included in the forum documentation hmgdoc/data/index.htm. the old CallDLL32 is still there.
Post Reply