Announcement

**Dave Biggs** · 11 Oct 2007, 10:20 AM

Gösta,
This thread should help.. http://www.powerbasic.com/support/fo...ML/001478.html
and another good one in Pierre's link..

**Pierre Bellisle** · 11 Oct 2007, 10:36 AM

Also...

**Gösta H. Lovgren-2** · 11 Oct 2007, 11:12 AM

Thanks guys

I looked at both examples and decided to look at (incorporate) Maciej's example (Pierre's link) as it appears less cluttered to me (at this point).

I was under the (obviously mistaken) impression the Dialog scrolling would be handled by the Callback automatically.

Thanks for the replies

**Gösta H. Lovgren-2** · 11 Oct 2007, 11:55 AM

Works great

Scrollbar work GREAT. And Maciej's example is well commented.

Thanks again, guys. Ain't the PB Forums just grand? Life is good again.

**Gösta H. Lovgren-2** · 13 Oct 2007, 09:15 PM

Something neat (2 things actually).

The first:
After incorporating Maciej's scrollbar dialog routine, I ran across an unusual memory corruption. At least I think it was unusual. It took me a long time (couple days) to find. Some may have seen a couple posts here where I tout using a Macro (Common_Locals) to contain all Local variables.

I incorporated Common_Locals into the ScrollBar setup, thinking nothing of it, just had to add those variables needed for the routine to run. Okay scrollbar works BUT after if it is scrolled up and down several times, an artifact of the scrollbar appears just above and to the left and scrolling becomes erratic.

Having done a bunch of stuff before I found it I had know idea where the error came from. After a day or so of diddling around I figure the only thing left was to start transferring my stuff (Subs, Macros, etc.) to a a copy of Maciej's working perfectly example. You know the drill - Move a little, Run, Move a little, run, move a ...

And that's how I finally came across the Common_Locals problem. Code which should be runnable is below. See CallBack Function CB_Update_Patient for demostration. There must be some sort of improper in the macro but dogged if I can see it.

And the second thing:
If you can run the code, scroll down a screen or two and take look at how there are MULTIPLE "Save & Exit" buttons, all using the same Id_Number for the CallBack. I don't know if that is "accepted" programming or not but it seems to work (so far at least). Pretty cool I think.

'

Code:

--------------------------------------------------------------------
#Compile Exe
#Include "WIN32API.INC"
' #Include "C:\Power Basic\Includes\clipboard.inc"
' #Include "C:\Power Basic\Includes\colors.inc"
' #Include "C:\Power Basic\Includes\Fonts.inc"
'#Include "C:\Power Basic\Includes\commctrl.inc" 'contains spinner info
#Include "commctrl.inc" 'contains spinner info
'--------------------------------------------------------------------
%IDC_LABEL1 = 200     
%Btn_Save_Patient_Data = 1118
'
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
Global hdlg As Dword, hdlg1 As Dword, hdlg2 As Dword, hdlg3 As Dword
Global pnmud As nm_updown Ptr     'pointer to structure used by spinner     
Global Pat_Labels$(), Pat_Id&(), Pat_Content$()
Global g_Begin_Readings&, g_Stop_Readings&
%Box_Height = 12
%Letter_Len = 6
%Btn_Choose_Patient             = 1101
%Btn_Explanation                = 1102
%Btn_MicroLife                  = 1103
%Btn_Rpt_Gosta                  = 1104
%Btn_Rpt_Carol                  = 1105
%Btn_Run_WinWord                = 1106
%Dates_Okay    = 1107
%tb_Start_Date = 1108
%tb_Done_Date =  1109
%tb_date_label = 1110
%Start_Day_Spinner   = 1111
%Start_Month_Spinner = 1112
%Done_Month_Spinner  = 1113
%Start_Year_Spinner = 1114
%Done_Year_Spinner  = 1115
%Done_Day_Spinner    = 1116
%Btn_Update_Patient  = 1117
 
%Patient_List_Box   = 1130
%Lbl_Test           = 1131
'1200's being used for patient id's
 
$Add_New_Patient = "Add new Patient"
    'keep consistent style wherever used
    %spinner_style = %ws_child Or _  
                     %ws_visible Or _
                     %uds_wrap Or _
                     %uds_arrowkeys 
'                                
'BPA31.exe
'"  sys,dia,pls,PP,map,mam,ihd,"
Type BPD
  Sort As String * 25
  Date_String As String * 10 '2007/05/01
  Date As Long '20070501
  Days As Long 'total days
  Id As String * 25
  Time As String * 8 '10:40 AM
  Systolic  As Integer
  Diastolic As Integer
  Pulse     As Integer 
  PP As Integer
  Map As Integer
  Mam As String * 3
  Ihd As String * 3
  extra As String * 17
End Type 
 Global BP_Data() As BPD
 Global Xml_Data() As BPD
Type PD     
   ID As String * 25
   Family_Name As String * 15
   Given_Name As String * 15
   Address01  As String * 30'"12 Trenton Avenue",
   Address02  As String * 30'"12 Trenton Avenue",
   City As String * 60
   Phone As String * 30
   Fax As String * 30
   EMail  As String * 25 ',"732-793-4737 - [EMAIL="[email protected]"][email protected][/EMAIL]",
   Date_Of_Birth  As String * 12' ,1938/12/9,
   Age  As String * 4
   Weight As String * 8',195(lb),
   Height As String * 15',5/10(ft/In),
   Sex As String * 6',Male,
   Smoker As String * 50 'Yes,No,Occasional
   BMI As String * 10 
   Diabetic As String * 50 'Yes,No,Moderate, Severe
   Alcohol_Usage As String * 50 'No, Negligible, 1 a day, moderate, heavy
   Cholesterol(10) As String * 80
   Family_History As String * 2500'
   Patient_Notes As String  * 2500 '
   Notes_to_Doctor As String *600
   General_Doctor As String * 100
   Vitamins  As String * 1200
   Extra As String * 1200
End Type
  Global Patient_Data As PD
  Global Pat_Data() As pd
Type rod
  Date_String As String * 10 '2007/05/01
  Date As Long '20070501
End Type
  Global Reading_on_Days() As rod
