Announcement

Collapse
No announcement yet.

How to use max. processor capacity?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Lance Edmonds
    replied
    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>

    Leave a comment:


  • Eddy Van Esch
    replied
    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]

    Leave a comment:


  • Lance Edmonds
    replied
    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>

    Leave a comment:


  • Bernard Chapman
    replied
    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:

    Code:
    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

    Leave a comment:


  • Eddy Van Esch
    replied
    Folks,
    I replaced the DIALOG DOEVENTS with a call to DoEventsAPI (as found on
    different threads in these forums):
    Code:
    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]

    Leave a comment:


  • Russ Srole
    replied
    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


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

    Leave a comment:


  • Brad D Byrne
    replied
    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

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

    Leave a comment:


  • Jim Barber
    Guest replied
    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


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

    Leave a comment:


  • Lance Edmonds
    replied
    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>

    Leave a comment:


  • Michael Mattias
    replied
    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

    Leave a comment:


  • Florent Heyworth
    replied
    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

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

    Leave a comment:


  • Eddy Van Esch
    replied
    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]

    Leave a comment:


  • Lance Edmonds
    replied
    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>

    Leave a comment:


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


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

    Leave a comment:


  • Eddy Van Esch
    started a topic How to use max. processor capacity?

    How to use max. processor capacity?

    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:
    Code:
    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
    Code:
    ' *************************************************************
    '                    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]
Working...
X