How to use max. processor capacity?

[Eddy Van Esch]

Hi all,
Since a few years I am working (on and off) on a program. It is a "universal" mathemathical program
to solve systems of linear and non-linear equations. I have worked on it in several programming
languages (QB, VB, XBasic, RapidQ, Euphoria and now PB).
You could say I use it as a testcase to evaluate different languages because such
a "universal" algorithm does not exist... But it is like searching for
a perpetuum mobile: you know it does not exist, but it is fun searching for it.. .
My current PB-version relies heavily on random searching and a 'downhill'-algorythm.
So, basically, what you need primarily is raw computing power...
When I'm testing or using the program, I let it run on the background for days or weeks....
When the program is started, it immediately starts calculating and keeps calculating
until it finds a satisfying solution (which could be forever...)

So my question is:
Since my program is continuously executing its calculating routine, I must insert
some "DIALOG DOEVENTS" statements in the various loops to prevent my display from freezing and to be able to
respond to occasional button clicks to change some parameters in my program. The problem is how many
of these statements do you use and where.
I tried inserting them in the loops that are executed most frequently. I noticed
however that my processor is using then only around 10% of its capacity, even when I am doing nothing
else on the computer!!
Last thing I tried was something like this:

DO
    INCR DoEventCounter
    IF DoEventCounter > 10 THEN DoEventCounter = 0 : DIALOG DOEVENTS
    ...
LOOP

This gives a higher processor performance, but it is a question of 'how high can the
DoEventCounter be..' for maximum performance.
I have a feeling that there must be a more efficient way to use the maximum of
(free?) processor capacity. Does anybody know a way?

I have included my source code for your information. Notice that this was my very first
PB program, so it most certainly is not an example of good programming I think.. I just
included it if you happened to be interested. In other cases, don't waste your time on it.
Kind regards
Eddy

' *************************************************************
'                    Minimiser V0.0
' Experimental program to (try to) solve systems of linear and
' non-linear equations.
' Eddy Van Esch  1997-2001
' *************************************************************
'
' *************************************************************
'       Code Generated by EZGUI Freeware Dialog Designer
' *************************************************************

#COMPILE EXE
#REGISTER ALL
#DIM ALL

 ' Remark out the Constants for Controls you Will use in your program !
 %NOANIMATE    = 1
 %NOBUTTON     = 1
 %NOCOMBO      = 1
 %NODRAGLIST   = 1
 %NOHEADER     = 1
 %NOIMAGELIST  = 1
 %NOLIST       = 1
 '    %NOLISTVIEW   = 1
 '    %NOSTATUSBAR  = 1
 '    %NOTABCONTROL = 1
 '    %NOTOOLBAR    = 1
 '    %NOTOOLTIPS   = 1
 %NOTRACKBAR   = 1
 '    %NOTREEVIEW   = 1
 '    %NOUPDOWN     = 1
''#INCLUDE "win32api.inc"   ' Must come first before other include files !
#INCLUDE "Win32api.inc"
#INCLUDE "commctrl.inc"  ' The Common Controls include file !
' *************************************************************

' *************************************************************
'              EZGUI Library Constants and Declares
' *************************************************************