'
Macro Common_Locals
  'Note to Self - 
  '       Use p_ prefix For variables being passed In Subs so As To 
  '       not conflict with Common_Locals
  '       ie Call Return_Number(p_x&), not (x&) 
   ErrClear                  
   Local  Avg&(), avg&, avg1&, avg2&
     Local Am_Dia&, Am_Sys&, Am_Pulse&, Am_pp&, Am_Map&, Am_Ctr&
   Local Btn_Len&, BpDat As Bpd, BP_Hdr$, BP_Use$, Boss$()
     Local Bmi!, b!, Btn_width&
   Local Chol_hdr$, Chol_use$,c$, Col&, col1&
     Register ctr&, ctr1& 'Register = faster execution in loops:
   Local dy&, d$(), d1$, Data_Hdr$, dt&, dl&(), Done_Report_Date&
     Local dwn&, Dlg_Width&
   Local End_Loop&
   Local fnum&, Flag&, Folder$, fil$, fn$, ft&, first& 
   Local h&, Half_Point&, Hght&, hdr$, hdr1$, hr&, ht&, hs&
     Local hProcess As Dword 'for shellexecute
     Local hFont_Arial As Dword
     Local hFont_Comic As Dword
     Local hFont_Courier As Dword
   Local id&, IHD_Ctr&, itr$, Iterate_Flag&, inch& 
     Register i&
   Local l$, ln&, Lnes&, lnes1&, Lines_Per_Page&, lRslt&, lRet& 
     Local lbl_Width&, lbl_Height&, lb&, last&, lbr&, lbl$, Last_id&
     Local Lbl_ForeColor&, lbl_BackColor&
   Local m$, mn&, mb$,  Micro_Life_Header As String * 80
   Local nl$, n$       
   Local ovr&, oldPos&
   Local p$, pp$, p1_Ctr&, p2_Ctr&, p3_Ctr&
     Local Pm_Dia&, Pm_Sys&, Pm_Pulse&, Pm_pp&, Pm_Map&, Pm_Ctr&
     Local p1$(), p2$(), p3$(), Psn_Dia&(), Psn_Sys&(), Psn_Pulse&()
     Local Patient_Data_Chol_Array_Elements&
   Local qt$
   Local recs&, Row&, Row1&, r$, Readings&, Readings_Ctr& 
   Local s$, Spcr&, Start_Loop&,  Stat_Ctr&, Stle&
     Local si As SCROLLINFO
   Local ttl&(), TB_Len&, t$, tmp&(), temp() As BPD
     Local tb_width&, tb_Height&, tb$, temp_id&
   Local ub&, ubr&, url$   
   Local vt&, vs&
   Local Wdth&, Weight_Target&, Wt&, w&
   Register x& 'faster execution in loops: ie. For x = 
   Local yr&, y&, y1$
   Local z&
   Local sys&(), Dia&(), Pulse&(), pp&(), Map&()  
' initialize scrollbar constants here
'  Local w As Long, h As Long, oldPos As Long, si As SCROLLINFO
'  Local vt As Long, ht As Long, hs As Long, vs As Long     
 
 
   m_Bounds_Set 'bound checks used so frequently
     Chol_hdr$ = "   Date   Sugar  Ttl   Hdl   Ldl   Try   Weight"  
     Chol_use$ = "\      \   ###   ###   ###   ###   ###      ###"
     BP_Hdr$ = "      Date       Time     Sys  Dia Pulse  Pp  Map   Mam   Ihd" 
     BP_Use$ = "\        \    \      \    ###  ###  ###  ###  ###   \ \   \ \ "
   Dim  tmp(4), Avg(1, 4)
   Patient_Data_Chol_Array_Elements = 10
   Lines_Per_Page = 45 'courier 12 gives 45
                       '  ""    11   "   50
                       '  ""    10   "   48
' Font Weights
'%FW_DONTCARE   = 0
'%FW_THIN       = 100
'%FW_EXTRALIGHT = 200
'%FW_LIGHT      = 300
'%FW_NORMAL     = 400
'%FW_MEDIUM     = 500
'%FW_SEMIBOLD   = 600
'%FW_BOLD       = 700
'%FW_EXTRABOLD  = 800
'%FW_HEAVY      = 900
'
'%FW_ULTRALIGHT = %FW_EXTRALIGHT
'%FW_REGULAR    = %FW_NORMAL
'%FW_DEMIBOLD   = %FW_SEMIBOLD
'%FW_ULTRABOLD  = %FW_EXTRABOLD
'%FW_BLACK      = %FW_HEAVY
         ' MakeFontEx(FontName, PointSize, fBold, fItalic, fUnderline)
  hFont_Courier = MakefontEx("Courier New", 9, %FW_NORMAL, %FALSE, %FALSE)
  hFont_Arial = MakefontEx("Arial",       10, %FW_Normal, %FALSE, %FALSE)
  hFont_Comic = MakefontEx("Comic MS Sans", 10, %FW_Normal, %TRUE,  %FALSE)
'  Control Send hDlg, %IDC_TextBox1, %WM_SETFONT, hFont_Courier, 0
 
 
 
   Micro_Life_Header = _
     " *** Microlife BP Monitor * Model BP 3AC1-1PC * 800-568-4147 ***"    
   Folder$ = CurDir$ & "\" 'file folder for files
   hdr$ = "*** Microlife Blood Pressure Monitor *** Model BP3AC1-1PC ***" 
   Close
End Macro               
'
'                    
Macro m_Bounds_Check_Readings   
   m_Bounds_Set
   If g_Begin_Readings < lbr Then
      g_Begin_Readings = lbr
      Beep
   End If
   If g_Stop_Readings > ubr Then
      g_Stop_Readings = ubr
      Beep
   End If
End Macro
'                        
'                
Macro m_Bounds_Set
   lbr = LBound(Reading_on_Days)
   ubr = UBound(Reading_on_Days)
   lb = LBound(Bp_Data)
   ub = UBound(Bp_Data)
End Macro
'                  
Macro pf = Print #Fnum,  
'                   
Macro m_Color_Label =  Control Set Color Hdlg3, temp_id,  Lbl_ForeColor, Lbl_BackColor
'
Macro m_Report_Name                       
   If Asc(Patient_Data.ID) < 65 Then
     fn$ = "None Chosen yet"
    Else
   'replace spaces in ID     
   s$ = Trim$(Patient_Data.ID, Chr$(32))
       Replace " " With "_" In s$            
'   fn$ =  Folder$ & s$ & ".Rpt"  
     fn$ = "C:\Medical\" & s$ & ".Rpt"
   End If
End Macro
'
Macro m_ML_Header
   pf Micro_Life_Header '& $CrLf    
End Macro
'
Macro m_Clip_Set
   Call Clipboard_Set_Text(c$) 
End Macro                        
'
Macro m_ExtractId
 t$ = Mid$(xml$(ctr), Len(s$) + 1)
  i = InStr(t$, "<")  
  Bp_Data(UBound(Bp_Data)).Id = Left$(t$, i - 1)
        'case of first starting up
       If InStr(Bp_Data(UBound(Bp_Data)).id, "1234567890") Then
          Bp_Data(UBound(Bp_Data)).id = "Boss"
       End If
End Macro
'
Macro m_ExtractMam
 t$ = Mid$(xml$(ctr), Len(s$) + 1)
  i = Val(t$)
  If i = 0 Then  
    Bp_Data(UBound(Bp_Data)).Mam = "No"
   Else
    Bp_Data(UBound(Bp_Data)).Mam = "Yes"
  End If  
End Macro
'
Macro m_ExtractDate
'<ReadingDate>2007-05-11T18:48:00.0000000-04:00</ReadingDate>
 t$ = Mid$(xml$(ctr), Len(s$) + 1, 10)
 
  Call BP_Convert_Date(t$, dt1&, dys&)
 Bp_Data(UBound(Bp_Data)).Date_String = t$
 Bp_Data(UBound(Bp_Data)).Date = dt1&
