How do i call a procedure

Topic Specific Tutorials and Tips.

Moderator: Rathinagiri

ROBROS
Posts: 60
Joined: Thu May 25, 2017 6:30 pm
DBs Used: DBF
Has thanked: 32 times
Been thanked: 1 time

Re: How do i call a procedure

Post by ROBROS » Tue Aug 08, 2017 6:03 pm

OK, I'll be back.

Robert

ROBROS
Posts: 60
Joined: Thu May 25, 2017 6:30 pm
DBs Used: DBF
Has thanked: 32 times
Been thanked: 1 time

Post by ROBROS » Tue Aug 08, 2017 6:38 pm

I have zipped 2 files: main. prg with all procedures and main.fmg, which is not used, it was created by choosing new project from the IDE.

Robert
Attachments
Main_prg.7z
(1.88 KiB) Downloaded 17 times

User avatar
serge_girard
Posts: 1832
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 273 times
Been thanked: 63 times
Contact:

Post by serge_girard » Wed Aug 09, 2017 5:03 am

Robert,

See this sample:

Code: Select all

#include "hmg.ch"




Function Main
/**************/
CLOSE ALL
SET DATE TO GERMAN
SET CENTURY ON

SET DATE FORMAT TO "DD.MM.YYYY"
SET TOOLTIPSTYLE BALLOON

cJahr    := "2017"
dDat     := date()
dDATE_1  := date() + 10

DEFINE WINDOW Win_1 ;
   AT 0,0 ;
   WIDTH 1200 ;
   HEIGHT 300 ;
   TITLE 'Fahrerspesen by RS 2017' ;
   MAIN

   DEFINE MAIN MENU
      DEFINE POPUP 'D&atei'   
         ITEM "E&nde" ACTION Win_1.Release
      END POPUP

      DEFINE POPUP 'D&aten'
         ITEM 'Tagesdaten bereitstellen' ACTION woche()
         ITEM 'Tagesdaten einlesen' ACTION filltag()
         ITEM 'Enter date' ACTION datum()
      END POPUP

      DEFINE POPUP 'F&ahrerstamm'
         ITEM 'Suchen' ACTION suchen()       
      END POPUP
      
   END MENU
 

   @ 80,10 DATEPICKER date_1 ;
      TOOLTIP 'Datum '	;
      SHOWNONE ;
      VALUE dDATE_1; 
      ON CHANGE fill_Label_date_1()

   @ 100,10 LABEL Label_date_1 ;
      VALUE "" ;
      WIDTH 175 ;
      HEIGHT 35 ;
      FONT 'Arial' SIZE 09 

END WINDOW

SetProperty('Win_1', 'date_1','Visible', .F.)
SetProperty('Win_1', 'Label_date_1','Visible', .F.)

ACTIVATE WINDOW Win_1

RETURN





FUNCTION datum()
/****************/
SetProperty('Win_1', 'date_1','Visible', .T.)
return





FUNCTION fill_Label_date_1()
/***************************/
SetProperty('Win_1', 'date_1','Visible', .F.)
SetProperty('Win_1', 'Label_date_1','Visible', .T.)
SetProperty('Win_1', 'Label_date_1','Value', dtoc(GetProperty('Win_1', 'date_1','Value')))
dDATE_1 := GetProperty('Win_1', 'date_1','Value')
MSGINFO(dDATE_1)
SetProperty('Win_1', 'Label_date_1','Visible', .F.)
RETURN




FUNCTION woche()
/****************/
// YOU CAN USE DATE ALS HERE: 
dDATE_1 := GetProperty('Win_1', 'date_1','Value')

close all
nCnt:=0
use wochesdf exclusive
zap

append from woche.prn sdf
delete for empty(line) .or. substr(line,1,4)="Mita"
pack

use woche
zap
close all
use woche alias wo new exclusive		
use wochesdf alias wosdf new

select wosdf
go top
do while !eof()
   select wo
   dbappend()
   replace persnr with substr(wosdf->line,1,4),;
           zeit   with substr(wosdf->line,119,5),;
           koge   with substr(wosdf->line,125,5),;
           kza    with substr(wosdf->line,135,1),;
           datum  with ctod(substr(wosdf->line,110,6)+cJahr)
   nCnt++
   select wosdf
   skip
