Exit of the cycle DO WHILE on button pressing in a cycle

[Eugene Lutsenko]

Prompt how to make, please, an exit of the cycle DO WHILE on button pressing in a cycle (it is very desirable with a program example)

[reganc]

Hi Eugene

Take a look at dc_completeevents(). It basically starts up an event loop that exits when there are no more events to be processed.

I don't have time to create you a sample, sorry.

You would call this in your loop. Your button could then set a variable to something (a TRUE or FALSE perhaps) that would be tested after and exit the loop as required.

[Eugene Lutsenko]

I thank for council. I will come home from work and at once I will try.

I understood that it is necessary to establish value of the variable as processing of pressing of the button, defining to proceed to a cycle or not. But at me it did not turn out to transfer this value from function of processing of pressing of a key in a cycle.

[Tom]

As I understand it, you have a dialog and something started from there, like a printout or what. Now, the user presses "abort" in the dialog, but since the printing loop is running, the dialog does not react. Am I right?

What you have to do is to start printing (in this example) in a new thread and disable all dialog items in the dialog, except the "abort"-button. Starting the printout may set a var like "lPrintingRuns", all dialog elements reflect this in their WHEN-clauses. Only the "abort"-button sets another var "lAbort" to .T. (or a function value, like shown below) - and the print loop reflects this var (or the value of a get/set-function). Like:

Code: Select all

DO WHILE !Eof() .and. ContinuePrinting()
  * print
  DbSkip(1)
ENDDO

The "abort"-button calls "ContinuePrinting(.F.)", so sets a STATIC var in there. All other dialog elements are disable. Printing must run in a separate thread for this:

Code: Select all

FUNCTION ContinuePrinting(lContinue)
STATIC lGoOn := .T.
IF PCount() = 1
  lGoOn := lContinue
ENDIF
RETURN lGoOn

[Eugene Lutsenko]

I have a cycle in which I set parameters in dialogue and receive results of calculation which I bring in a database and I display in the form of the table. If these results are unacceptable, the user should have possibility to repeat input of parameters and to see turning-out result (that is without an exit from цкла). If result устривает the user, he has to have exit possibility from a cycle of a task or selection of parameters.

Code: Select all

M_Exit = .T.

DO WHILE M_Exit

   @10,  0 DCGROUP oGroup6 CAPTION 'Задайте СУММАРНОЕ количество градаций в шкалах:' SIZE 70,3.5
   IF K_N_KlSh > 0    && Кол-во числовых  классификационных шкал
      @ 1,  2 DCSAY "В классификационных шкалах:" PARENT oGroup6;@1,mPosGet DCSAY "" GET N_SKGrKl PARENT oGroup6 PICTURE "#####"
   ENDIF
   IF K_N_OpSh > 0    && Кол-во числовых  описательных      шкал
      @ 2,  2 DCSAY "В описательных      шкалах:" PARENT oGroup6;@2,mPosGet DCSAY "" GET N_SKGrPr PARENT oGroup6 PICTURE "#####"
   ENDIF