End Macro                
'
Macro m_ExtractTime
'<ReadingDate>2007-05-11T18:48:00.0000000-04:00</ReadingDate>
 t$ = Mid$(xml$(ctr), Len(s$) + 1)
 i = InStr(t$, "T")
 t$ = Mid$(t$, i + 1)
 t$ = Left$(t$, 5)
 hr = Val(t$)
 mn = Val(Right$(t$, 2))
' t$ = " AM"
 If hr < 12 Then 
    t$ = " am" 
   Else      
    t$ = " Pm"
 End If  
    If hr > 12 Then hr = hr - 12
 t$ = Using$("##:##", hr, mn) & t$
   If Mid$(t$, 4, 1) = " " Then  
      Mid$(t$, 4, 1) = "0"
   End If   
 Bp_Data(UBound(Bp_Data)).Time = t$
'MsgBox Using$("## ## ", hr, mn) & Bp_Data(UBound(Bp_Data)).Time,  %MB_TASKMODAL, " in " & FuncName$ 
End Macro
'
Macro m_ExtractNumber
 t$ = Mid$(xml$(ctr), Len(s$) + 1)
  i = Val(t$)
End Macro
'
Macro m_ExtractIhd 
 t$ = Mid$(xml$(ctr), Len(s$) + 1)
  i = Val(t$)
  If i = 1 Then  
    Bp_Data(UBound(Bp_Data)).Ihd = "No"
   Else
    Bp_Data(UBound(Bp_Data)).Ihd = "Yes"
  End If  
End Macro                
'
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------
Function MakeFontEx(ByVal FontName As String, _
                    ByVal PointSize As Long, _
                    ByVal fBold As Long, _
                    ByVal fItalic As Long, _
                    ByVal fUnderline As Long) As Long
 
  ' Borrowed from Borje Hagsten
  ' MakeFontEx(FontName, PointSize, fBold, fItalic, fUnderline)
 
  Local hDC As Long, CyPixels As Long
 
  hDC = GetDC(%HWND_DESKTOP)
  CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
  ReleaseDC %HWND_DESKTOP, hDC
  PointSize = 0 - (PointSize * CyPixels) \ 72
 
  Function = CreateFont( _
             PointSize, 0, _        'height, width(default=0)
             0, 0, _                'escapement(angle), orientation
             fBold, _               'weight (%FW_DONTCARE = 0, %FW_NORMAL = 400, %FW_BOLD = 700)
             fItalic, _             'Italic
             fUnderline, _          'Underline
             %FALSE, _              'StrikeThru - who needs it?
             %ANSI_CHARSET, %OUT_TT_PRECIS, _
             %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
             %FF_DONTCARE , ByCopy FontName)
 'Put below in Common_Locals code
'     Local hFont_Arial As Dword
'     Local hFont_Comic As Dword
'     Local hFont_Courier As Dword
'          ' MakeFontEx(FontName, PointSize, fBold, fItalic, fUnderline)
'  hFont_Courier = MakefontEx("Courier New", 12, %FW_NORMAL, %FALSE, %FALSE)
'  hFont_Arial = MakefontEx("Arial",       10, %FW_Normal, %FALSE, %FALSE)
'  hFont_Comic = MakefontEx("Comic MS Sans",       10, %FW_Normal, %TRUE,  %FALSE)
'  Control Send hDlg, %IDC_TextBox1, %WM_SETFONT, hFont1, 0
' Font Weights
'%FW_DONTCARE   = 0
'%FW_THIN       = 100
'%FW_EXTRALIGHT = 200
'%FW_LIGHT      = 300
'%FW_NORMAL     = 400
'%FW_MEDIUM     = 500
'%FW_SEMIBOLD   = 600
'%FW_BOLD       = 700
'%FW_EXTRABOLD  = 800
'%FW_HEAVY      = 900
'
'%FW_ULTRALIGHT = %FW_EXTRALIGHT
'%FW_REGULAR    = %FW_NORMAL
'%FW_DEMIBOLD   = %FW_SEMIBOLD
'%FW_ULTRABOLD  = %FW_EXTRABOLD
'%FW_BLACK      = %FW_HEAVY
 
End Function
'------------------------------------------------------------------
 
'
Sub Pers_Data_Gosta
   Common_Locals 
   Patient_Data.General_Doctor = "Patient_Data.General_Doctor"
   Patient_Data.ID = "Patient_Data.ID"
   Patient_Data.Family_Name = "Patient_Data.Family_Name" 
   Patient_Data.Given_Name = "Patient_Data.Given_Name" 
   Patient_Data.Address01 = "Patient_Data.Address01"
   Patient_Data.City  = "Lavallette, NJ 08735"
   Patient_Data.Phone = "Patient_Data.Phone"   
   Patient_Data.Fax =   "Patient_Data.Fax"   
   Patient_Data.EMail = "Patient_Data.EMail"   
   Patient_Data.Date_Of_Birth = "Patient_Data.Date_Of_Birth"              
   Patient_Data.Age = "Old" 
   Patient_Data.Weight = "195 lb" 
   Patient_Data.Height = "5'10" & Chr$(34) 
   Patient_Data.BMI = "27-28"    
   Patient_Data.Sex = "Male"  
    Patient_Data.Smoker = "Moderate to very heavy 30+ yrs- Stopped 1985"  'Yes,No,Occasional, Past
   Patient_Data.Diabetic = "No" 'Yes,No,Mild, Moderate, Severe
   Patient_Data.Alcohol_Usage = "Less than 1 drink per week."
  Reset x