DECLARE SUB EZLIB_InitFonts()
DECLARE SUB EZLIB_DeleteFonts()
DECLARE SUB EZLIB_FixSize(BYVAL hDlg&, BYVAL Style&, BYVAL HasMenu&)
DECLARE FUNCTION EZLIB_IsTooltip(BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION EZLIB_TooltipID(BYVAL lParam AS LONG) AS LONG
DECLARE SUB EZLIB_SetTooltipText(BYVAL lParam AS LONG, TipText$)
DECLARE FUNCTION EZLIB_IsTab(BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION EZLIB_TabID(BYVAL lParam AS LONG) AS LONG

DECLARE SUB EZLIB_DefColors()
DECLARE SUB EZLIB_DeleteBrushes()
DECLARE FUNCTION EZLIB_QBColor(N&) AS LONG
DECLARE SUB EZLIB_ShowControl(BYVAL hWnd&, BYVAL ID&, BYVAL SFlag&)

DECLARE CALLBACK FUNCTION CBF_EXITBUTTON()
DECLARE CALLBACK FUNCTION CBF_RESTARTCALCBUTT()
DECLARE CALLBACK FUNCTION CBF_BESTVARSLIST()
DECLARE CALLBACK FUNCTION CBF_MAXTXT()
DECLARE CALLBACK FUNCTION CBF_MINTXT()
DECLARE CALLBACK FUNCTION CBF_ITERATEBELOWTXT()
DECLARE CALLBACK FUNCTION CBF_ITERATECHECK()
DECLARE CALLBACK FUNCTION CBF_SAVEBUTTON()
DECLARE CALLBACK FUNCTION CBF_MAXERRTXT()
DECLARE CALLBACK FUNCTION CBF_RESETRESULTSBUTT()
DECLARE CALLBACK FUNCTION CBF_LOACCURACYTXT()
DECLARE CALLBACK FUNCTION CBF_HIACCURACYTXT()
DECLARE CALLBACK FUNCTION CBF_DISPLAYCHECK()

DECLARE SUB ShowDialog_MainForm(BYVAL hParent&)
DECLARE CALLBACK FUNCTION MainForm_DLGPROC

' *************************************************************
'              Application Constants and Declares
' *************************************************************

%ACTIONFRAME        = 100
%RESULTFRAME        = 105
%ITERATEFRAME       = 110
%LIMITSFRAME        = 115
%LOACCURACYLABEL    = 120
%HIACCURACYLABEL    = 125
%MAXERRLABEL        = 130
%MINITERATELABEL    = 135
%MINLABEL           = 140
%MAXLABEL           = 145
%TITLE              = 150
%ERRORTXT           = 155
%EXITBUTTON         = 160
%RESTARTCALCBUTT    = 165
%BESTVARSLIST       = 170
%MAXTXT             = 175
%MINTXT             = 180
%ITERATEBELOWTXT    = 185
%ITERATECHECK       = 190
%SAVEBUTTON         = 195
%MAXERRTXT          = 200
%RESETRESULTSBUTT   = 205
%LOACCURACYTXT      = 210
%HIACCURACYTXT      = 215
%DISPLAYCHECK       = 220
' --------------------------------------------------

' ------------------------------------------------
' (1) Put NEXT DIALOG Constant and Declare code after here :

' *************************************************************
'            Application Global Variables and Types
' *************************************************************
GLOBAL App_Brush&()
GLOBAL App_Color&()
GLOBAL App_Font&()
GLOBAL hMainForm&    ' Dialog handle

' (2) Application specific declarations
DECLARE SUB SaveResults()
DECLARE SUB RDResults()
DECLARE SUB ScanIncreasing()
DECLARE SUB ShowBest()
DECLARE SUB PresetParameters()
DECLARE SUB DoelFunc()

GLOBAL conVgls          AS LONG
GLOBAL conVars          AS LONG
GLOBAL conLargest       AS DOUBLE
GLOBAL fout             AS DOUBLE
GLOBAL DeltaQ           AS DOUBLE
GLOBAL maxErr           AS DOUBLE
GLOBAL qMax             AS DOUBLE
GLOBAL qMin             AS DOUBLE
GLOBAL best             AS DOUBLE
GLOBAL dblMaxStartFout  AS DOUBLE
GLOBAL sign             AS DOUBLE
GLOBAL SaveCounter      AS LONG
GLOBAL resultFile       AS STRING
GLOBAL fn               AS LONG
GLOBAL tel              AS LONG
GLOBAL BetterFound      AS LONG
GLOBAL ScanStop         AS LONG
GLOBAL ProgStop         AS LONG
GLOBAL Accuracy         AS DOUBLE
GLOBAL LoAccuracy       AS DOUBLE
GLOBAL MidAccuracy      AS DOUBLE
GLOBAL HiAccuracy       AS DOUBLE
GLOBAL ErrorTxtColor    AS LONG
GLOBAL IterateFlag      AS LONG
GLOBAL DisplayFlag      AS LONG
GLOBAL ActionRequest    AS LONG
GLOBAL Flag_ScanBusy    AS LONG    'Flag if scanning is still busy or not
%REQ_SCAN       = 1 'Request to start (new) scan
%REQ_SAVE       = 2 'Request to save results
%REQ_RESETRES   = 3 'Request to reset results

' *************************************************************
'                    Application Entrance
' *************************************************************

FUNCTION PBMAIN
    conVars = 8
    conVgls = 8
    DIM q(conVars) AS GLOBAL DOUBLE, qf(conVgls) AS GLOBAL DOUBLE, PrevDeltaQ(conVars) AS GLOBAL DOUBLE
    DIM qBest(conVars) AS GLOBAL DOUBLE, dblLastDeltaQ(conVars) AS GLOBAL DOUBLE
    LOCAL i AS LONG, qRange AS DOUBLE
    RANDOMIZE TIMER
    resultFile      ="c:/Minimise.txt"
    ScanStop        =%FALSE
    ProgStop        =%FALSE
    maxErr          =1
    qMin            =-10000
    qMax            = 10000
    LoAccuracy      =10000000000
    HiAccuracy      =1
    conLargest      =1e300
    dblMaxStartFout = 1e6
    IterateFlag     =%TRUE
    DisplayFlag     =%TRUE
    fout            =conLargest
    ErrorTxtColor   =26
    best            =conLargest
    tel             =0
    SaveCounter     =0
    FOR i = 1 TO conVars
        q(i)=1
        qBest(i)=1
    NEXT
    CALL RDResults()

    LOCAL Count&
    LOCAL CC1 AS INIT_COMMON_CONTROLSEX
    CC1.dwSize=SIZEOF(CC1)
    CC1.dwICC=%ICC_WIN95_CLASSES
    InitCommonControlsEx CC1
    EZLIB_DefColors
    EZLIB_InitFonts

    ShowDialog_MainForm 0
    SLEEP 3000  'To build GUI
    PresetParameters
    ActionRequest = %REQ_SCAN   'Request to start scan
    DO
        DIALOG DOEVENTS TO Count&
        SELECT CASE ActionRequest
            CASE %REQ_SCAN
                CONTROL SET TEXT hMainForm&,  %ERRORTXT, "------------" 'Indicate new scan
                SLEEP 500   'Wait a short time to show "-------"
                ActionRequest = 0   'Reset action request
                ScanStop = %FALSE
                ScanIncreasing
            CASE %REQ_SAVE
                ActionRequest = 0   'Reset action request
                SaveResults
                ScanStop = %FALSE
                ScanIncreasing
            CASE %REQ_RESETRES
                ActionRequest = 0   'Reset action request
                ScanStop = %FALSE
                best = conLargest
                qRange = qMax - qMin
                FOR i = 1 TO conVars
                    qBest(i) = qMin + RND * qRange
                NEXT
                ShowBest
                ScanIncreasing
        END SELECT
    LOOP UNTIL Count&=0 OR ProgStop

    EZLIB_DeleteBrushes
    EZLIB_DeleteFonts
END FUNCTION


' *************************************************************
'                    Application Dialogs
' *************************************************************

SUB ShowDialog_MainForm(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Minimiser V0.0", 0, 0,  299,  177, Style&, ExStyle& TO hMainForm&
    EZLIB_FixSize hMainForm&, Style&, 0
    ' Layer # 0
    CONTROL ADD FRAME, hMainForm&,  %ACTIONFRAME,  "Actions", 155, 140, 139, 34, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
        %WS_EX_TRANSPARENT
    CONTROL ADD FRAME, hMainForm&,  %RESULTFRAME,  "Results", 3, 20, 147, 155, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
        %WS_EX_TRANSPARENT
    CONTROL ADD FRAME, hMainForm&,  %ITERATEFRAME,  "Iteration settings", 155, 64, 139, 74, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
        %WS_EX_TRANSPARENT
    CONTROL ADD FRAME, hMainForm&,  %LIMITSFRAME,  "Parameter limits", 155, 20, 139, 42, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
        %WS_EX_TRANSPARENT
    CONTROL ADD LABEL, hMainForm&,  %LOACCURACYLABEL,  "Fine accuracy", 160, 118, 59, 12
    CONTROL ADD LABEL, hMainForm&,  %HIACCURACYLABEL,  "Coarse accuracy", 160, 103, 67, 12
    CONTROL ADD LABEL, hMainForm&,  %MAXERRLABEL,  "Max. Err", 8, 140, 33, 12
    CONTROL ADD LABEL, hMainForm&,  %MINITERATELABEL,  "Iterate below", 157, 76, 43, 12
    CONTROL ADD LABEL, hMainForm&,  %MINLABEL,  "Min value", 160, 44, 36, 12
    CONTROL ADD LABEL, hMainForm&,  %MAXLABEL,  "Max value", 160, 30, 35, 12
    CONTROL ADD LABEL, hMainForm&,  %TITLE,  "M i n i m i s e r   V 0 . 0", 3, 2, 291, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %WS_DLGFRAME
    CONTROL SEND hMainForm&,  %TITLE, %WM_SETFONT, App_Font&(0), %TRUE
    CONTROL ADD LABEL, hMainForm&,  %ERRORTXT,  "", 8, 32, 133, 12, 0 , _
        %WS_EX_CLIENTEDGE
    CONTROL SEND hMainForm&,  %ERRORTXT, %WM_SETFONT, App_Font&(3), %TRUE
    CONTROL ADD "Button", hMainForm&,  %EXITBUTTON,  "Exit", 160, 155, 27, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EXITBUTTON
    CONTROL ADD "Button", hMainForm&,  %RESTARTCALCBUTT,  "Restart calc.", 192, 155, 48, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_RESTARTCALCBUTT
    ' - - - - - - - - - - - - - - - - - - - - - - - - -
    DIM BESTVARSLIST_List(0) AS LOCAL STRING
    DATA "Item One"
    FOR N&=0 TO 0
        CT&=CT&+1
        BESTVARSLIST_List(N&)=READ$(CT&)
    NEXT N&
    ' - - - - - - - - - - - - - - - - - - - - - - - - -
    CONTROL ADD LISTBOX, hMainForm&,  %BESTVARSLIST, BESTVARSLIST_List(), 8, 49, 133, 86, _
        %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_SORT OR %LBS_NOINTEGRALHEIGHT OR %WS_VSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_BESTVARSLIST
    CONTROL ADD TEXTBOX, hMainForm&,  %MAXTXT,  "", 203, 30, 85, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_MAXTXT
    CONTROL ADD TEXTBOX, hMainForm&,  %MINTXT,  "", 203, 44, 85, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_MINTXT
    CONTROL ADD TEXTBOX, hMainForm&,  %ITERATEBELOWTXT,  "", 203, 76, 85, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_ITERATEBELOWTXT
    CONTROL ADD CHECKBOX, hMainForm&,  %ITERATECHECK,  "Iterate", 203, 91, 53, 12 CALL CBF_ITERATECHECK
    CONTROL ADD "Button", hMainForm&,  %SAVEBUTTON,  "Save results", 245, 155, 43, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_SAVEBUTTON
    CONTROL ADD TEXTBOX, hMainForm&,  %MAXERRTXT,  "", 48, 140, 93, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_MAXERRTXT
    CONTROL ADD "Button", hMainForm&,  %RESETRESULTSBUTT,  "Reset results", 83, 155, 59, 15, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_RESETRESULTSBUTT
    CONTROL ADD TEXTBOX, hMainForm&,  %LOACCURACYTXT,  "", 221, 103, 67, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_LOACCURACYTXT
    CONTROL ADD TEXTBOX, hMainForm&,  %HIACCURACYTXT,  "", 221, 118, 67, 12, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %ES_NUMBER OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE CALL CBF_HIACCURACYTXT
    CONTROL ADD CHECKBOX, hMainForm&,  %DISPLAYCHECK,  "Display every", 8, 155, 61, 12 CALL CBF_DISPLAYCHECK
    DIALOG SHOW MODELESS hMainForm& , CALL MainForm_DLGPROC
END SUB

' *************************************************************
'                             Dialog Callback Procedure
'                             for Form MainForm
'                             uses Global Handle - hMainForm&
' *************************************************************

CALLBACK FUNCTION MainForm_DLGPROC
    ''#DEBUG PRINT "MainForm_DLGPROC" & STR$(CBMSG)
    IF ProgStop THEN EXIT FUNCTION
    SELECT CASE CBMSG
        ' Common Windows Messages you may want to process
        ' -----------------------------------------------
        CASE %WM_TIMER
        CASE %WM_HSCROLL
        CASE %WM_VSCROLL
        CASE %WM_SIZE
        CASE %WM_CLOSE
        CASE %WM_DESTROY
        CASE %WM_SYSCOMMAND
        CASE %WM_PAINT
        ' -----------------------------------------------
        CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
             %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
            ' Control colors
            SELECT CASE GetDlgCtrlID(CBLPARAM)
                CASE  %TITLE
                    SetTextColor CBWPARAM, App_Color&( 12)
                    SetBkColor   CBWPARAM, App_Color&( 26)
                    FUNCTION=App_Brush&( 26)
                CASE  %ERRORTXT
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( ErrorTxtColor)
                    FUNCTION=App_Brush&( 26)
                CASE  %BESTVARSLIST
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 26)
                    FUNCTION=App_Brush&( 26)
                CASE  %MAXTXT
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 25)
                    FUNCTION=App_Brush&( 25)
                CASE  %MINTXT
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 25)
                    FUNCTION=App_Brush&( 25)
                CASE  %ITERATEBELOWTXT
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 25)
                    FUNCTION=App_Brush&( 25)
                CASE  %MAXERRTXT
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 25)
                    FUNCTION=App_Brush&( 25)
                CASE  %LOACCURACYTXT
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 25)
                    FUNCTION=App_Brush&( 25)
                CASE  %HIACCURACYTXT
                    SetTextColor CBWPARAM, App_Color&( 0)
                    SetBkColor   CBWPARAM, App_Color&( 25)
                    FUNCTION=App_Brush&( 25)
                CASE ELSE
                    FUNCTION=0
            END SELECT
        CASE %WM_NOTIFY
            IF EZLIB_IsTooltip(CBLPARAM) THEN
                SELECT CASE EZLIB_TooltipID(CBLPARAM)
                    CASE  %EXITBUTTON
                        EZLIB_SetTooltipText CBLPARAM, "Control -  %EXITBUTTON"
                    CASE  %RESTARTCALCBUTT
                        EZLIB_SetTooltipText CBLPARAM, "Control -  %RESTARTCALCBUTT"
                    CASE  %SAVEBUTTON
                        EZLIB_SetTooltipText CBLPARAM, "Control -  %SAVEBUTTON"
                    CASE  %RESETRESULTSBUTT
                        EZLIB_SetTooltipText CBLPARAM, "Control -  %RESETRESULTSBUTT"
                    CASE ELSE
                END SELECT
            END IF
            IF EZLIB_IsTab(CBLPARAM) THEN
                SELECT CASE EZLIB_TabID(CBLPARAM)
                    CASE ELSE
                END SELECT
            END IF
        CASE %WM_COMMAND
            ' Process Messages to Controls that have no Callback Function
            ' and Process Messages to Menu Items
            SELECT CASE CBCTL
                CASE ELSE
            END SELECT
        CASE ELSE
    END SELECT