*   N_SKGrKl = IF(N_SKGrKl <= 4000, N_SKGrKl, 4000)
*   N_SKGrPr = IF(N_SKGrPr <= 4000, N_SKGrPr, 4000)

   * 0 - выход из цикла задания размерности модели

   K_N_GrKlSh =  N_SKGrKl - K_C_GrKlSh
   K_N_GrOpSh =  N_SKGrPr - K_C_GrOpSh

   ********** Если нет шкал, то нет и градаций:
   K_N_GrKlSh = IF(K_N_KlSh=0,0,K_N_GrKlSh)
   K_N_GrOpSh = IF(K_N_OpSh=0,0,K_N_GrOpSh)
   K_C_GrKlSh = IF(K_C_KlSh=0,0,K_C_GrKlSh)
   K_C_GrOpSh = IF(K_C_OpSh=0,0,K_C_GrOpSh)

   *   СУММАРНОЕ КОЛИЧЕСТВО ШКАЛ И ГРАДАЦИЙ СИМ(кл/пр):####### x #######"
   *   ╔═══════════╦═════════════════════════╦═════════════════════════╗"
   *   ║           ║    Классификационные    ║      Описательные       ║"
   *   ║           ╟────────┬────────┬───────╫────────┬────────┬───────╢"
   *   ║           ║  Шкалы │Градации│ Гр/шк ║  Шкалы │Градации│ Гр/шк ║"
   *   ╠═══════════╬════════╪════════╪═══════╬════════╪════════╪═══════╣"
   * 1 ║ Числовые  ║    2   │    3   │   4   ║    5   │    6   │   7   ║"
   *   ╟───────────╫────────┼────────┼───────╫────────┼────────┼───────╢"
   * 2 ║ Текстовые ║    2   │    3   │   4   ║    5   │    6   │   7   ║"
   *   ╠═══════════╬════════╪════════╪═══════╬════════╪════════╪═══════╣"
   * 3 ║ ВСЕГО:    ║    2   │    3   │   4   ║    5   │    6   │   7   ║"
   *   ╚═══════════╩════════╧════════╧═══════╩════════╧════════╧═══════╝"

   SELECT ScaleALL

   // Классификационные шкалы

   DBGOTO(1);FIELDPUT( 2, K_N_KlSh )                         // Кол-во числовых  классификационных шкал
   DBGOTO(2);FIELDPUT( 2, K_C_KlSh )                         // Кол-во текстовых классификационных шкал
   DBGOTO(3);FIELDPUT( 2, K_N_KlSh+K_C_KlSh )                // Суммарное кол-во классификационных шкал

   DBGOTO(1);FIELDPUT( 3, K_N_GrKlSh )                       // Суммарное кол-во градаций числовых  клас.шкал
   DBGOTO(2);FIELDPUT( 3, K_C_GrKlSh )                       // Суммарное кол-во градаций текстовых клас.шкал
   DBGOTO(3);FIELDPUT( 3, K_N_GrKlSh+K_C_GrKlSh )            // Суммарное кол-во градаций числ.и текст.клас.шкал

   DBGOTO(1);FIELDPUT( 4, INT(K_N_GrKlSh/K_N_KlSh) )         // Среднее кол-во градаций в числовых  классификационных шкалах
   DBGOTO(2);FIELDPUT( 4, INT(K_C_GrKlSh/K_C_KlSh) )         // Среднее кол-во градаций в текстовых классификационных шкалах
   Mv = INT((K_N_GrKlSh+K_C_GrKlSh)/(K_N_KlSh+K_C_KlSh))
   DBGOTO(3);FIELDPUT( 4, Mv )                               // Среднее кол-во градаций в числ.и текст.клас.шкалах

   // Описательные шкалы

   DBGOTO(1);FIELDPUT( 5, K_N_OpSh )                         // Кол-во числовых  описательных шкал
   DBGOTO(2);FIELDPUT( 5, K_C_OpSh )                         // Кол-во текстовых описательных шкал
   DBGOTO(3);FIELDPUT( 5, K_N_OpSh+K_C_OpSh )                // Суммарное кол-во описательных шкал

   DBGOTO(1);FIELDPUT( 6, K_N_GrOpSh )                       // Суммарное кол-во градаций числовых  клас.шкал
   DBGOTO(2);FIELDPUT( 6, K_C_GrOpSh )                       // Суммарное кол-во градаций текстовых клас.шкал
   DBGOTO(3);FIELDPUT( 6, K_N_GrOpSh+K_C_GrOpSh )            // Суммарное кол-во градаций числ.и текст.опис.шкал

   DBGOTO(1);FIELDPUT( 7, INT(K_N_GrOpSh/K_N_OpSh) )         // Среднее кол-во градаций в числовых  описательных шкалах
   DBGOTO(2);FIELDPUT( 7, INT(K_C_GrOpSh/K_C_OpSh) )         // Среднее кол-во градаций в текстовых описательных шкалах
   Mv = INT((K_N_GrOpSh+K_C_GrOpSh)/(K_N_OpSh+K_C_OpSh))
   DBGOTO(3);FIELDPUT( 7, Mv )                               // Среднее кол-во градаций в числ.и текст.опис.шкалах                          

   Flag_err = .F.
   IF K_N_KlSh > 0 .AND. K_N_GrKlSh <= 0 .OR.;
      K_C_KlSh > 0 .AND. K_C_GrKlSh <= 0
      M_Exit = 1
      Flag_err = .T.
*     Mess3 = "Задайте больше классификационных шкал !!!"
*     @24,40-LEN(Mess3)/2 DCSAY Mess3
*     INKEY(0)
   ENDIF
   IF K_N_OpSh > 0 .AND. K_N_GrOpSh <= 0 .OR.;
      K_C_OpSh > 0 .AND. K_C_GrOpSh <= 0
      M_Exit = 1
      Flag_err = .T.