enddo
MsgInfo(ltrim(str(ncnt))+ " records aufbereitet")		
nCnt:=0
CLOSE ALL
Return





procedure filltag
/****************/
// YOU CAN USE DATE ALS HERE: 
dDATE_1 := GetProperty('Win_1', 'date_1','Value')


close all

cFehler:="N"
//dDatum:=ctod("")
dDat:=ctod("")
cPersnr:=space(4)
set cursor on
set confirm on
cName:=space(30)
cName1:=space(30)


use spesen alias spesen new
index on datum to datum


use woche alias woche new
go top

dDat:=woche->datum
select spesen
seek dDat
if found()
   MsgInfo(dtoc(dDat)+" bereits verarbeitet")
   return
endif


close all

use woche alias woche new
go top




astruct:={{"PERSNR","C",4,0},{"DATUM","D",8,0},{"KOMMT","C",5,0},{"GEHT","C",5,0},{"KZA","C",5,0}}
dbcreate("SPESENA",astruct,"dbfntx")
use spesena alias spa exclusive new

use bbpers alias pers new
index on persnr to persnr



select woche

do while !eof()
   if !empty(woche->persnr)
      cPersnr=woche->persnr
   endif
   select pers
   seek cPersnr
//   if found()
      do dazu
//   endif
   select woche
   skip
enddo

do fillspes





astruct:={{"DATUM","D",8,0},{"PERSNR","C",4,0},{"GRUND","C",30,0},{"KOMMT","C",5,0},{"GEHT","C",5,0}}
dbcreate("FEHLER",astruct,"dbfntx")
use FEHLER alias FEHLER exclusive new


use bbpers alias pers new
index on persnr to persnr
select spesen
dDat:=spesen->datum
//?dDat,spesen->datum
//wait
go top
do while !eof()
   if empty(spesen->kommt) .or. empty(spesen->geht)
      cName:="Zeitangabe fehlt"
      select fehler
	   dbappend()
	   replace persnr with spesen->persnr,kommt with spesen->kommt,geht with spesen->geht,datum with spesen->datum,grund with cName
      cFehler:="J"
   endif
   select spesen
   skip
enddo

if cFehler="J"
   select spesen
   delete for datum=dDat
   pack
   MsgInfo(dtoc(dDat)+" nicht gespeichert,siehe Tabelle Fehler")
else
   MsgInfo(dtoc(dDat)+" Daten eingelesen")   
endif


return





procedure dazu
/****************/
// YOU CAN USE DATE ALS HERE: 
dDATE_1 := GetProperty('Win_1', 'date_1','Value')


select spa
dbappend()
replace persnr with cPersnr,datum with woche->datum,kza with woche->kza
if woche->koge="Kommt"
   replace kommt with woche->zeit
else
   replace geht with woche->zeit
endif   
RETURN






PROCEDURE fillspes
/****************/
// YOU CAN USE DATE ALS HERE: 
dDATE_1 := GetProperty('Win_1', 'date_1','Value')



use woche exclusive
delete for empty(koge)
pack
close all

dDatum:=ctod("")
cPersnr:=space(4)
set cursor on
set confirm on

//Tagesdaten in Spesendatei einlesen

use spesen alias spesen exclusive new


use spesena alias spa new

select spa

do while !eof()
   if !empty(spa->kommt)
      select spesen
      dbappend()
	   replace persnr with spa->persnr,datum with spa->datum,kommt with spa->kommt,kza with spa->kza
      select spa
	   skip // IS THIS CORRECT? WHAT ABOUT EOF() BY NEXT SKIP?
	   select spesen
      replace geht with spa->geht	  
   endif


   select spa
   skip
enddo

return

procedure suchen
/****************/
// YOU CAN USE DATE ALS HERE: 
dDATE_1 := GetProperty('Win_1', 'date_1','Value')

return