END FUNCTION


' (3) Put NEXT DIALOG Creation / Dialog Procedure code after here :


' *************************************************************
'              EZGUI Freeware Dialog Designer Library
'
'                   see web site at EZGUI.COM
'
' Copyright (C) 2000, Christopher R. Boss , All Rights Reserved !
'
' This code was Generated by the EZGUI Freeware Dialog Designer
' and may be used ROYALTY FREE, as long as this Copyright notice
' is kept with the source code.
' The Author also gives you the right to post this code on a
' web site and to distribute it to others.
' *************************************************************

SUB EZLIB_InitFonts()
    REDIM App_Font(0 TO 5)
    App_Font(0)=GetStockObject(%SYSTEM_FONT)
    App_Font(1)=GetStockObject(%SYSTEM_FIXED_FONT)
    App_Font(2)=GetStockObject(%ANSI_VAR_FONT)
    App_Font(3)=GetStockObject(%ANSI_FIXED_FONT)
    App_Font(4)=GetStockObject(%DEFAULT_GUI_FONT)    ' MS Sans Serif
    App_Font(5)=GetStockObject(%OEM_FIXED_FONT)      ' Terminal Font
    END SUB

' -------------------------------------------------------------

SUB EZLIB_DeleteFonts()
    LOCAL N&
    ' Fonts 0 to 5 do not need to be deleted
    FOR N&=6 TO UBOUND(App_Font)
        IF App_Font(N&)<>0 THEN DeleteObject App_Font(N&)
    NEXT N&
    END SUB

' -------------------------------------------------------------