'                                          Chol_hdr$ = "   Date   Sugar  Ttl   Hdl   Ldl   Try   Weight"  
'  0-10                                   Using$(Chol_Use$, "2007/09",  -1,  -1, -1,  -1,  -1, 165)  
           Patient_Data.Cholesterol(x) = Using$(Chol_Use$, "2002/09", -1, 193,  46, 126, 103)
   Incr x: Patient_Data.Cholesterol(x) = Using$(Chol_Use$, "2003/09", -1, 212,  54, 135, 115) 
   Incr x: Patient_Data.Cholesterol(x) = Using$(Chol_Use$, "2004/03", -1, 253,  62, 173,  89) 
   Incr x: Patient_Data.Cholesterol(x) = Using$(Chol_Use$, "2004/09", -1, 210,  46, 136, 136) 
   Incr x: Patient_Data.Cholesterol(x) = Using$(Chol_Use$, "2005/03", -1, 177,  44, 114,  92) & " After zetia For a year?" 
   Incr x: Patient_Data.Cholesterol(x) = Using$(Chol_Use$, "2006/03", -1, 202,  39, 141, 108) & " Nothing for a year? " 
   Incr x: Patient_Data.Cholesterol(x) = Using$(Chol_Use$, "2007/05", -1, 198,  56, 127,  77) & " After 4 cinnamon caps per day " 
   Incr x: Patient_Data.Cholesterol(x) = "  (after 4 Cholestless per day since above) " 
   Incr x: Patient_Data.Cholesterol(x) = "123456789 123456789212345678 312345678 412345678 512345678 612345678 712345678 8123456789 " 
   Incr x: Patient_Data.Cholesterol(x) = " " 
   'x = 10 
 
   Patient_Data.Family_History = _
     "Married 43 years, wife, 3 children, 5 grand children - all healthy." & $CrLf & _
     "No siblings." & $CrLf & _
     "Multiple disabling Strokes on Paternal Side (none immediately fatal)" & $CrLf & _
     "       Otherwise healthy. One diabetic uncle (went blind in later years)." & $CrLf & _
     "Mother - died of lung cancer in her early 60's" & $CrLf & _
     "       Both maternal grandparents died of cancer. (Oral & Lung)"
   Patient_Data.Patient_Notes  = _
     "Major disabling apoplexy (1985) - " &  $CrLf & _
     "Minoxydyl (since 1986?) (15mg) twice a day " & $CrLf & _
     "  (Incrementally increased from (10mg) once per day over the years)" & $CrLf & _
     "  Tried virtually every other BP therapy but none found as effective." &  $CrLf & _
     "Corguard (20mg) in AM (to mitigate tachycardia caused by minoxydil)" & $CrLf & _
     "Ecotrin (81mg) in AM"  & $CrLf & _
     "Ambien CR 12.5 mg in PM  "  & $CrLf & _
     $CrLf & _                  
     "EKG, Nuclear Test, Stress Test. Nov 2004 (Dr Escandon)- Everything Fine." & $CrLf & _
     "Colonoscopy May 2004 (Dr Aaron), next scheduled 2009, Annual visits." & $CrLf & _
     "Prostate biopsy Oct 2002 (Dr Bellingham), negative, " & $CrLf & _
     "   Diagnosed BHP which was alleviated With Flax Seed Oil capsules. " & $CrLf & _
     "   Annual visits." & $CrLf & _ 
     "  PSA counts:" & $CrLf & _
     "   2002/09 4.9 DRE found enlarged prostate. " & $CrLf & _
     "   2002/10 6.0 Had biopsy (negative) BHP diagnosed" & $CrLf & _
     "   2003/03 5.6 DRE prostate still enlarged" & $CrLf & _
     "   2003/06 ?.? DRE normal again (after starting flaxseed oil)" & $CrLf & _
     "   2004/05 4.8 DRE normal " & $CrLf & _
     "   2005/05 6.7 DRE normal " & $CrLf & _
     "   2006/06 8.6 DRE normal declined biopsy (strongly indicated) by doubling of PSA in 2 years." & $CrLf & _
     "   2007/06 7.5 DRE normal (had started using capsaicin In December '06 as a food seasoner 3-4 times a week)."   
   Patient_Data.Notes_To_Doctor  = "Space to write in questions to ask doctor. "
   Patient_Data.Vitamins = "" 'not used unless building a file
'BMI Formula: weight (lb) / [height (In)]2 x 703 
'Calculate BMI by dividing weight In pounds (lbs) 
'   by height In inches (In) squared
'   And multiplying by a conversion factor Of 703.
' Example: Weight = 150 lbs, Height = 5'5" (65")
'Calculation: [150 / (65)2] x 703 = 24.96
'  me 195 / (69" sq) * 703 = 28.79
'  or 195 / (70" sq) * 703 = 27.97   
'  or 195 / (71" sq) * 703 = 27.14   
End Sub
'                                 
'                       
CallBack Function CB_Update_Patient As Long
  ' If Common_Locals is remmed and the other Locals are 
  'un remmed, the dialog works as advertised
  '
  'However doing the reverse causes a scrollbar "artifact" to appear
  'and the dialog stops working after the scrollbar is moved up and down
  'several times (how many times varies).
 
   Common_Locals
  ' initialize scrollbar constants here
'  Local w As Long, h As Long, oldPos As Long, si As SCROLLINFO
'  Local vt As Long, ht As Long, hs As Long, vs As Long
 
'
'==========================================================================
'http://www.powerbasic.com/support/pbforums/showthread.php?t=24898&highlight=Maciej+NEYMAN+April+2006+07%3A51
'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE
'SCROLL BARS:   (try to experiment with these values)
'==========================================================================
    w = 600    'This is the number of dialog units by which the Dialog's Window
               'will scroll horizontaly if the thumb of the Scrolling Bar
               'travels between its extreme positions left and right
               'Reasonable (but not compulsory) value for it is between 200 to 2000
    h = 2250    'This is the number of dialog units by which the Dialog's Window
               'will scroll vertically if the thumb of the Scrolling Bar
               'travels between its extreme positions top and bottom
               'Reasonable (but not compulsory) value for it is between 200 to 1600
    vt = h\4'50    'length of the vertical scroll bar's thumb, this is also the amount
               'of dialog units by which the dialog will scroll verticaly if mouse is
               'clicked between the ends of the scroll bar and the thumb itself
               'reasonable value for it is between 10 and h/2
    ht = 50    'length of the horizontal scroling bar's thumb, this is also the amount
               'of dialog units by which the dialog will scroll horizontaly if mouse is
               'clicked between the ends of the scroll bar and the thumb itself
               'reasonable value for it is between 10 and w/2
    hs = 5     'number of dialog units by which the Dialog scrolls horizontaly when the
               'small arrow on either end of scroling bar is activated by mouse
               'reasonable values for it is between 1 and 30. Small value produces
               'smother but slower scrolling, the higher value is faster but more
               'jerki - the Dialog scrolls by steps determined by this value.
    vs = 50     'number of dialog units by which the Dialog scrolls verticaly when the
               'small arrow on either end of scroling bar is activated by mouse
               'reasonable values for it is between 1 and 30. Small value produces
               'smother but slower scrolling, the higher value is faster but more
               'jerki - the Dialog scrolls by steps determined by this value.
'----------------
   'If scroling by dialog units and not by pixels is giving you stomachache
   'remove REM from the next line.
   ' Dialog Units CbHndl, w, h To Pixels w, h
'==========================================================================
' This is all you have to decide upon, the rest just copy.
' If you remove all comments, the code become quite lean!
'==========================================================================
 
 
'
   Select Case CbMsg  ' this is to determine the message type returned by the program  
'
        Case %wm_initdialog '<- for processing that needs to occur when the program loads '
                            ' it only gets hit once when the program starts.
       ' initialize scrollbars here
       '---------------------------------------------------------------------------------
        si.cbSize = Len(si)                   ' get place holders for the si parameters
        si.fMask  = %SIF_ALL                  ' setting the topological space for the scroll bars
        si.nMin   = 0                         ' min scroll pos
        si.nMax   = h                         ' max scroll pos
        si.nPage  = vt                        ' lenght of the vertical scroll bar's thumb
        SetScrollInfo CbHndl, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents
                                              ' "TRUE" and causes redraw of the scroll bar
        '--------------------------------------------------------------------------------
        si.nMin   = 0                         ' min scroll pos
        si.nMax   = w                         ' max scroll pos
        si.nPage  = ht                        ' width of the horizontal scroll bar thumb
        si.nPos   = 0                         ' initial position of the thumbs
        SetScrollInfo CbHndl, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents
                                              ' "TRUE" and causes redraw of the scroll bar
        '--------------------------------------------------------------------------------
 
        Case %wm_command  'this processes command messages sent by windows
           Select Case As Long CbCtl
             '
             Case %IDCANCEL
                If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then 'end prog
                 Dialog End CbHndl
                End If
             '
             '
             Case %Btn_Save_Patient_Data
                MsgBox "  Btn_Save_Patient_Data  ",  %MB_TASKMODAL, " in " & FuncName$ 
                 Dialog End CbHndl
             '    
           End Select   
         '   