The DATEPICKER is now defined in the WINDOW and when needed it is set to Visible (that's the way I useually do it)
Label LABEL Label_date_1 is not needed but it shows the content of the DATEPICKER (ONLY on CHANGE!)

Hope this helps!

Serge

ROBROS
Posts: 60
Joined: Thu May 25, 2017 6:30 pm
DBs Used: DBF
Has thanked: 32 times
Been thanked: 1 time

Post by ROBROS » Wed Aug 09, 2017 6:11 am

Good Morning Serge,

I really appreciate your help, I just compiled it, it does exactly what it should an what you predicted, and thanks to your extended effort at such an early time of day , now I have a template that can be used in further apps.

Thank you so much.

Robert

User avatar
serge_girard
Posts: 1832
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 273 times
Been thanked: 63 times
Contact:

Post by serge_girard » Wed Aug 09, 2017 7:09 am

You're welcome!

Normally I get up a bit later but today I have a visit coming: my grandchild

Serge

User avatar
esgici
Posts: 4332
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Has thanked: 221 times
Been thanked: 76 times
Contact:

Post by esgici » Wed Aug 09, 2017 9:33 am

serge_girard wrote:
Wed Aug 09, 2017 7:09 am
... today I have a visit coming: my grandchild
Congrats :)

IMO a grandchild is one of most happiness of the world

How many grandchild you have ( I have six )?

I wish you endless happiness together with your loved ones and your loved ones :D
Viva INTERNATIONAL HMG :D

User avatar
serge_girard
Posts: 1832
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 273 times
Been thanked: 63 times
Contact:

Post by serge_girard » Wed Aug 09, 2017 11:33 am

Hi Esgici !

I have 4 children and 2 grandchildren. Ages 15 and 18 months, so both very little. I adore both and indeed one of most happiness of the world .
I actually have them each wednesday (now sleeping, so a minute free time!)

Serge

ROBROS
Posts: 60
Joined: Thu May 25, 2017 6:30 pm
DBs Used: DBF
Has thanked: 32 times
Been thanked: 1 time

Post by ROBROS » Wed Aug 09, 2017 11:39 am

Hi Serge,

enjoy the free time!

I also have 3 grandchildren
one aged 15 years, the next 2 and a half, and little Anna is 4 months old.

Robert
Last edited by ROBROS on Wed Aug 09, 2017 11:54 am, edited 1 time in total.

User avatar
serge_girard
Posts: 1832
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 273 times
Been thanked: 63 times
Contact:

Post by serge_girard » Wed Aug 09, 2017 11:43 am

Granddaddys all together!

Serge

ROBROS
Posts: 60
Joined: Thu May 25, 2017 6:30 pm
DBs Used: DBF
Has thanked: 32 times
Been thanked: 1 time

Post by ROBROS » Sun Aug 20, 2017 10:46 pm

Hi to all,

I'm just playing around with the windows of HMG, I got a lot of help from you (especially from Serge) Thank You again.

The following code shows how I call a second window via function win2(). Now I intend to split my yet to be programmed functions in their "own" windows. Are there any drawbacks doing this? The reason why I did so is to avoid to Define win_2 repeatedly and thus getting an error.

I would be glad to hear what you think about that.


#include "hmg.ch"


Function Main
/**************/
CLOSE ALL
SET DATE TO GERMAN
SET CENTURY ON

SET DATE FORMAT TO "DD.MM.YYYY"
SET TOOLTIPSTYLE BALLOON

cJahr := "2017"
dDATE_1 := date()
dDate_2 := date() + 10

DEFINE WINDOW Win_1 ;
AT 0,0 ;
WIDTH 1200 ;
HEIGHT 800 ;
TITLE 'Fahrerspesen by RS 2017' ;
MAIN

DEFINE MAIN MENU
DEFINE POPUP 'D&atei'
ITEM "E&nde" ACTION Win_1.Release
END POPUP

DEFINE POPUP 'WINDOW 2'
ITEM '2. WINDOW' ACTION win2()
END POPUP
END MENU

END WINDOW
ACTIVATE WINDOW Win_1

RETURN

function win2()
if !IsWindowActive(win_2)
DEFINE WINDOW Win_2 ;
windowtype child;
AT 100,100 ;
WIDTH 800 ;
HEIGHT 400 ;
TITLE 'Test 2. WINDOW'
END WINDOW
ACTIVATE WINDOW Win_2
else
MsgInfo('2. WINDOW already active')
endif
return nil

Post Reply