SUB EZLIB_FixSize(BYVAL hDlg&, BYVAL Style&, BYVAL HasMenu&)
    LOCAL X&, Y&, W&, H&, XX&, YY&
    DIALOG GET SIZE hDlg& TO X&, Y&
    IF (Style& AND %WS_CAPTION) = %WS_CAPTION THEN
        IF HasMenu& THEN
            H&=H&+GetSystemMetrics(%SM_CYCAPTION)
        END IF
    END IF
    IF (Style& AND %WS_HSCROLL) = %WS_HSCROLL THEN
        H&=H&+GetSystemMetrics(%SM_CYHSCROLL)
    END IF
    IF (Style& AND %WS_VSCROLL) = %WS_VSCROLL THEN
        W&=W&+GetSystemMetrics(%SM_CYVSCROLL)
    END IF
    DIALOG PIXELS hDlg&, W&, H& TO UNITS XX&, YY&
    X&=X&+XX&
    Y&=Y&+YY&
    DIALOG SET SIZE hDlg&, X&, Y&
END SUB

' -------------------------------------------------------------

FUNCTION EZLIB_IsTooltip(BYVAL lParam AS LONG) AS LONG
    LOCAL pNM AS NMHDR PTR
    pNM=lParam
    IF @pNM.code=%TTN_NEEDTEXT THEN FUNCTION=1 ELSE FUNCTION=0
END FUNCTION

' -------------------------------------------------------------

FUNCTION EZLIB_TooltipID(BYVAL lParam AS LONG) AS LONG
    LOCAL pNM AS NMHDR PTR, pTT AS TOOLTIPTEXT PTR
    LOCAL IDNum&, UF&
    IDNum&=0
    pNM=lParam
    IF @pNM.code=%TTN_NEEDTEXT THEN
        ' Check for Tooltip message
        pTT=lParam
        UF&[email protected] AND %TTF_IDISHWND
        IF UF&=%TTF_IDISHWND THEN
            IDNum&=GetDlgCtrlID(@pTT.hdr.idfrom)
        ELSE
            IDNum&[email protected]
        END IF
    END IF
    FUNCTION=IDNum&
END FUNCTION

' -------------------------------------------------------------

SUB EZLIB_SetTooltipText(BYVAL lParam AS LONG, TipText$)
    LOCAL pNM AS NMHDR PTR, pTT AS TOOLTIPTEXT PTR
    pNM=lParam
    IF @pNM.code=%TTN_NEEDTEXT THEN
        ' Check for Tooltip message
        pTT=lParam
        IF TipText$<>"" THEN
            @pTT.szText=LEFT$(TipText$, 79)+CHR$(0)
        END IF
    END IF
END SUB

' -------------------------------------------------------------

FUNCTION EZLIB_IsTab(BYVAL lParam AS LONG) AS LONG
    LOCAL pNM AS NMHDR PTR
    pNM=lParam
    IF @pNM.code=%TCN_SELCHANGE THEN FUNCTION=1 ELSE FUNCTION=0
END FUNCTION

' -------------------------------------------------------------

FUNCTION EZLIB_TabID(BYVAL lParam AS LONG) AS LONG
    LOCAL pNM AS NMHDR PTR
    LOCAL IDNum&
    pNM=lParam
    IF @pNM.code=%TCN_SELCHANGE THEN
        IDNum&[email protected]
    END IF
    FUNCTION=IDNum&
END FUNCTION

' -------------------------------------------------------------

' -------------------------------------------------------------

SUB EZLIB_DefColors()
    LOCAL T&
    REDIM App_Brush&(0 TO 31)
    REDIM App_Color&(0 TO 31)
    FOR T&=0 TO 31
        App_Brush&(T&)=CreateSolidBrush(EZLIB_QBColor(T&))
        App_Color&(T&)=EZLIB_QBColor(T&)
    NEXT T&
END SUB

' -------------------------------------------------------------

SUB EZLIB_DeleteBrushes()
    LOCAL T&
    FOR T&=0 TO 31
        DeleteObject App_Brush&(T&)
    NEXT T&
END SUB

' -------------------------------------------------------------

FUNCTION EZLIB_QBColor(N&) AS LONG
    LOCAL RV&
    SELECT CASE N&
        CASE 0
        RV&=RGB(0,0,0)       ' Black
    CASE 1
        RV&=RGB(0,0,128)     ' Blue
    CASE 2
        RV&=RGB(0,128,0)     ' Green
    CASE 3
        RV&=RGB(0,128,128)   ' Cyan
    CASE 4
        RV&=RGB(196,0,0)     ' Red
    CASE 5
        RV&=RGB(128,0,128)   ' Magenta (Purple)
    CASE 6
        RV&=RGB(128,64,0)    ' Brown
    CASE 7
        RV&=RGB(196,196,196) ' White
    CASE 8
        RV&=RGB(128,128,128) ' Gray
    CASE 9
        RV&=RGB(0,0, 255)    ' Lt. Blue
    CASE 10
        RV&=RGB(0,255,0)     ' Lt. Green
    CASE 11
        RV&=RGB(0,255,255)   ' Lt. Cyan
    CASE 12
        RV&=RGB(255,0,0)     ' Lt. Red
    CASE 13
        RV&=RGB(255,0,255)   ' Lt. magenta (Purple)
    CASE 14
        RV&=RGB(255,255,0)   ' Yellow
    CASE 15
        RV&=RGB(255,255,255) ' Bright White
    CASE 16   ' - Extended QB colors Pastel version -
        RV&=RGB(164,164,164)
    CASE 17
        RV&=RGB(128,160,255)
    CASE 18
        RV&=RGB(160,255,160)
    CASE 19
        RV&=RGB(160,255,255)
    CASE 20
        RV&=RGB(255,160,160)
    CASE 21
        RV&=RGB(255,160,255)
    CASE 22
        RV&=RGB(255,255,160)
    CASE 23
        RV&=RGB(212,212,212)
    CASE 24
        RV&=RGB(180,180,180)
    CASE 25
        RV&=RGB(188,220,255)
    CASE 26
        RV&= RGB(220,255,220)
    CASE 27
        RV&=RGB(220,255,255)
    CASE 28
        RV&=RGB(255,220,220)
    CASE 29
        RV&=RGB(255,220,255)
    CASE 30
        RV&=RGB(255,255,220)
    CASE 31
        RV&=RGB(228,228,228)
    CASE ELSE
        RV&=RGB(0,0,0)
    END SELECT
    FUNCTION=RV&
END FUNCTION
 ' -------------------------------------------------------------
SUB EZLIB_ShowControl(BYVAL hWnd&, BYVAL ID&, BYVAL SFlag&)
    LOCAL hCtrl&
    IF IsWindow(hWnd&) THEN
        IF ID&<>0 THEN
            hCtrl&=GetDlgItem(hWnd&,ID&)
            IF SFlag&=0 THEN
                ShowWindow hCtrl&, %SW_HIDE
            ELSE
                ShowWindow hCtrl&, %SW_SHOW
            END IF
        END IF
    END IF
END SUB
 ' -------------------------------------------------------------
' *************************************************************
'             End of EZGUI Dynamic Dialogs Library
' *************************************************************


' *************************************************************
'  Application Callback Functions (or Procedures) for Controls
' *************************************************************