'GHL remmed because not used
'     Case %WM_HSCROLL  ' call from the horizontal scroll bar
'        si.cbSize = SizeOf(si)
'        si.fMask  = %SIF_ALL
'        GetScrollInfo CbHndl, %SB_HORZ, si
'        oldPos = si.nPos
'
'        Select Case LoWrd(CbWParam)
'            Case %SB_LINELEFT   : si.nPos = si.nPos - hs
'            Case %SB_PAGELEFT   : si.nPos = si.nPos - si.nPage
'            Case %SB_LINERIGHT  : si.nPos = si.nPos + hs
'            Case %SB_PAGERIGHT  : si.nPos = si.nPos + si.nPage
'            Case %SB_THUMBTRACK : si.nPos = HiWrd(CbWParam)
'            Case Else           : Exit Function
'        End Select
'
'        'To limit scroling range remove REM from the next line.
'        'If you don't then you can keep scrolling indefinitelly (well, almost)
'        'by using small arrrows on the end of the scroll bar.
'
'        'si.nPos = Max&(si.nMin, Min&(si.nPos, si.nMax - si.nPage))
'
'        ' Update the scroll bar and scroll the client area
'        si.fMask  = %SIF_POS
'        SetScrollInfo CbHndl, %SB_HORZ, si, 1     'remember new geometry of the horizontal scroll bar
'        ScrollWindow CbHndl, oldPos - si.nPos, 0, ByVal %Null, ByVal %Null   'actual scroling action
'        Function = 1
 
     Case %WM_VSCROLL  'call from the vertical scroll bar
        si.cbSize = SizeOf(si)
        si.fMask  = %SIF_ALL
        GetScrollInfo CbHndl, %SB_VERT, si
        oldPos = si.nPos
        Select Case LoWrd(CbWParam)
            Case %SB_LINEUP     : si.nPos = si.nPos - vs
            Case %SB_PAGEUP     : si.nPos = si.nPos - si.nPage
            Case %SB_LINEDOWN   : si.nPos = si.nPos + vs
            Case %SB_PAGEDOWN   : si.nPos = si.nPos + si.nPage
            Case %SB_THUMBTRACK : si.nPos = HiWrd(CbWParam)
            Case Else           : Exit Function
        End Select
        'To limit scroling range remove REM from the next line
        'If you don't then you can keep scrolling indefinitelly (well, almost)
        'by using small arrrows on the end of the scroll bar.
        'si.nPos = Max&(si.nMin, Min&(si.nPos, si.nMax - si.nPage + 1))
        ' Update the scroll bar and scroll the client area
        si.fMask = %SIF_POS
        SetScrollInfo CbHndl, %SB_VERT, si, 1    'remember new geometry of the vertical scroll bar
        ScrollWindow CbHndl, 0, oldPos - si.nPos, ByVal %Null, ByVal %Null  'actual scroling action
        Function = 1
    '         
 
   End Select
End Function
'             
'                                  
Sub Update_Patient_File
  Common_Locals
   Lbl_ForeColor = %Black
   lbl_BackColor = %Yellow
 
  If Asc(Patient_Data.Id) < 64 Then
'     Call Pers_Data_Sample
     Call Pers_Data_Gosta
  End If
 
'  Call Assign_Pat_Id_Arrays ' for control setup
 
    row = %box_height * 5 'row to begin drawing the dialog from the top og the screen     
    m$ = "Update  Patient ID = " & _
        Trim$(Patient_Data.ID) & "     Name " & _
        Trim$(Patient_Data.Given_Name) & " " & _
        Trim$(Patient_Data.Family_Name)
    Stle = %WS_POPUP Or %WS_SYSMENU Or %WS_VSCROLL Or %WS_HSCROLL Or %WS_MINIMIZEBOX Or %WS_MAXIMIZEBOX Or %WS_THICKFRAME
    Stle = %WS_CAPTION Or %WS_SYSMENU  'Or %WS_VSCROLL
    Dlg_Width = 500
      '
   Dialog New %HWND_DESKTOP, m$, _
              , , _ 'not specifying a row or column automatically centers the dialog
              Dlg_Width, 300, _
              stle _
              To hdlg3              
'              %ws_caption    Or _   
'              %WS_SYSMENU  Or %WS_VSCROLL _
 
  temp_id& = 5000 'high enough to not conflict with anything
  Stle = %SS_RIGHT 
  row  = 1'%Box_Height
  col  = 1 
  lbl_Width = Len(Patient_Data.Id) * 3
  tb_Width = 400
   Last_id = 1100
'   ID As String * 25                       
    id = 1101
     lbl$ = "Patient ID"
     tb$ = Patient_Data.Id
      GoSub Add_Control
'   Family_Name As String * 15
    id = 1102
     lbl$ = "Family Name"
     tb$ = Patient_Data.Family_Name
      GoSub Add_Control
'   Given_Name As String * 15
    id = 1103
     lbl$ = "Given Name"
     tb$ = Patient_Data.Given_Name
      GoSub Add_Control
'   Adddress01 As String * 30
    id = 1104
     lbl$ = "Street Address 1"
     tb$ = Patient_Data.Address01
      GoSub Add_Control
'   Adddress02 As String * 30
    id = 1105
     lbl$ = "Street Address 2"
     tb$ = Patient_Data.Address02
      GoSub Add_Control
'   City As String * 60
    id = 1106
     lbl$ = "City"
     tb$ = Patient_Data.City
      GoSub Add_Control
'   Phone As String * 30
    id = 1107
     lbl$ = "Phone"
     tb$ = Patient_Data.Phone
      GoSub Add_Control
'   Fax As String * 30
    id = 1108
     lbl$ = "Fax"
     tb$ = Patient_Data.Fax
      GoSub Add_Control
'   EMail  As String * 25 ',"732-793-4737 - [EMAIL="[email protected]"][email protected][/EMAIL]",
    id = 1109
     lbl$ = "Email"
     tb$ = Patient_Data.Email
      GoSub Add_Control
'   Date_Of_Birth  As String * 12' ,1938/12/9,
    id = 1110
     lbl$ = "Date of Birth"
     tb$ = Patient_Data.Date_of_Birth
      GoSub Add_Control
'   Age  As String * 4
    id = 1111
     lbl$ = "Age"
     tb$ = Patient_Data.Age
      GoSub Add_Control
'   Weight As String * 8',195(lb),
    id = 1112
     lbl$ = "Weight"
     tb$ = Patient_Data.Weight
      GoSub Add_Control
'   Height As String * 15',5/10(ft/In),
    id = 1113
     lbl$ = "Height"
     tb$ = Patient_Data.Height
      GoSub Add_Control
'   Sex As String * 6',Male,
    id = 1114
     lbl$ = "Sex"
     tb$ = Patient_Data.Sex
      GoSub Add_Control