*     Mess3 = "Задайте больше описательных шкал !!!"
*     @24,40-LEN(Mess3)/2 DCSAY Mess3 COLOR "w+/rb"
*     INKEY(0)
   ENDIF

   ** K_N_KlSh     // Кол-во числовых  классификационных шкал
   ** K_C_KlSh     // Кол-во текстовых классификационных шкал
   IF K_N_KlSh + K_C_KlSh <= 0
      M_Exit = 1
      Flag_err = .T.
      Mess3 = "Нет классификационных шкал!!! Для продолжения нажмите какую-нибудь клавишу"
   ENDIF
   ** K_N_OpSh     // Кол-во числовых  описательных      шкал
   ** K_C_OpSh     // Кол-во текстовых описательных      шкал
   IF K_N_OpSh + K_C_OpSh <= 0
      M_Exit = 1
      Flag_err = .T.
      Mess3 = "Нет описательных шкал!!! Для продолжения нажмите какую-нибудь клавишу"
   ENDIF
   ** K_N_GrKlSh   // Суммарное кол-во градаций числовых  классификационных шкал
   ** K_C_GrKlSh   // Суммарное кол-во градаций текстовых классификационных шкал
   IF K_N_GrKlSh + K_C_GrKlSh <= 0
      M_Exit = 1
      Flag_err = .T.
      Mess3 = "Нет градаций классификационных шкал!!! Для продолжения нажмите клавишу"
   ENDIF
   ** K_N_GrOpSh   // Суммарное кол-во градаций числовых  описательных шкал
   ** K_C_GrOpSh   // Суммарное кол-во градаций текстовых описательных шкал
   IF K_N_GrOpSh + K_C_GrOpSh <= 0
      M_Exit = 1
      Flag_err = .T.
      Mess3 = "Нет градаций описательных шкал!!! Для продолжения нажмите какую-нибудь клавишу"
   ENDIF

   /* ----- Create browse ----- */

   *   СУММАРНОЕ КОЛИЧЕСТВО ШКАЛ И ГРАДАЦИЙ СИМ(кл/пр):####### x #######"
   *   ╔═══════════╦═════════════════════════╦═════════════════════════╗"
   *   ║           ║    Классификационные    ║      Описательные       ║"
   *   ║           ╟────────┬────────┬───────╫────────┬────────┬───────╢"
   *   ║           ║  Шкалы │Градации│ Гр/шк ║  Шкалы │Градации│ Гр/шк ║"
   *   ╠═══════════╬════════╪════════╪═══════╬════════╪════════╪═══════╣"
   * 1 ║ Числовые  ║    2   │    3   │   4   ║    5   │    6   │   7   ║"
   *   ╟───────────╫────────┼────────┼───────╫────────┼────────┼───────╢"
   * 2 ║ Текстовые ║    2   │    3   │   4   ║    5   │    6   │   7   ║"
   *   ╠═══════════╬════════╪════════╪═══════╬════════╪════════╪═══════╣"
   * 3 ║ ВСЕГО:    ║    2   │    3   │   4   ║    5   │    6   │   7   ║"
   *   ╚═══════════╩════════╧════════╧═══════╩════════╧════════╧═══════╝"
   aStructure := { { "Data_Type" , "C",  9, 0 }, ;
                   { "Cl_Scale"  , "N",  7, 0 }, ;
                   { "GrCl_Scal" , "N",  7, 0 }, ;
                   { "Gr_ClSc"   , "N",  7, 2 }, ;
                   { "Op_Scale"  , "N",  7, 0 }, ;
                   { "GrOp_Scal" , "N",  7, 0 }, ;
                   { "Gr_OpSc"   , "N",  7, 2 }  }

   SELECT ScaleALL
   DBGOTOP()

   @ 14, 0 DCPUSHBUTTON CAPTION 'Пересчитать шкалы и градации' SIZE 27, 1 ACTION {||M_Exit = .T.} 
   @ 14,30 DCPUSHBUTTON CAPTION 'Выход на начало ввода данных' SIZE 27, 1 ACTION {||M_Exit = .F.} 

   IF K_N_KlSh + K_N_OpSh > 0
      @0,0 DCSAY "ЗАДАНИЕ В ДИАЛОГЕ РАЗМЕРНОСТИ МОДЕЛИ"
   ELSE
      @0,0 DCSAY "ИНФОРМАЦИЯ О РАЗМЕРНОСТИ МОДЕЛИ"
   ENDIF
   

   // Отобразить тип шкал: класс.или опис. и размерность модели

   @2, 0  DCBROWSE oBrowse ALIAS 'ScaleALL' SIZE 70,7.1 ;
          PRESENTATION DC_BrowPres() ;     // Только просмотр БД
          HEADLINES 4                ;     // Кол-во строк в заголовке
          NOHSCROLL NOVSCROLL              // Убрать горизонтальную и вертикальную полосы прокрутки

   DCBROWSECOL FIELD ScaleALL->Data_Type HEADER "Тип шкалы"                       PARENT oBrowse WIDTH 7 
   DCBROWSECOL FIELD ScaleALL->Cl_Scale  HEADER "Кол-во;класс.;шкал"              PARENT oBrowse WIDTH 5
   DCBROWSECOL FIELD ScaleALL->GrCl_Scal HEADER "Кол-во;градаций;класс.;шкал"     PARENT oBrowse WIDTH 5
   DCBROWSECOL FIELD ScaleALL->Gr_ClSc   HEADER "Средн.;кол-во;градаций;на шкалу" PARENT oBrowse WIDTH 5
   DCBROWSECOL FIELD ScaleALL->Op_Scale  HEADER "Кол-во;опис.;шкал"               PARENT oBrowse WIDTH 5
   DCBROWSECOL FIELD ScaleALL->GrOp_Scal HEADER "Кол-во;градаций;опис.;шкал"      PARENT oBrowse WIDTH 5
   DCBROWSECOL FIELD ScaleALL->Gr_OpSc   HEADER "Средн.;кол-во;градаций;на шкалу" PARENT oBrowse WIDTH 5

   DCGETOPTIONS TABSTOP

   DCREAD GUI ;
      OPTIONS GetOptions ;
      MODAL ;
      TITLE '2.3.2.2. Задание размерности модели системы "ЭЙДОС-X++"';
      FIT ;
      CLEAREVENTS