' ------------------------------------------------
CALLBACK FUNCTION CBF_EXITBUTTON
    IF CBCTLMSG=%BN_CLICKED THEN
        SaveResults
        ScanStop=%TRUE
        ProgStop=%TRUE
        DIALOG END hMainForm&
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_RESTARTCALCBUTT
    IF CBCTLMSG=%BN_CLICKED THEN
        ScanStop = %TRUE            'Stop scanning
        ActionRequest = %REQ_SCAN   'Request a new scan
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_BESTVARSLIST
    LOCAL CVal&
    ' Return Current Selection in CVal&
    CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO CVal&
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_MAXTXT
    LOCAL Text$
    IF CBCTLMSG=%EN_CHANGE THEN
        CONTROL GET TEXT hMainForm&, %MAXTXT TO Text$
        qMax = VAL(Text$)
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_MINTXT
    LOCAL Text$
    IF CBCTLMSG=%EN_CHANGE THEN
        CONTROL GET TEXT hMainForm&, %MINTXT TO Text$
        qMin = VAL(Text$)
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_ITERATEBELOWTXT
    LOCAL Text$
    IF CBCTLMSG=%EN_CHANGE THEN
        CONTROL GET TEXT hMainForm&, %ITERATEBELOWTXT TO Text$
        dblMaxStartFout = VAL(Text$)
        #DEBUG PRINT Text$
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_ITERATECHECK
    IF CBCTLMSG=%BN_CLICKED THEN
        CONTROL GET CHECK hMainForm&, %ITERATECHECK TO IterateFlag
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_SAVEBUTTON
    IF CBCTLMSG=%BN_CLICKED THEN
        ScanStop=%TRUE              'Stop scanning to save results
        ActionRequest = %REQ_SAVE   'Request to save results
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_MAXERRTXT
LOCAL Text$
    IF CBCTLMSG=%EN_CHANGE THEN
        CONTROL GET TEXT hMainForm&, %MAXERRTXT TO Text$
        MaxErr = VAL(Text$)
        #DEBUG PRINT Text$
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_RESETRESULTSBUTT
    IF CBCTLMSG=%BN_CLICKED THEN
        ScanStop = %TRUE                'Stop scanning
        ActionRequest = %REQ_RESETRES   'Request to reset results
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_LOACCURACYTXT
    LOCAL Text$
    IF CBCTLMSG=%EN_CHANGE THEN
        CONTROL GET TEXT hMainForm&, %LOACCURACYTXT TO Text$
        LoAccuracy = VAL(Text$)
        MidAccuracy = (LoAccuracy+HiAccuracy)/2.0
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_HIACCURACYTXT
    LOCAL Text$
    IF CBCTLMSG=%EN_CHANGE THEN
        CONTROL GET TEXT hMainForm&, %HIACCURACYTXT TO Text$
        HiAccuracy = VAL(Text$)
        MidAccuracy = (LoAccuracy+HiAccuracy)/2.0
        #DEBUG PRINT STR$(MidAccuracy)
    END IF
END FUNCTION
' ------------------------------------------------

' ------------------------------------------------
CALLBACK FUNCTION CBF_DISPLAYCHECK
    IF CBCTLMSG=%BN_CLICKED THEN
        CONTROL GET CHECK hMainForm&, %DISPLAYCHECK TO DisplayFlag
    END IF
END FUNCTION
' ------------------------------------------------

' (4) Put NEXT DIALOG Callback / Subs code after here :

' *************************************************************
'                     Put Your Code Here
' *************************************************************

SUB Doelfunc ()
'User functie: Dit gedeelte is door de gebruiker aan te passen volgens de toepassing:
'15 -20 200 -500 1000 -2500 5000 -7500
LOCAL q1 AS DOUBLE, q2 AS DOUBLE, q3 AS DOUBLE, q4 AS DOUBLE, q5 AS DOUBLE, q6 AS DOUBLE, q7 AS DOUBLE, q8 AS DOUBLE
LOCAL qq22 AS DOUBLE, quit AS LONG,i AS LONG
quit=%FALSE
fout=conLargest
IF q(2)=0 THEN
    fout=conLargest
    quit=%TRUE
    q(2)=1
END IF
IF q(6)=0 THEN
    fout=conLargest
    quit=%TRUE
    q(6)=1
END IF
IF q(8)=0 THEN
    fout=conLargest
    quit=%TRUE
    q(8)=1
END IF
IF quit=%FALSE THEN
q1 = q(1)
q2 = q(2)
q3 = q(3)
q4 = q(4)
q5 = q(5)
q6 = q(6)
q7 = q(7)
q8 = q(8)
qq22 = q2 * q2
qf(1) = q1 + q2 + q3 + q4 + q5 + q6 + q7 + q8 + 4305
qf(2) = qq22 - 3 * q3 + q4 * q4 + q6 * q6 * 0.00001 - q7 / 10 - 249362.4999999
qf(3) = qq22 - q3 * q3 / 1000 + q5 / 100 + 500 * q6 / q8 - 536.66666666666
qf(4) = q1 * q7 - q4 * q4 - 10 * q5 - q6 + q8 + 190000
qf(5) = q1 * q1 - (q3 / 100) * (q3 / 100) - q2 * q4 / 1000 + q7 - 5211
qf(6) = 1000 * q1 / q6 + 5 * q6 + 12506
qf(7) = q1 - q2 + q3 * q3 - q4 + 60 * q5 / q6 + 50 * q7 / q8 - 40477.6666666667
qf(8) = 100 * q1 + q2 + q3 * q4 - q4 + 200 * q5 / q2 - 20 * q4 / q6 + 108024
fout = ABS(qf(1)) + ABS(qf(2)) + ABS(qf(3)) + ABS(qf(4)) + ABS(qf(5)) + ABS(qf(6)) + ABS(qf(7)) + ABS(qf(8))
END IF
EXIT SUB

'User functie: Dit gedeelte is door de gebruiker aan te passen volgens de toepassing:
'15 -20 200 -500 1000 -2500 5000 -7500
''LOCAL q1 AS DOUBLE, q2 AS DOUBLE, q3 AS DOUBLE, q4 AS DOUBLE, q5 AS DOUBLE, q6 AS DOUBLE, q7 AS DOUBLE, q8 AS DOUBLE
''LOCAL qq22 AS DOUBLE, quit AS LONG,i AS LONG
quit=%FALSE
fout=conLargest