'   Smoker As String * 50 'Yes,No,Occasional
    id = 1115
     lbl$ = "Smoking data"
     tb$ = Patient_Data.Smoker
      GoSub Add_Control
'   BMI As String * 60 
    id = 1116
     lbl$ = "Body Mass Index"
     tb$ = Patient_Data.BMI
      GoSub Add_Control
'   Diabetic As String * 50 'Yes,No,Moderate, Severe
    id = 1117
     lbl$ = "Date of Birth"
     tb$ = Patient_Data.Date_of_Birth
      GoSub Add_Control
'   Alcohol_Usage As String * 50 'No, Negligible, 1 a day, moderate, heavy
    id = 1118
     lbl$ = "Alcohol Usage"
     tb$ = Patient_Data.Alcohol_Usage
      GoSub Add_Control
'   Cholesterol(10) As String * 75
'  row = row + %Box_Height
  lbl$ = "   Date   Sugar  Ttl   Hdl   Ldl   Try   Weight       Notes "  
  Incr temp_id
  Control Add Label, Hdlg3, temp_id, lbl$, _
     Col + lbl_Width + 10, Row, _
     Len(lbl$) * 6, %Box_Height, _
     %SS_Left Or %SS_CENTERIMAGE 
    m_color_Label
  Control Send hDlg3, temp_id, %WM_SETFONT, hFont_Courier, 0
  row = row + %Box_Height
   For x = 0 To 10
    id = 1119 + x '1119 next up
     lbl$ = "Cholesterol " & Using$("(#)", x)
     tb$ = Patient_Data.Cholesterol(x) & "xxx"
      GoSub Add_Control
      Control Send hDlg3, id, %WM_SETFONT, hFont_Courier, 0
   Next x  
   GoSub Add_Buttons_Row 'Quit buttons
'   Family_History As String * 2500'
  row = row + %Box_Height 'insert a space for readability
    id = 1130 'next id
     lbl$ = "Family History"
     tb$ = Patient_Data.Family_History
      GoSub Add_Control
   GoSub Add_Buttons_Row 'Quit buttons
   '   Patient_Notes As String  * 2500 '
  id = 1131
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "Patient Notes"
     tb$ = Patient_Data.Patient_Notes
      GoSub Add_Control
   GoSub Add_Buttons_Row 'Quit buttons
'   Notes_to_Doctor As String *600
  id = 1132
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "Notes to Doctor"
     tb$ = Patient_Data.Notes_to_Doctor
      GoSub Add_Control
   GoSub Add_Buttons_Row 'Quit buttons
'   General_Doctor As String * 100
  id = 1133
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "General Doctor"
     tb$ = Patient_Data.General_Doctor
      GoSub Add_Control
   GoSub Add_Buttons_Row 'Quit buttons
'   Vitamins  As String * 1200
  id = 1134
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "Vitamins Taken"
     tb$ = Patient_Data.Vitamins
      GoSub Add_Control
   GoSub Add_Buttons_Row 'Quit buttons
'   Extra As String * 1200
    Dialog Show Modal hdlg3  Call CB_Update_Patient 
   Exit Sub 
'
Add_Control:  
  If id <> Last_Id + 1 Then    'id check
    MsgBox Str$(id) & " Ids not consistent ",  %MB_TASKMODAL, " in " & FuncName$ 
  End If
  Last_Id = id                
 
  tb_width = Len(tb$) * 5
  tb_Height = %Box_Height
  'case of big fields
  If tb_Width > 375 Then
     Tb_Height = (tb_width \ 375) * %Box_Height
     tb_Width = 375
  End If
  Incr temp_id
  Control Add Label, Hdlg3, temp_id, lbl$ & Using$("  # ", id), _
     Col, Row, _
     lbl_Width, %Box_Height, Stle         
    m_color_Label
 
  Control Add TextBox, Hdlg3, Id, tb$, _
     Col + lbl_Width + 10, Row, _
     tb_width, tb_Height, _
     %ES_LEFT Or %ES_MULTILINE       
  Control Send hDlg3, id, %WM_SETFONT, hFont_Courier, 0
  row = row + %Box_Height + 2                         
Return
'
'                      
Add_Button:
  Control Add Button, Hdlg3, Id, Btn_lbl$, _
     Col, Row, _
     Btn_width, %Box_Height, _
     %BS_Center       
  row = row + %Box_Height + 2                         
Return
'                      
'   GoSub Add_Buttons_Row 'Quit buttons
Add_Buttons_Row:
  col1 = col 'save for return
  row1 = row
     id = %Btn_Save_Patient_Data
     lbl$ = " Save Data and Exit "
     row = row + tb_Height - %Box_Height 
     Col = (Dlg_Width \ 2) - (lbl_Width \ 2) 'center
   GoSub Add_Buttons_Row_Add 'so as to have multiple buttons
 
  Col = col1                           
  row = row1                           
Return
'
Add_Buttons_Row_Add:
  Control Add Button, Hdlg3, Id, lbl$, _
     Col, Row, _
     lbl_width, %Box_Height, _
     %BS_Center       
Return
'
End Sub
'                                  
 
' end GHL added
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Dialog and Controls setup
'--------------------------------------------------------------------
Function PBMain () As Long
   Call Update_Patient_File
 
   Local hDlg As Dword
  Dialog New 0, "Dialog's Scroll Bars ",,, 500, 300, _
  %WS_CAPTION Or %WS_SYSMENU Or %WS_MAXIMIZEBOX Or %WS_MINIMIZEBOX,  To hDlg
  Dialog Set Color hDlg, -1, RGB(74, 164, 74)
  '------------------------------------------------------------------
  Control Add Label, hDlg, %IDC_LABEL1, "Keep scrolling !", 100, 100, 300, 200
  Control Set Color hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74)
 
'       GHL Added here  
  Common_Locals 'set variables  
 
  Call Pers_Data_Gosta 'for demo purposes
 
  temp_id& = 5000 'high enough to not conflict with anything
  Stle = %SS_RIGHT Or %SS_CENTERIMAGE  'for labels      
  row  = 400 'below "Keep scrolling box"
  col  = 1 
  lbl_Width = 75'Len(Patient_Data.Id) * 3
  tb_Width = 400
   Last_id = 1100
'   ID As String * 25                       
    id = 1101
     lbl$ = "Patient ID"
     tb$ = Patient_Data.Id
      GoSub Add_Control
'   Family_Name As String * 15
    id = 1102
     lbl$ = "Family Name"
     tb$ = Patient_Data.Family_Name
      GoSub Add_Control
'   Given_Name As String * 15
    id = 1103
     lbl$ = "Given Name"
     tb$ = Patient_Data.Given_Name
      GoSub Add_Control
'   Adddress01 As String * 30
    id = 1104
     lbl$ = "Street Address 1"
     tb$ = Patient_Data.Address01
      GoSub Add_Control
'   Adddress02 As String * 30
    id = 1105
     lbl$ = "Street Address 2"
     tb$ = Patient_Data.Address02
      GoSub Add_Control
'   City As String * 60
    id = 1106
     lbl$ = "City"
     tb$ = Patient_Data.City
      GoSub Add_Control