ENDDO

The provided program doesn't leave a cycle of selection of parameters. With function I too tried, set in it the necessary value of a variable цткла and returned it, but it too didn't work. Probably it is necessary to organize somehow it, and then to update in a cycle, but how?

[rdonnay]

Here is the sample you wanted:

Code: Select all

#INCLUDE "dcdialog.CH"

FUNCTION Main()

LOCAL GetList[0], lProcessing := .f., oStatus

@ 0,0 DCPUSHBUTTON CAPTION 'Start Process' SIZE 20,1.5 ;
      ACTION {||ProcessLoop(@lProcessing,GetList,oStatus)} ;
      WHEN {||!lProcessing}

@ 2,0 DCPUSHBUTTON CAPTION 'End Process' SIZE 20,1.5 ;
      ACTION {||lProcessing := .f.} ;
      WHEN {||lProcessing}

@ 4,0 DCSAY '' SAYSIZE 20 COLOR GRA_CLR_BLUE FONT '10.Arial Bold' OBJECT oStatus

DCREAD GUI FIT TITLE 'Processing Test'

* ---------------

STATIC FUNCTION ProcessLoop( lProcessing, GetList, oStatus )

LOCAL nCount := 1

lProcessing := .t.
DC_GetRefresh(GetList)

oStatus:setColorFG(GRA_CLR_BLUE)

DO WHILE lProcessing

  DC_CompleteEvents()

  oStatus:setCaption('Work in progress ' + Alltrim(Str(nCount++)))
  Sleep(10)

ENDDO

oStatus:setColorFG(GRA_CLR_RED)
oStatus:setCaption('Process stopped!')

DC_GetRefresh(GetList)

RETURN nil

[Eugene Lutsenko]

Hello, Roger! Your example perfectly works and that I speak, you and perfectly know it. And I am very grateful to you for your support. But unfortunately slightly another is necessary to me.

If to take your example as a basis, whether that it is impossible to modify it as follows. You to these very much would help me. I tried to make itself, but at me it did not turn out yet.

-----------------------------------------------------------
At program start at once to begin process, which IN a cycle.

Let, for example, this process consists in summation 1 to some variable and a conclusion of its value to the screen. The initial value of a variable which is set to a cycle, is equal to zero.

This process should be executed ONCE and stop.

Here the user should have possibility to choose by means of buttons or process repetition, or an exit from a cycle.

If the user chooses repetition, the user should have possibility to set in dialogue other initial value of a variable. Then everything repeats since the beginning, but already with this new initial value of a variable.

If the user chooses an exit - there is an end of the program and a conclusion to the screen of final value of a variable.
-----------------------------------------------------------

PS Once again I want to express to you gratitude and gratitude for the rendered invaluable help. If it is honest, I haven't enough time since I conduct occupations at two universities water on 1.5, and in other on 0.5 rates, and still I still have a scientific magazine. Therefore, unfortunately, I can't give to development so much time, how many I would like. But when I am engaged in development I have a rest soul and I create a reserve for the future and prospect for teaching and scientific work.