''IF quit=%FALSE THEN
q1 = q(1)
q2 = q(2)
q3 = q(3)
q4 = q(4)
q5 = q(5)
q6 = q(6)
q7 = q(7)
q8 = q(8)
qf(1) = q1 + q2 + q3 + q4 + q5 + q6 + q7 + q8 + 4305
qf(2) = - 3 * q3 - q4 + q6 * 0.01 - q7 / 10 +624.99999999-5.48e-7
qf(3) = -q3 / 10 + q5 / 100 + 500 * q6+1250010
qf(4) = q7 - 8 * q4 - 10 * q5 - q6 + q8+6000
qf(5) = q1 - (q3 / 100) - q2 / 100 + 100*q7-500013.2
qf(6) = 1000 * q1 + 5 * q6 -2500
qf(7) = q1 - q2 + q3 - q4 + 60 * q5 + 5 * q8-23235
qf(8) = 100 * q1 + q3 - q4 + 200 * q5 - 20 * q6 -252200
fout = ABS(qf(1)) + ABS(qf(2)) + ABS(qf(3)) + ABS(qf(4)) + ABS(qf(5)) + ABS(qf(6)) + ABS(qf(7)) + ABS(qf(8))
''END IF
''#DEBUG PRINT STR$(qf(7))
''#DEBUG PRINT STR$(qf(8))
''#DEBUG PRINT STR$(qf(1))
EXIT SUB

'User functie: Dit gedeelte is door de gebruiker aan te passen volgens de toepassing:
''LOCAL q1 AS DOUBLE, q2 AS DOUBLE, q3 AS DOUBLE, q4 AS DOUBLE, q5 AS DOUBLE, q6 AS DOUBLE, q7 AS DOUBLE, q8 AS DOUBLE
''LOCAL  qq22 AS DOUBLE,quit AS LONG,i AS LONG
''quit=%FALSE
fout=conLargest
IF quit=%FALSE THEN
    q1 = q(1)
    q2 = q(2)
    q3 = q(3)
    qf(1) = q1 + q2 + q3 -10
    qf(2) = q1 * q3 -2*(q2+q3)
    qf(3) = 4+(q1-2)*(q1-2)-q2*q2
    fout = ABS(qf(1)) + ABS(qf(2)) + ABS(qf(3))
END IF
EXIT SUB

END SUB


SUB StoreBest ()
    LOCAL i AS LONG
    STATIC LastSaveTime AS LONG
    BetterFound=%TRUE
    best = fout
    FOR i = 1 TO conVars
        qBest(i) = q(i)
    NEXT
    'Display new values only if DisplayFlag is set or if enough seconds are passed:
    IF (DisplayFlag) OR (ISFALSE(DisplayFlag) AND (TIMER-LastSaveTime>3)) THEN
        LastSaveTime=TIMER
        CONTROL SET TEXT hMainForm&,  %ERRORTXT, STR$(best)
        LISTBOX RESET hMainForm&, %BESTVARSLIST
        FOR i = 1 TO conVars
            LISTBOX ADD hMainForm&, %BESTVARSLIST, STR$(i) & " " & STR$(q(i))
        NEXT
        SetWindowText hMainForm&, STR$(best) 'Show best in Window titlebar
    END IF
END SUB

SUB ShowBest ()
    LOCAL i AS LONG
    CONTROL SET TEXT hMainForm&,  %ERRORTxt, STR$(best)
    LISTBOX RESET hMainForm&, %BESTVARSLIST
    FOR i = 1 TO conVars
        LISTBOX ADD hMainForm&, %BESTVARSLIST, STR$(i) & " " & STR$(qBest(i))
    NEXT
    LISTBOX ADD hMainForm&, %BESTVARSLIST, "Best: " & STR$(best)
END SUB

SUB KleinsteDeltaQ (i AS LONG)
'Zoek de kleinste waarde van DeltaQ waarbij q(i) verandert. Indien q(i)
'een bepaalde waarde heeft en DeltaQ zeeeer klein is, en je telt ze bij elkaar
'op zal q(i) niet veranderen vanwege afrondingsfouten. DeltaQ mag daarom niet
'TE klein zijn:
'input: i:index van de variabele
'    sign: 1 of -1, het teken van DeltaQ
LOCAL conMaxValue AS DOUBLE, conMultiplier AS DOUBLE, a AS DOUBLE, smallestValue AS DOUBLE, beginFout AS DOUBLE
LOCAL dblLastDeltaQ AS DOUBLE
conMaxValue = 1e50
conMultiplier=2.0
smallestValue= 1e-300
DeltaQ = sign * ABS(PrevDeltaQ(i))

IF DeltaQ = 0 THEN
    DeltaQ = sign * 1e-15
END IF

a = q(i)
IF a + DeltaQ = a THEN
    'DeltaQ is te klein
    WHILE (a + DeltaQ = a)
        DeltaQ = DeltaQ * conMultiplier
    WEND
ELSE
    'Kijk of we DeltaQ wat kleiner kunnen maken:
    IF a <> 0 THEN
        WHILE (a + DeltaQ <> a) AND (ABS(DeltaQ) > smallestValue)
            DeltaQ = DeltaQ / conMultiplier
        WEND
        DeltaQ = DeltaQ * conMultiplier
    END IF
END IF

'Het resultaat van de doelfunctie moet bij deze kleine DeltaQ ook veranderen:
CALL Doelfunc()
beginFout = fout
DO
   q(i) = a + DeltaQ
   dblLastDeltaQ = DeltaQ
   CALL Doelfunc()
   DeltaQ = DeltaQ * conMultiplier
LOOP UNTIL (beginFout <> fout) OR (fout >= conLargest) OR (ABS(DeltaQ) > conMaxValue)
DeltaQ = dblLastDeltaQ

fout = beginFout
q(i) = a
IF ABS(DeltaQ) > conMaxValue THEN
    DeltaQ = sign * conMaxValue
END IF
PrevDeltaQ(i) = DeltaQ
DeltaQ = DeltaQ * Accuracy
END SUB


SUB  NewItereer1Dim (i AS LONG)
'Probeer de doelfunctie kleiner te maken door de variabelen een
'beetje te veranderen:
LOCAL beginFout AS DOUBLE, lastfout AS DOUBLE, qbefore AS DOUBLE, maxdeltaQ AS DOUBLE, deltaQInc AS DOUBLE
LOCAL temp AS DOUBLE
LOCAL tel AS LONG, blnTerminate AS LONG, MaxTel AS LONG, DoEventCounter AS LONG
maxdeltaQ = 1e10
deltaQInc=1.15
MaxTel=300
CALL Doelfunc()
lastfout        = fout
beginFout       = fout
blnTerminate    = %FALSE
DoEventCounter  = 0
DO
    INCR DoEventCounter
    IF DoEventCounter>4 THEN DoEventCounter = 0 : DIALOG DOEVENTS
    tel = 0
    DO
        INCR tel
        lastfout = fout
        qbefore = q(i)
        temp = q(i) + DeltaQ
        IF (temp > qMax) OR (temp < qMin) THEN
            blnTerminate = %TRUE
        ELSE
            q(i) = temp
        END IF
        IF ABS(DeltaQ) < maxdeltaQ THEN
            DeltaQ = DeltaQ * deltaQInc
        END IF
        CALL Doelfunc()
        IF tel > MaxTel THEN
            blnTerminate = %TRUE
        END IF
    LOOP UNTIL (blnTerminate=%TRUE) OR (fout >= lastfout) OR Scanstop
    fout = lastfout
    q(i) = qbefore  'herstel laatste goede waarde
    KleinsteDeltaQ (i)
    fout = lastfout
    q(i) = qbefore
LOOP UNTIL (tel=1) OR (blnTerminate=%TRUE) OR Scanstop
END SUB