'   Phone As String * 30
    id = 1107
     lbl$ = "Phone"
     tb$ = Patient_Data.Phone
      GoSub Add_Control
'   Fax As String * 30
    id = 1108
     lbl$ = "Fax"
     tb$ = Patient_Data.Fax
      GoSub Add_Control
'   EMail  As String * 25 ',"732-793-4737 - [EMAIL="[email protected]"][email protected][/EMAIL]",
    id = 1109
     lbl$ = "Email"
     tb$ = Patient_Data.Email
      GoSub Add_Control
'   Date_Of_Birth  As String * 12' ,1938/12/9,
    id = 1110
     lbl$ = "Date of Birth"
     tb$ = Patient_Data.Date_of_Birth
      GoSub Add_Control
'   Age  As String * 4
    id = 1111
     lbl$ = "Age"
     tb$ = Patient_Data.Age
      GoSub Add_Control
'   Weight As String * 8',195(lb),
    id = 1112
     lbl$ = "Weight"
     tb$ = Patient_Data.Weight
      GoSub Add_Control
'   Height As String * 15',5/10(ft/In),
    id = 1113
     lbl$ = "Height"
     tb$ = Patient_Data.Height
      GoSub Add_Control
'   Sex As String * 6',Male,
    id = 1114
     lbl$ = "Sex"
     tb$ = Patient_Data.Sex
      GoSub Add_Control
'   Smoker As String * 50 'Yes,No,Occasional
    id = 1115
     lbl$ = "Smoking data"
     tb$ = Patient_Data.Smoker
      GoSub Add_Control
'   BMI As String * 60 
    id = 1116
     lbl$ = "Body Mass Index"
     tb$ = Patient_Data.BMI
      GoSub Add_Control
'   Diabetic As String * 50 'Yes,No,Moderate, Severe
    id = 1117
     lbl$ = "Date of Birth"
     tb$ = Patient_Data.Date_of_Birth
      GoSub Add_Control
'   Alcohol_Usage As String * 50 'No, Negligible, 1 a day, moderate, heavy
    id = 1118
     lbl$ = "Alcohol Usage"
     tb$ = Patient_Data.Alcohol_Usage
      GoSub Add_Control
'   Cholesterol(10) As String * 75
'  row = row + %Box_Height
  lbl$ = "   Date   Sugar  Ttl   Hdl   Ldl   Try   Weight       Notes "  
  Incr temp_id
  Control Add Label, Hdlg, temp_id, lbl$, _
     Col + lbl_Width + 10, Row, _
     Len(lbl$) * 6, %Box_Height, _
     %SS_Left Or %SS_CENTERIMAGE 
    m_color_Label
  Control Send hDlg, temp_id, %WM_SETFONT, hFont_Courier, 0
  row = row + %Box_Height + 2
   For x = 0 To 10
    id = 1119 + x '1119 next up
     lbl$ = "Cholesterol " & Using$("(#)", x)
     tb$ = Patient_Data.Cholesterol(x) & "xxx"
      GoSub Add_Control
      Control Send hDlg, id, %WM_SETFONT, hFont_Courier, 0
   Next x  
'   Family_History As String * 2500'
  row = row + %Box_Height 'insert a space for readability
    id = 1130 'next id
     lbl$ = "Family History"
     tb$ = Patient_Data.Family_History
      GoSub Add_Control
'   Patient_Notes As String  * 2500 '
  id = 1131
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "Patient Notes"
     tb$ = Patient_Data.Patient_Notes
      GoSub Add_Control
'   Notes_to_Doctor As String *600
  id = 1132
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "Notes to Doctor"
     tb$ = Patient_Data.Notes_to_Doctor
      GoSub Add_Control
'   General_Doctor As String * 100
  id = 1133
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "General Doctor"
     tb$ = Patient_Data.General_Doctor
      GoSub Add_Control
'   Vitamins  As String * 1200
  id = 1134
  row = row + tb_Height + %Box_Height 'insert a space for readability
     lbl$ = "Vitamins Taken"
     tb$ = Patient_Data.Vitamins
      GoSub Add_Control
'   Extra As String * 1200
 
 
  '------------------------------------------------------------------
  Dialog Show Modal hDlg Call DlgProc
 
'GHL added
  Exit Function
Add_Control:  
  If id <> Last_Id + 1 Then    'id check
    MsgBox Str$(id) & " Ids not consistent ",  %MB_TASKMODAL, " in " & FuncName$ 
  End If
  Last_Id = id                
 
  tb_width = Len(tb$) * 5
  tb_Height = %Box_Height
  'case of big fields
  If tb_Width > 375 Then
     Tb_Height = (tb_width \ 375) * %Box_Height
     tb_Width = 375
  End If
  Incr temp_id
  Control Add Label, Hdlg, temp_id, lbl$ & Using$("  # ", id), _
     Col, Row, _
     lbl_Width, %Box_Height, Stle
    m_color_Label
 
  Control Add TextBox, Hdlg, Id, tb$, _
     Col + lbl_Width + 10, Row, _
     tb_width, tb_Height, _
     %ES_LEFT Or %ES_MULTILINE       
  Control Send hDlg, id, %WM_SETFONT, hFont_Courier, 0
  row = row + %Box_Height + 2                         
Return
 
End Function
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main callback
'--------------------------------------------------------------------
CallBack Function DlgProc() As Long
 
  ' initialize scrollbar constants here
  Local w As Long, h As Long, oldPos As Long, si As SCROLLINFO
  Local vt As Long, ht As Long, hs As Long, vs As Long
'==========================================================================
'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE
'SCROLL BARS:   (try to experiment with these values)
'==========================================================================
    w = 600    'This is the number of dialog units by which the Dialog's Window
               'will scroll horizontaly if the thumb of the Scrolling Bar
               'travels between its extreme positions left and right
               'Reasonable (but not compulsory) value for it is between 200 to 2000
        'GHL was 400
    h = 3000    'This is the number of dialog units by which the Dialog's Window
               'will scroll verticaly if the thumb of the Scrolling Bar
               'travels between its extreme positions top and bottom
               'Reasonable (but not compulsory) value for it is between 200 to 1600
    vt = h\4'50    'lenght of the vertical scroll bar's thumb, this is also the amount
               'of dialog units by which the dialog will scroll verticaly if mouse is
               'clicked between the ends of the scroll bar and the thumb itself
               'reasonable value for it is between 10 and h/2
    ht = 50    'lenght of the horizontal scroling bar's thumb, this is also the amount
               'of dialog units by which the dialog will scroll horizontaly if mouse is
               'clicked between the ends of the scroll bar and the thumb itself
               'reasonable value for it is between 10 and w/2
    hs = 5     'number of dialog units by which the Dialog scrolls horizontaly when the
               'small arrow on either end of scroling bar is activated by mouse
               'reasonable values for it is between 1 and 30. Small value produces
               'smother but slower scrolling, the higher value is faster but more
               'jerki - the Dialog scrolls by steps determined by this value.
    vs = 50     'number of dialog units by which the Dialog scrolls verticaly when the
               'small arrow on either end of scroling bar is activated by mouse
               'reasonable values for it is between 1 and 30. Small value produces
               'smother but slower scrolling, the higher value is faster but more
               'jerki - the Dialog scrolls by steps determined by this value.