Somebody can still will help from those who treats favourably my efforts and more than once responded on my requests

[Eugene Lutsenko]

Please!

[Cliff Wiernik]

Here is a program Roger suggested as I modified that allows processing within a loop but allows you to exit the loop and reenter the loop as needed in order to do editing, control items, etc.

This is what I do in an actual application

1. Build dialog for normal editing and but do not start event loop
2. Start the event loop manually
3. Do editing as normal
4. If I want to start automated processing:
a. exit out of the loop
b. start loop processing
c. If an exception detected, start event loop and when done editing exit loop
d. at conclusion of loop, reenter the loop
5. When done editing, exit out of loop and manually destroy dialog

There are other ways to handle things, like Roger suggested, if you want a loop to be running but have a button active to allow for early termination of the loop.

You can also work with multiple treads also. I do this often.

1. Thread 1, is the control thread with the button allowing you to exit out of the loop
2. Start the loop in thread 2 from a button in thread 2. Thread 2 references a pointer set in thread 1.
3. To exit the loop, click the button in thread 1 that sets the point to exit, thread 2 checks the exit status in each loop and exits when exit set.
4. Thread 2 closes upon exit status being set and you just have thread 1 running. Thread 1 cannot exit if thread 2 is active.

The code below is just the test code used to validate the concept of the actual cash receipt processing application I have. The same dialog allows manual or automated entry of cash receipt transactions.

Cliff.

Code: Select all

#INCLUDE "appevent.CH"

#define EDIT_RECORD xbeP_User+1

STATIC lContinut

FUNCTION Main()

LOCAL GetList[0], GetOptions, oDlg, lStatus := .t., nStatus

lcontinue := .T.


USE \exp\data\xtest

@ 0,0 DCSAY {||XTEST->city + ': ' + STR(XTEST->(recno()),4)} SIZE 30 SAYLEFTBOTTOM

@ 2,0 DCSAY 'Area Code' GET XTEST->areacode GETOBJECT oAreaCode ;
                 VALID {|o| iif(DC_ReadGuiLastKey(getlist) = xbeK_ENTER.OR.DC_ReadGuiLastKey(getlist)==xbeK_DOWN,PostAppEvent(xbeP_Keyboard,xbeK_PGDN,,o),nil) }
//               KEYBLOCK {|c,b,o| iif((c==xbeK_ENTER.OR.c==xbeK_DOWN), PostAppEvent(xbeP_Keyboard,xbeK_PGDN,,o),nil) }

@ 3,0 DCSAY 'Exchange' GET XTEST->exchange 
@ 5,0 DCSAY 'Number' GET XTEST->number GETOBJECT oNumber ACCELKEY {xbeK_PGDN}
@ 6,0 DCSAY 'Number2' GET XTEST->number 
@ 7,0 DCSAY 'Number3' GET XTEST->number 

@ 9,0 DCPUSHBUTTON CAPTION 'Done' SIZE 10,1.2 ;
      ACTION {|| lContinue := .F., DC_ReadGuiEvent(DCGUI_EXIT_ABORT,GetList)}

@ 9,12 DCPUSHBUTTON CAPTION 'Next' SIZE 10,1.2 ;
      ACTION {|| DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)}

@ 9,24 DCPUSHBUTTON CAPTION 'Post' SIZE 10,1.2 ;
       ACTION {|| Processing(Getlist) }

DCGETOPTIONS SAYWIDTH 100 SAYRIGHTBOTTOM
DCREAD GUI FIT TITLE 'Editing Data' EXIT SAVE PARENT @oDlg OPTIONS GetOptions 


SetAppFocus(oAreaCode)
lStatus := DC_ReadGuiEventLoop(Getlist)

wtf 'exit last time'
oDlg:destroy()

RETURN nil

* -----------

PROC appsys ; return

* -----------

STATIC FUNCTION Processing( GetList )


wtf 'start processing'
//USE \exp\data\xtest

DO WHILE !XTEST->(Eof())
wtf 'loop'
  SetAppFocus(oAreaCode)
  lStatus := DC_ReadGuiEventLoop(Getlist)

  IF !lContinue
wtf '!lcontinue and exit'
    EXIT
  ENDIF
  XTEST->(dbSkip())
  dc_GetRefresh(Getlist)

ENDDO


wtf 'exit processing'
lStatus := DC_ReadGuiEventLoop(Getlist)

RETURN nil

[rdonnay]

Cliff -

Please don't show this kind of code:

Code: Select all

dc_debugqout('exit processing')

This is easier to remember:

Code: Select all

wtf 'exit processing'

Roger