SUB  Itereer ()
LOCAL quit AS LONG, counter AS LONG, maxcounter AS LONG
LOCAL prevfout AS DOUBLE, startfout AS DOUBLE, i AS LONG
LOCAL StoreDeltaQ AS DOUBLE
maxcounter=50 'conVars*conVars
CALL Doelfunc()
startfout = fout
counter=0
quit=%FALSE
    DO
        ''DIALOG DOEVENTS
        INCR counter
        prevfout = fout
        FOR i = 1 TO conVars
            'DIALOG DOEVENTS
            sign=1
            KleinsteDeltaQ (i)
            StoreDeltaQ=DeltaQ
            NewItereer1Dim (i)
            'sign=-1
            'KleinsteDeltaQ (i)
            DeltaQ= -StoreDeltaQ
            NewItereer1Dim (i)
            IF ScanStop THEN EXIT SUB
        NEXT
        IF fout < best THEN
            CALL StoreBest()
        END IF
        IF counter > maxcounter THEN
            quit=%TRUE
        END IF
    LOOP UNTIL (prevfout <= fout) OR (quit= %TRUE) OR ScanStop
IF quit= %TRUE THEN
    #DEBUG PRINT "Iteratie gestopt omdat 'counter' te hoog geworden is!"
END IF
END SUB

SUB  ItereerSmall ()
LOCAL prevfout AS DOUBLE, startfout AS DOUBLE, i AS LONG, i2 AS LONG, i3 AS LONG
LOCAL BestFout AS DOUBLE, Counter AS LONG, MaxCounter AS LONG
DIM DeltaQQ(conVars) AS DOUBLE
DIM qa(conVars) AS DOUBLE
MaxCounter = 100
Counter=0
CALL Doelfunc()
FOR i = 1 TO conVars
    qa(i)=q(i)
    KleinsteDeltaQ (i)
    DeltaQQ(i)=DeltaQ * 2.0
NEXT

DO
    ''DIALOG DOEVENTS
    INCR Counter
    prevfout = fout : BestFout=fout
    FOR i2 = 1 TO conVars*conVars
        FOR i = 1 TO conVars
            SELECT CASE RND
                CASE >0.66
                    q(i)=qa(i)+DeltaQQ(i)
                CASE >0.33
                    q(i)=qa(i)-DeltaQQ(i)
                CASE ELSE
                    q(i)=qa(i)
            END SELECT
        NEXT
        CALL Doelfunc()
        IF fout < best THEN
            BestFout=fout
            CALL StoreBest()
            FOR i3 = 1 TO conVars
                qa(i3)=q(i3)
            NEXT
        END IF
        IF ScanStop THEN EXIT SUB
    NEXT
LOOP UNTIL (prevfout <= BestFout) OR ScanStop OR (Counter>MaxCounter)
IF Counter>MaxCounter THEN #DEBUG PRINT "ItereerSmall: counter got too high"
END SUB

SUB ScanIncreasing()
LOCAL localbest AS DOUBLE, qRange AS DOUBLE, localTemp AS DOUBLE, localTemp2 AS DOUBLE, dblPrevFout AS DOUBLE
LOCAL multi AS DOUBLE
DIM qlo(conVars) AS LOCAL DOUBLE, qhi(conVars) AS LOCAL DOUBLE, qc(conVars) AS LOCAL DOUBLE
LOCAL clipped AS LONG, i AS LONG, i5 AS LONG, ScanCounter AS LONG, DoEventCounter AS LONG
LOCAL temphandle&
ScanCounter     = 0
qRange          = 0
clipped         = 0
DoEventCounter  = 0
ShowBest
WHILE (best > maxErr) AND (ISFALSE ScanStop)
    INCR DoEventCounter
    IF DoEventCounter>100 THEN DoEventCounter = 0 : DIALOG DOEVENTS
    BetterFound =%FALSE
    qRange      = qMax - qMin
    localTemp2  = (qMax - qMin) / 2

    IF (RND > 0.45) THEN
        FOR i = 1 TO conVars
            q(i)    = qBest(i)
            qc(i)   = q(i)
        NEXT
    ELSE
        FOR i = 1 TO conVars
            q(i)    = qMin + RND * qRange
            qc(i)   = q(i)
        NEXT
    END IF

    sign=1
    KleinsteDeltaQ(1)
    localTemp = DeltaQ
    multi = 4
    clipped = 0
    INCR ScanCounter

    DO
        clipped = 0
        FOR i = 1 TO conVars
            qlo(i) = qc(i) - localTemp
            qhi(i) = qc(i) + localTemp
            IF (qlo(i) < qMin) THEN
                INCR clipped
                qlo(i) = qMin
            END IF
            IF qhi(i) > qMax THEN
                INCR clipped
                qhi(i) = qMax
            END IF
        NEXT

        localTemp = localTemp * multi
        multi = multi * 1.3

        ''FOR i5 = 1 TO (2 * conVars)
            FOR i = 1 TO conVars
                'DIALOG DOEVENTS
                q(i) = qlo(i) + (qhi(i) - qlo(i)) * RND
                CALL Doelfunc()
                IF IterateFlag AND (fout < dblMaxStartFout) THEN
                    Accuracy=HiAccuracy : CALL Itereer() : CALL ItereerSmall
                    Accuracy=MidAccuracy : CALL Itereer() : CALL ItereerSmall
                    Accuracy=LoAccuracy : CALL Itereer() : CALL ItereerSmall
                END IF
                IF fout < best THEN
                    CALL StoreBest()
                END IF
            NEXT i
        ''NEXT i5
    LOOP UNTIL (clipped >= (2 * conVars)) OR ScanStop OR BetterFound OR (best < maxErr)
WEND
IF best < maxErr THEN
    MSGBOX "Max. Error value reached!"
END IF
END SUB

SUB SaveResults()
LOCAL i AS LONG
OPEN resultFile FOR OUTPUT AS #1
WRITE# 1, conVars
WRITE# 1, conVgls
WRITE# 1, maxErr
WRITE# 1, qMax
WRITE# 1, qMin
WRITE# 1, dblMaxStartFout
WRITE# 1, LoAccuracy
WRITE# 1, MidAccuracy
WRITE# 1, HiAccuracy
WRITE# 1, best
FOR i = 1 TO conVars
    WRITE# 1, qBest(i)
NEXT i
CLOSE 1
END SUB

SUB RDResults()
LOCAL i AS LONG, dummy AS LONG
IF DIR$(resultFile)="" THEN EXIT SUB
OPEN resultFile FOR INPUT AS #1
INPUT# 1, dummy
IF dummy<>conVars THEN EXIT SUB
INPUT# 1, conVgls
INPUT# 1, maxErr
INPUT# 1, qMax
INPUT# 1, qMin
INPUT# 1, dblMaxStartFout
INPUT# 1, LoAccuracy
INPUT# 1, MidAccuracy
INPUT# 1, HiAccuracy
INPUT# 1, best
FOR i = 1 TO conVars
    INPUT# 1, qBest(i)
NEXT i
CLOSE 1
END SUB