'----------------
   'If scroling by dialog units and not by pixels is giving you stomachache
   'remove REM from the next line.
   Rem Dialog Units CbHndl, w, h To Pixels w, h
'==========================================================================
' This is all you have to decide upon, the rest just copy.
' If you remove all comments, the code become quite lean!
'==========================================================================
  Select Case CbMsg
     Case %WM_INITDIALOG
       ' initialize scrollbars here
       '---------------------------------------------------------------------------------
        si.cbSize = Len(si)                   ' get place holders for the si parameters
        si.fMask  = %SIF_ALL                  ' setting the topological space for the scroll bars
        si.nMin   = 0                         ' min scroll pos
        si.nMax   = h                         ' max scroll pos
        si.nPage  = vt                        ' lenght of the vertical scroll bar's thumb
        SetScrollInfo CbHndl, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents
                                              ' "TRUE" and causes redraw of the scroll bar
        '--------------------------------------------------------------------------------
        si.nMin   = 0                         ' min scroll pos
        si.nMax   = w                         ' max scroll pos
        si.nPage  = ht                        ' width of the horizontal scroll bar thumb
        si.nPos   = 0                         ' initial position of the thumbs
        SetScrollInfo CbHndl, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents
                                              ' "TRUE" and causes redraw of the scroll bar
        '--------------------------------------------------------------------------------
 
     Case %WM_COMMAND      ' <- a control is calling
        Select Case CbCtl  ' <- look at control's id
           Case %IDCANCEL
              If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then 'end prog
                 Dialog End CbHndl
              End If
        End Select
 
     Case %WM_HSCROLL  ' call from the horizontal scroll bar
        si.cbSize = SizeOf(si)
        si.fMask  = %SIF_ALL
        GetScrollInfo CbHndl, %SB_HORZ, si
        oldPos = si.nPos
        Select Case LoWrd(CbWParam)
            Case %SB_LINELEFT   : si.nPos = si.nPos - hs
            Case %SB_PAGELEFT   : si.nPos = si.nPos - si.nPage
            Case %SB_LINERIGHT  : si.nPos = si.nPos + hs
            Case %SB_PAGERIGHT  : si.nPos = si.nPos + si.nPage
            Case %SB_THUMBTRACK : si.nPos = HiWrd(CbWParam)
            Case Else           : Exit Function
        End Select
        'To limit scroling range remove REM from the next line.
        'If you don't then you can keep scrolling indefinitelly (well, almost)
        'by using small arrrows on the end of the scroll bar.
    Rem    si.nPos = Max&(si.nMin, Min&(si.nPos, si.nMax - si.nPage))
        ' Update the scroll bar and scroll the client area
        si.fMask  = %SIF_POS
        SetScrollInfo CbHndl, %SB_HORZ, si, 1     'remember new geometry of the horizontal scroll bar
        ScrollWindow CbHndl, oldPos - si.nPos, 0, ByVal %Null, ByVal %Null   'actual scroling action
        Function = 1
 
     Case %WM_VSCROLL  'call from the vertical scroll bar
        si.cbSize = SizeOf(si)
        si.fMask  = %SIF_ALL
        GetScrollInfo CbHndl, %SB_VERT, si
        oldPos = si.nPos
        Select Case LoWrd(CbWParam)
            Case %SB_LINEUP     : si.nPos = si.nPos - vs
            Case %SB_PAGEUP     : si.nPos = si.nPos - si.nPage
            Case %SB_LINEDOWN   : si.nPos = si.nPos + vs
            Case %SB_PAGEDOWN   : si.nPos = si.nPos + si.nPage
            Case %SB_THUMBTRACK : si.nPos = HiWrd(CbWParam)
            Case Else           : Exit Function
        End Select
        'To limit scroling range remove REM from the next line
        'If you don't then you can keep scrolling indefinitelly (well, almost)
        'by using small arrrows on the end of the scroll bar.
    Rem    si.nPos = Max&(si.nMin, Min&(si.nPos, si.nMax - si.nPage + 1))
        ' Update the scroll bar and scroll the client area
        si.fMask = %SIF_POS
        SetScrollInfo CbHndl, %SB_VERT, si, 1    'remember new geometry of the vertical scroll bar
        ScrollWindow CbHndl, 0, oldPos - si.nPos, ByVal %Null, ByVal %Null  'actual scroling action
        Function = 1
  End Select
End Function
'------------------
 
'[This message has been edited (some spelling) by Maciej NEYMAN (edited January 08, 2005).]
'
'[This message has been edited by Maciej NEYMAN (edited January 17, 2005).]
'    
'Copyright © 1999-2007 PowerBASIC, Inc. All Rights Reserved. 
'

**Pierre Bellisle** · 14 Oct 2007, 05:19 PM

Hey Gösta,

Problem come from the fact that
"Common_Locals" macro contain some functions
and it is positionned outside the "SELECT CASE CBMSG".
This, for example, make "MakeFontEx" to be called
every time Windows send a message to your CALLBACK.
And this is a lot of times...

Put this "Common_Locals" in %WM_INITDIALOG and everything should run fine.
The ScrollBar variable initialisation (w, h, vt, ht, hs and vs)
could also be moved there.

Also, just in case, beware that hDlg is both declared as LOCAL and GLOBAL.

**Gösta H. Lovgren-2** · 14 Oct 2007, 09:20 PM

Originally posted by Pierre Bellisle View Post

Hey Gösta,

Problem come from the fact that
"Common_Locals" macro contain some functions
and it is positionned outside the "SELECT CASE CBMSG".
This, for example, make "MakeFontEx" to be called
every time Windows send a message to your CALLBACK.
And this is a lot of times...

Put this "Common_Locals" in %WM_INITDIALOG and everything should run fine.

Boy, now why didn't I think of that? Good catch, Pierre. {shaking head sadly} I know that too but just never think of (forget) how many times a CallBack is called. Still in "Dos Mind Mode" (DMM, pronounced "DIM"), I guess.

The ScrollBar variable initialisation (w, h, vt, ht, hs and vs)
could also be moved there.

Ha! Now that one should be laid directly at the feet of Maciej. After all, it's his code I copied. {just kidding}

Also, just in case, beware that hDlg is both declared as LOCAL and GLOBAL.

Another something I should have seen myself.

Okay, I made the change to the sample code (eliminated the Global,Local hdlg ) but still got the artifact. Then moved the Common_Locals inside the InitDialog and the artifact disappearred. You hit it right on the head. Thanks Pierre.

Boy ain't this forum just grand?

================================================================
Let each man exercise the art he knows.
Aristophanes
================================================================

**Pierre Bellisle** · 14 Oct 2007, 11:02 PM

>> Still in "Dos Mind Mode"

I think it's one of the must dificult reflex to get rid of.

====================================================================
Of course, it's the old Maciej code outside %wm_initdialog trick !!!

Maxwell Smart & Maciej as K.A.O.S. agent.
====================================================================

Announcement

Scroll bar not responding

Scroll bar not responding

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment