' Empty GUI script created on 12-16-2011 11:51:36 by largo_winch (ThinAIR)
' Empty GUI script created on 12-27-2011 15:32:11 by largo_winch (ThinAIR)
'------------------------------------------------------------------------------
' MLGrid Example: basic example
'------------------------------------------------------------------------------
#MINVERSION 1.8.9.0
Uses "UI"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Randomize
Begin ControlID
%IDC_MLGRID
%Canvas_Gdip
%bClose
%IDC_LABEL1
%IDC_LABEL2
%IDC_TEXTBOX1
%IDC_LABEL3
%IDC_TEXTBOX2
%IDC_LABEL4
%IDC_TEXTBOX3
%IDC_BUTTON1
%ButtonClose
End ControlID
'----------------------------------------------------------------------------
Function TBMain() As Long
'----------------------------------------------------------------------------
Local hDlg As Long '---Used to store window handle
Local Count As Long
Local hr As Long
Local hdc As Long
Local token As Long
Local StartupInput As GdiplusStartupInput
' Initialize GDI+
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, ByVal %NULL)
If hr Then
MsgBox "Error initializing GDI+"
Exit Function
End If
'---Create a new dialog
Dialog New Pixels, 0, "thinBasic_BodyMassIndex Calculator 1.0", -1, -1, 640, 480, _
%WS_DLGFRAME | _
%DS_CENTER | _
%WS_CAPTION | _
%WS_SYSMENU | _
%WS_OVERLAPPEDWINDOW | _
%WS_CLIPCHILDREN, _
0 To hDlg
Control Add Label, hDlg, %IDC_LABEL1, _
"Calculation of Body Mass Index (BMI):", 330, 15, 355, 20
Control Add Label, hDlg, %IDC_LABEL2, "Body Weight", 345, 50, 70, 20
Control Add Textbox, hDlg, %IDC_TEXTBOX1, " ", 425, 45, 80, 22, _
%WS_TABSTOP Or %WS_BORDER Or %ES_NUMBER, %WS_EX_CLIENTEDGE
Control Add Label, hDlg, %IDC_LABEL3, "Body Height", 345, 80, 70, 20
Control Add Textbox, hDlg, %IDC_TEXTBOX2, " ", 425, 75, 80, 22, _
%WS_TABSTOP Or %WS_BORDER Or %ES_NUMBER, %WS_EX_CLIENTEDGE
Control Add Label, hDlg, %IDC_LABEL4, "Bmi Index:", 345, 110, 70, 20
Control Add Textbox, hDlg, %IDC_TEXTBOX3, " ", 425, 105, 80, 22, _
%WS_BORDER Or %ES_READONLY, %WS_EX_CLIENTEDGE
Control Add Button, hDlg, %IDC_BUTTON1, "Calculation",435,154,105,20
Control Add Button, hDlg, %IDCANCEL, "program_end",435,214,105,20, Call bCloseProc
'---Set window minimum size
Dialog Set Minsize hDlg, 408, 206
'---Show dialog
Dialog Show Modeless hDlg, Call cbDialog_Proc
Do
Dialog DoEvents 0 To Count
Loop While Count
' Shutdown GDI+
GdiplusShutdown token
End Function
'------------------------------------------------------------------------------
' Callback procedure for main window
'------------------------------------------------------------------------------
CallBack Function cbDialog_Proc() As Long
'------------------------------------------------------------------------------
Static hGrid As Long '---Defined as statis so at every callback run it will be available
Local Counter As Long
Local w1, w2, h1, h2 As Long
Local lRow, lCol As Long
Local txt As String
Local l,b,f,g As double
Select Case CBMSG
Case %WM_INITDIALOG
Local cx, cy As Long, hDc As Long
'---Add controls
hGrid = Control Add MLGrid, CBHNDL, %IDC_MLGRID, "", _
10, 250, 0, 0, %WS_VISIBLE Or %WS_CHILD Or %WS_BORDER', Call cbGrid
MLGrid_Redim hGrid, 8, 8, 8, 8
MLGrid_SetColumnWidth hGrid, 1, 90, 80, 80, 80, 80, 60, 80
'MLGRID_SetColumnWidth hGrid, 1, 80, 40, 40, 40, 50, 40, 80
MLGrid_SetHeaderColor hGrid, %RGB_LAVENDER
MLGrid_SetGridColors hGrid, Rgb(140,140,255), Rgb(140,240,250), %RGB_LAVENDER
MLGrid_Sheet_SetName hGrid, 1, "Base"
'---Add other 5 sheets
MLGrid_Sheet_Add hGrid, "Matrix 1", 200,100 '---Number of rows and columns will be the same as BASE
MLGrid_Sheet_Add hGrid, "Matrix 2", 200, 32 '--- 200 rows, 32 columns
MLGrid_Sheet_Add hGrid, "Matrix 3", 500, 100 '--- 500 rows, 100 columns
MLGrid_Sheet_Add hGrid, "Matrix 4", 500, 100 '--- 500 rows, 100 columns
MLGrid_Sheet_Add hGrid, "Matrix 5", 500, 100 '--- 500 rows, 100 columns
MLGrid_Sheet_Select hGrid, 1
'---------------------------------------------> "WHO" BMI VALUES ------->
'BMI männlich BMI weiblich
'Untergewicht unter 20 unter 19
'Normalgewicht 20-25 19-24
'Übergewicht 26-30 25-30
'Adipositas 31-40 31-40
'starke Adipositas größer 40 größer 40
'---------------------------------------------> "WHO" BMI VALUES ------->
'BMI in relationship to age - ideal BMI --------->
'BMI = x KG / (y M * y M)
'x=Körpergewicht In KG
'y=Größe In M
'BMI In Abhängigkeit vom Alter Alter idealer BMI
'19-24 Jahre 19-24
'25-34 Jahre 20-25
'35-44 Jahre 21-26
'45-54 Jahre 22-27
'55-64 Jahre 23-28
'über 64 Jahre 24-29
'---------------------------------------------> "WHO" BMI VALUES ------->
'---Fill cell 1:1
MLGrid_Put(hgrid, 1, 1, "", %TRUE)
MLGrid_Put(hgrid, 1, 2, "BMI man ", %TRUE)
MLGrid_Put(hgrid, 1, 3, "BMI woman", %TRUE)
MLGrid_Put(hgrid, 2, 1, "UnderWeight", %TRUE)
MLGrid_Put(hgrid, 3, 1, "NormalWeight", %TRUE)
MLGrid_Put(hgrid, 4, 1, "OverWeight", %TRUE)
MLGrid_Put(hgrid, 5, 1, "Adipositas", %TRUE)
MLGrid_Put(hgrid, 6, 1, "heavy Adipositas", %TRUE)
MLGrid_Put(hgrid, 2, 2, "less 20", %TRUE)
MLGrid_Put(hgrid, 2, 3, "less 19", %TRUE)
MLGrid_Put(hgrid, 2, 5, "critical", %TRUE)
MLGrid_Put(hgrid, 2, 4, "", %TRUE)
'---Change column/row header
MLGrid_Put(hgrid, 0, 1, "Col A", %TRUE)
MLGrid_Put(hgrid, 1, 0, "Row 1", %TRUE)
MLGrid_Put(hgrid, 3, 2, "20-25", %TRUE)
MLGrid_Put(hgrid, 2, 4, "call doctor", %TRUE)
MLGrid_Put(hgrid, 3, 4, "very good", %TRUE)
MLGrid_Put(hgrid, 3, 3, "19-24", %TRUE)
MLGrid_Put(hgrid, 3, 5, "compliment", %TRUE)
MLGrid_Put(hgrid, 4, 2, "26-30", %TRUE)
MLGrid_Put(hgrid, 4, 3, "25-30", %TRUE)
MLGrid_Put(hgrid, 4, 4, "call doctor", %TRUE)
MLGrid_Put(hgrid, 4, 5, "critical", %TRUE)
MLGrid_Put(hgrid, 5, 2, "31-40", %TRUE)
MLGrid_Put(hgrid, 5, 3, "31-40", %TRUE)
MLGrid_Put(hgrid, 5, 4, "call doctor", %TRUE)
MLGrid_Put(hgrid, 5, 5, "very critical", %TRUE)
MLGrid_Put(hgrid, 5, 6, "obesity", %TRUE)
MLGrid_Put(hgrid, 6, 2, "41-?", %TRUE)
MLGrid_Put(hgrid, 6, 3, "41-?", %TRUE)
MLGrid_Put(hgrid, 6, 4, "call doctor", %TRUE)
MLGrid_Put(hgrid, 6, 5, "extremly critical", %TRUE)
MLGrid_Put(hgrid, 6, 6, "obesity", %TRUE)
MLGrid_Sheet_Tabs_Visible hgrid, %TRUE, 350
MLGrid_Refresh hGrid
'---------------------------------------------------->
' -- Place controls here
Dialog Pixels CBHNDL, 400, 250 To Units cx, cy
Control Add Canvas, CBHNDL, %Canvas_Gdip, "", 5, 5, cx+100, cy+100
'Control Add Button, CBHNDL, %bClose, "Close", 180+cx, cy+5-144, 50, 22, Call bCloseProc
Canvas_Attach CBHNDL, %Canvas_Gdip, %TRUE
Canvas_Color Rgb(128, 255, 0), Rgb(0, 0, 0)
'Canvas_Clear(Rgb(0,0,0))
Canvas_Scale Pixels
'--------------------------->
Case %WM_COMMAND
Select Case CBCTL
Case %IDC_BUTTON1
If CBCTLMSG = %BN_CLICKED Or CBCTLMSG = 1 Then
Control Get Text CBHNDL, %IDC_TEXTBOX1 To txt
l = Val(txt)
Control Get Text CBHNDL, %IDC_TEXTBOX2 To txt
b = Val(txt)
f = l/(b*b)*10000
'g = f/100
'BMI = 70 / (1,75 * 1,75) = 22,86
MsgBox 0,"result of multiplaction is: " + Str$(f) 'f
Control Set Text CBHNDL, %IDC_TEXTBOX3, Str$(f) 'f
End If
Function = 1
End Select
Case %WM_SIZE
Dialog Get Client CBHNDL To w1, h1
Control Set Size CBHNDL, %IDC_MLGRID, w1, h1
Case %WM_NOTIFY
Case %WM_PAINT
GDIP_DrawImage()
Canvas_Redraw
' End Select
Case %WM_DESTROY
'---Do whatever needed just before dialog is destroyed.
End Select
End Function
'-------------------->
Sub GDIP_DrawImage()
'-------------------->
Local hStatus As Long
Local pGraphics As DWord
Local pImage As DWord
Local strFileName As String
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Create the Image object
strFileName = Ucode$("Christmas-simpson1c.jpg")
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), pImage)
' // Draw the image
hStatus = GdipDrawImage(pGraphics, pImage, 5, 5)
' // Cleanup
If pImage Then GdipDisposeImage(pImage)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
CallBack Function bCloseProc()
If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
' -- Closes the dialog
Dialog End CBHNDL
End If
End If
End Function
Critic: if anyone like this example or copied this would be fair to make a critic or comment about that example. but I am sad about such one: sometimes I think it' s like a supermarket where's all things for free to get. so you are always shopping here for free and nobody say's thank you for the gifts. can you tell me why this unfriendly behaviour is usual here at board? there's always a lot of work or time spending with these examples, you can imagine. I wanted to make thinbasic better and learn with these language. what's your opinion they are always getting these things for free? 
Members who have read this thread: 0
Reply With Quote
Bookmarks