SUB PresetParameters
    CONTROL SET TEXT hMainForm&, %MAXTXT, STR$(qMax)
    CONTROL SET TEXT hMainForm&, %MINTXT, STR$(qMin)
    CONTROL SET TEXT hMainForm&, %ITERATEBELOWTXT, STR$(dblMaxStartFout)
    CONTROL SET TEXT hMainForm&, %MAXERRTXT, STR$(maxErr)
    CONTROL SET TEXT hMainForm&, %LOACCURACYTXT, STR$(LoAccuracy)
    CONTROL SET TEXT hMainForm&, %HIACCURACYTXT, STR$(HiAccuracy)
    CONTROL SET CHECK hMainForm&, %ITERATECHECK, 1
    CONTROL SET CHECK hMainForm&, %DISPLAYCHECK, 1
END SUB

------------------
[email protected]

[Wayne Diamond]

On the topic of squeezing the most out of a processor (eg. 100% use), does anyone have any tips/tricks to share ?


------------------

[Lance Edmonds]

A couple of ideas:
1. Don't release time slices with DIALOG DOEVENTS or SLEEP.
2. Use a separate thread to do the CPU-intensive calculations.

By using a separate thread, that thread can virtually hammer the CPU as much as it likes (or can get away with), yet the main thread running the GUI can idle along processing the occasional message.


------------------
Lance
PowerBASIC Support
mailto:[email protected][email protected]</A>

[Eddy Van Esch]

Originally posted by Lance Edmonds:
2. Use a separate thread to do the CPU-intensive calculations.

A separate thread without DIALOG DOEVENTS, would this use practically
100% processor capacity in case all other processes are idle?
Eddy



------------------
[email protected]

[Florent Heyworth]

A compute intensive thread will claim a lot of CPU in a
tight loop. You can tweak the thread's priority (*never*
use realtime unless absolutely necessary for a *very* short
period of time). The next higher thread priority would be high
however it should not be necessary.

YMMV

Florent

------------------

[Michael Mattias]

I think you could use the PeekMessage to see if there are any unprocessed messages for your dialog, and only "DoEvents" until nothing's left.

(Not totally sure, because I don't use DDT much).

MCM

[Lance Edmonds]

Calling DIALOG DOEVENTS in a thread that does not "own" a GUI dialog/window is a waste of time... message pumps should be thread-specific.

PeekMessage() may be worth experimenting with, but using a separate thread is generally regarded as the "best" solution.

------------------
Lance
PowerBASIC Support
mailto:[email protected][email protected]</A>

[Jim Barber]

This isn't an answer to Eddy's or Wayne's questions,
but it seems an opportune thread in which to bring it up.

Since Intel and AMD both seem to be determined to move
away from stack-based floating point units, I'll wonder out
loud if any PB'ers have considered just how 'vectorized'
SSE (SSE2, SIMD+, whatever you want to call it) could be
implemented in PB?

I know the ASM folks will be happy to throw out examples,
but I'm interested in a way to have the compiler handle it
intrinsically, even if that means giving it a little help
with directives, or some kind of pre-processor.

As things stand, it seems to me to be a real problem.
Introducing parallelism into programming at the high
level is something I have trouble getting a handle on.
I suspect I'm not the only one, since only the Intel C++,
Intel Fortran, and VectorC compilers address the issue at
all so far. Of the above, only the Intel C++ compiler
(plugin for VS6) is what I'd call "widely deployable",
and the combined cost of VS6 and the plugin is quite
high. Add VTune to do any profiling, and the total cost
approaches 2K USD.

Getting back to PB, perhaps a code generator for inline
includes? The problem with linking libraries is that
all that pushing and popping burns cycles, so ideally,
I'd like to see parms passed in registers to 'nearby'
inline functions, rather than on the stack.

No answers here folks, but in my opinion, at least, the
the stack-based '87 unit on the P4 leaves a lot to be
desired. (understatement alert!) If this is any indicator
of things to come, I'll venture that we (or someone) had
better get it figured out.

My .02,
Jim Barber


------------------

[Brad D Byrne]

If you just want to use 100% processor w/o Thread overhead
Why not???


WHILE GetMessage(Msg, %NULL, 0, 0)
CALL USE100Prct()
TranslateMessage Msg
DispatchMessage Msg
WEND

SUB USE100Prct()
"do some math"
"return to ck for msg"
END SUB

------------------

[Russ Srole]

Lance,

This is not a bad place to clear up some confusing (at least on
my part) vis-a-vis the difference between Dialog DoEvents and Sleep.
Sometimes I'm at a loss to figure out which one is the better choice,
So I try one or the other and see what happens.

Also, in regards to the idea of using a thread with no Dialog DoEvents
or Sleep: I found in a thread that is monitoring a serial port, you
need a Sleep or things get a bit odd. It does seem to depend on the
version of windows. I had one routine without the Sleep in the loop
and all was OK on Win98 & NT, but Win2K was not too happy.

"Working on mysteries without any clues" - Bob Sieger

Thanks,
Russ Srole


------------------

[Eddy Van Esch]

Folks,
I replaced the DIALOG DOEVENTS with a call to DoEventsAPI (as found on
different threads in these forums):

SUB DoEventsAPI
STATIC Msg AS tagMsg     
   IF PeekMessage(Msg, %NULL, 0, 0, %PM_REMOVE) THEN
        TranslateMessage Msg        
        DispatchMessage Msg   
   END IF 
END SUB

Works great! 100% CPU usage and practically immediate response to
GUI events (button clicks, etc..)
Eddy



------------------
[email protected]

[Bernard Chapman]

While on the question of SLEEP you can keep the CPU active 100% of the time if you use:


SLEEP 0

rather than say:

SLEEP 1

in a loop like:

DO
   IF SOMETHINGTODO THEN
      .
      .
      .
   ELSE
      SLEEP 0
   END IF
LOOP

Using a parameter of zero the thread will only relinquish the remainder of its time slice if there is another thread ready to run.

A parameter of say 1 forces it to suspend for 1 millisecond.

The difference in CPU usage can be dramatic.

Bern

------------------
Bern

www.insighttrading.com.au

[Lance Edmonds]

Actually, even 1 millisecond is a little optimistic... depending on the version of Windows (which determines the Time Quantum or time-slice allocation), it usually will cause a suspension of up to at least 10 milliseconds or more.

------------------
Lance
PowerBASIC Support
mailto:[email protected][email protected]</A>

[Eddy Van Esch]

Originally posted by Bernard Chapman:
SLEEP 0
rather than say:
SLEEP 1

Will the GUI-events (messages and stuff) of the program that invokes the SLEEP command
be processed during the SLEEP command?



------------------
[email protected]

[Lance Edmonds]

SLEEP 0 releases the current time-slice of the current thread to other threads/processes.

Since the current thread is not running, and GUI message pumps and callbacks are thread-specific, the GUI messages will not be processed for _that_ specific thread while the SLEEP statement is running.

However, the zero is a special case (as elsewhere noted above) - if no thread with at least the same priority is ready to run, execution resumes immediately.

------------------
Lance
PowerBASIC Support
mailto:[email protected][email protected]</A>