Simple WinAPI GUI library

[Pim Scheffers]

He,

I found the source of the GDI memory leak.
The root-cause was not in destroying the controls but setting their fonts.

The function:

Code: Select all

control_setfont........


creates a font object locally but does not destroy it!

I have split the function into 3 sub / functions that 1 create a font object, 2 assigns a font to a control and 3 deletes the font object!

Code: Select all

'=============================================================================================

function control_createfont(font as string, _
                            h as long = 16, _
                            w as long = 8, _
                            wt as long = 0, _
                            it as long = False, _
                            ul as long = False, _
                            so as long = False) as HFONT
   
       '<-----Set font for a control. Parameters:
   '<-----Control hWnd = Handle to the control
   '<-----Font = e.g. "Courier New", "Arial", "New Times Roman"
   '<-----h = Logical height of the font
   '<-----w = Logical average width of font
   '<-----wt = Font weight (e.g. FW_THIN, FW_NORMAL, FW_BOLD)
   '<-----it = Italic: True = yes
   '<-----ul = Underline: True = yes
   '<-----so = Strikout: True = yes
   
    return CreateFont(h, _
                      w, _
                      0, _
                      0, _
                      wt, _
                      it, _
                      ul, _
                      so, _
                      ANSI_CHARSET, _
                      FALSE, _
                      FALSE, _
                      DEFAULT_QUALITY, _
                      DEFAULT_PITCH or FF_ROMAN, _
                      font)
end function

'=============================================================================================

sub control_deletefont(hfont as HFONT)
    DeleteObject(hfont)
end sub

'=============================================================================================

sub control_setfont(hwnd as HWND, hfont as HFONT)
    SendMessage(hwnd, WM_SETFONT, cast(WPARAM, hfont), true)
end sub


The GDI memory leak is now gone!

[Lothar Schirm]

I was a little bit lazy during the last months regarding FreeBASIC due to my other hobby (playing classical guitar), but I think your contribution is very useful, so I placed a new update on FreeBASIC Portal. Thank you very much!

[RNBW]

Hi Lothar
I've not been in touch here for a while. I hope you are well.

I still like your Simple Windows API library, although I've been using Vanya's library more recently. I still use your library for developing GUI tasks, since it is so easy to use. I used to use Liberty Basic to do this but I had a little falling out with them on their forum. They didn't like me to mention LB Booster (Liberty Basic on steroids!) on the forum and banned me. First time I've been banned for anything!

Anyway, I had been developing a routine for LB to enter numeric data into an editbox (textbox as LB calls it) and have produced the code which is on the LBB (not LB website). Seeing as I'm looking more at FreeBasic now, I've developed the code for FreeBasic using your Simple Windows API GUI library.

There are many routines for restricting numeric entry into an editbox, but I wanted something that would error check as you entered the characters and would also display entries of ".123" as "0.123" and "-.123" as "-0.123". The routine would also have to ensure entry of only one "-" and this would be at the beginning of the number. The routine would also have to ensure that only one "." could be entered and it must allow editing.

I think I've accomplished this in the code below and, if you are happy with it, you may wish to include it as an example in your library:

Code: Select all

'=============================================
'  NUMERIC INPUT IN A TEXTBOX
'  This does a check for 0-9 and - or . and prevents entry of all other
'  characters.   It ensures that "-" can only be placed at the start of
'  the number entry.  It also ensures that only one "." or "-"   can be
'  entered.
'  It also ensures that if .123 is entered it displays 0.123 and if
'  -.123 is entered -0.123 is displayed.
'  Code by RNBW. 
'============================================

#Include "WinGUI.bi"

Dim As HWND Window_Main, Button_Ok, Edit_1
Dim As MSG msg
dim As String txt, oldtxt
Dim As Integer pos0   


Function num(ByVal txt As String) As String
   'Function to check that character input is 0-9, - or .
   
   Dim As String num1
   Dim As Integer i, a, t
                                             
   For i = 1 To Len(txt)
      a = Asc(Mid(txt,i,1))
      if a = 46 then t = t + 1
        if (a = 46) and (t > 1) then a = 0    'only DOT after FIRST is cleared
        if a = 45 and i>1 then a = 0          'so really almost anything do, not just 8
        if a = 46 and i = 1 then num1 = "0" + num1
      If a = 45 Or a = 46 or a > 47 and a < 58 then num1 = num1 + Chr(a)
   Next
   
   a=asc(mid(txt,1,1))
    if a = 45 and mid(txt,2,1) = "." then num1 = "-0" + num1
   
   Return num1

End Function


'Create a window with an Editbox and a button:
Window_Main = Window_New   (100, 100, 400, 400, "Numeric Entry Filter!")
Var Label_txt = Label_New  (10, 10, 150, 20, "Enter numbers:",, Window_Main)
Edit_1 = EditBox_New       (150, 10, 100, 20, "",, Window_Main)
Button_Ok = Button_New     (160, 300, 60, 20, "Ok",, Window_Main)

'Set timer to 300 miliseconds:
SetTimer(Window_Main, 0, 300, 0 )

Do
   WaitEvent(Window_Main,msg)
   Select Case msg.message
      Case WM_TIMER
         'Check contents of the edit box every 300 millisecinds
         txt = EditBox_GetText(Edit_1)   'get text from edit box
         oldtxt = txt      'make text the oldtext
         txt = num(txt)  'gets new text from function num(txt) which does the checking
         If oldtxt <> txt Then
            EditBox_SetText(Edit_1, txt)   'if old text is not the same as the new text then use new text
            pos0 = Len(txt)   'position of character is the length of the current text
            SendMessage(Edit_1, EM_SETSEL, pos0, pos0)
         End If
      Case WM_LBUTTONDOWN
         If msg.hwnd = Button_Ok Then Print EditBox_GetText(Edit_1)  'print text to console
   End Select
Loop Until Window_Event_Close(Window_Main, msg)

End


I hope this is useful to anyone who needs this solution.

[RNBW]

I have found that not all IDEs produce a console window automatically, so clicking the OK button does not always print out the number entered in the Editbox on the console. I have modified the code to open a console window. Also I have modified the code to the Editbox so that the characters entered are right justified.

The code with the modifications is shown below:

Code: Select all

REM=============================================
'  NUMERIC INPUT IN A TEXTBOX
'  This does a check for 0-9 and - or . and prevents entry of all other
'  characters.   It ensures that "-" can only be placed at the start of
'  the number entry.  It also ensures that only one "." or "-"   can be
'  entered.
'  It also ensures that if .123 is entered it displays 0.123 and if
'  -.123 is entered -0.123 is displayed.
'  Characters entered are right justified
'  Code by RNBW. 
'============================================

#INCLUDE "WinGUI.bi"

DIM AS HWND Window_Main, Button_Ok, Edit_1
DIM AS MSG msg
DIM AS STRING txt, oldtxt
DIM AS INTEGER pos0   

FUNCTION NUM(BYVAL txt AS STRING) AS STRING
   'Function to check that character input is 0-9, - or .
   
   DIM AS STRING num1
   DIM AS INTEGER i, a, t
                                             
   FOR i = 1 TO LEN(txt)
      a = ASC(MID(txt,i,1))
      IF a = 46 THEN t = t + 1
        IF (a = 46) AND (t > 1) THEN a = 0    'only DOT after FIRST is cleared
        IF a = 45 AND i>1 THEN a = 0          'so really almost anything do, not just 8
        IF a = 46 AND i = 1 THEN num1 = "0" + num1
      IF a = 45 OR a = 46 OR a > 47 AND a < 58 THEN num1 = num1 + CHR(a)
   NEXT
   
   a=ASC(MID(txt,1,1))
    IF a = 45 AND MID(txt,2,1) = "." THEN num1 = "-0" + num1
   
   RETURN num1

END FUNCTION


'Create a window with an Editbox and a button:
Window_Main = Window_New   (100, 100, 400, 400, "Numeric Entry Filter!")
VAR Label_txt = Label_New  (10, 10, 150, 20, "Enter numbers:",, Window_Main)
Edit_1 = EditBox_New       (150, 10, 100, 20, "",ES_RIGHT, Window_Main)
Button_Ok = Button_New     (160, 300, 60, 20, "Ok",, Window_Main)

Screen 12
open cons for output as #1

'Set timer to 300 miliseconds:
SETTIMER(Window_Main, 0, 300, 0 )

DO
   WaitEvent(Window_Main,msg)
   SELECT CASE msg.message
      CASE WM_TIMER
         'Check contents of the edit box every 300 millisecinds
         txt = EditBox_GetText(Edit_1)   'get text from edit box
         oldtxt = txt      'make text the oldtext
         txt = NUM(txt)  'gets new text from function num(txt) which does the checking
         IF oldtxt <> txt THEN
            EditBox_SetText(Edit_1, txt)   'if old text is not the same as the new text then use new text
            pos0 = LEN(txt)   'position of character is the length of the current text
            SENDMESSAGE(Edit_1, EM_SETSEL, pos0, pos0)
         END IF
      CASE WM_LBUTTONDOWN
         IF msg.hwnd = Button_Ok THEN PRINT EditBox_GetText(Edit_1)  'print text to console
   END SELECT
LOOP UNTIL Window_Event_Close(Window_Main, msg)

END


[RNBW]

My reason for wanting the simple numeric input routine I previously posted, is so that I can use it to enter numerics into a grid of textboxes for a program I am developing. I have now got this working and the code (again using Lothar Schirm's Simple Windows API Library) is shown below. What remains to be done is to tidy up the displayed numbers because they are a bit straggly.

Instructions for use:
Enter numbers into columns 3 and 4 on rows 2 and 3. Click the calculate button and simple addition takes place displaying the totals of columns 3 and 4 in column 5 and the totals of columns 3, 4 and 5 in row 4.

I hope it's of use and if anyone can see where the coding might be done better, I'm sure we would all like to see it (my code is not always the best, I'm of the school "if it works, use it").

Code: Select all

'===============================================================
'NumericEntryIntoGridOfTextboxes.bas
'Author: RNBW
' 18 July2018

'Includes Row and Column Headings
' Modified from Lothar Schirm's Simple Windows API Library  GridTransfer.bas
'--------------------------------------------------------------------------------------------------------------
  'INSTRUCTIONS:
  'Enter any text you want in col 2, rows 2 & 3.  It is superfluous to the exercise  and is only
  'included for my own future use.
  'Enter numbers into columns 3 and 4 in rows 2 and 3.  They will be automatically
  'checked for numeric validity in the range 0 to 9, minus and period and for only one
  'inclusion of minus and period and ensuring that the minus only occurs as the first
  'character.  It will also print out ".123" as "0.123" and "-.123" as "-0.123"
'===============================================================
' TO DO:
'As can be seen, the displayed numbers are a bit straggly.
' Format the numbers to a specific number of decimal places.
'===============================================================

#Include "WinGUI.bi"

Dim As Long NumOfRows=5, NumOfCols=9
Dim As String sRows, sCols

Dim Shared As HWND Window_Main, Static_Text
Dim Shared As MSG msg
Dim As String text, text2
Dim As HWND Edit_Text(1 To NumOfRows, 1 To NumOfCols)
Dim As HWND Button_Calc
Dim As Long vPos, hPos, bWidth, bHeight, row, col
DIM AS STRING sTxt, oldsTxt
DIM AS INTEGER pos0
DIM AS DOUBLE numb(2 TO NumOfRows, 3 TO NumOfCols)
DIM AS DOUBLE totalRows(2 TO NumOfRows, 5)
DIM AS DOUBLE totalCols(4, 3 TO NumOfCols)


FUNCTION sNum(BYVAL sTxt AS STRING) AS STRING
   'Function to check that character input is 0-9, - or .   
   DIM AS STRING sNum1
   DIM AS INTEGER i, a, t
                                             
   FOR i = 1 TO LEN(sTxt)
      a = ASC(MID(sTxt,i,1))
      IF a = 46 THEN t = t + 1
        IF (a = 46) AND (t > 1) THEN a = 0    'only DOT after FIRST is cleared
        IF a = 45 AND i>1 THEN a = 0          'so really almost anything do, not just 8
        IF a = 46 AND i = 1 THEN sNum1 = "0" + sNum1
      IF a = 45 OR a = 46 OR a > 47 AND a < 58 THEN sNum1 = sNum1 + CHR(a)
   NEXT
   
   a=ASC(MID(sTxt,1,1))
    IF a = 45 AND MID(sTxt,2,1) = "." THEN sNum1 = "-0" + sNum1
   
   RETURN sNum1

END FUNCTION


'---------------------
' MAIN WINDOW
'---------------------
Sub OpenWindow_Main()
   Window_Main = Window_New(100, 100, 750, 200, "Numeric Input Into A Grid of Textboxes")   
End Sub

OpenWindow_Main()

Button_Calc = Button_New(10, 10, 100, 20, "Calculate!",, Window_Main)

'-------------------------------
'  SET UP THE GRID
'-------------------------------
vPos = 40: bHeight = 20
NumOfRows = 4
For row = 1 To NumOfRows
   'hPos = 0 : bWidth = 0
   For col = 1 To 5
      Select Case col
      Case 1
         hPos = 10: bWidth = 65
      Case 2
         hPos = 75: bWidth = 380
      End Select
      Edit_Text(row, col) = EditBox_New(hPos, vPos+bHeight*(row-1), bWidth+1, bHeight+1, "",, Window_Main)
   Next
Next

FOR row = 1 to 1
   for col = 3 TO 5
         SELECT CASE col
            CASE 3 TO 4
               hpos =  col*65+(455-65*3) : bWidth = 65
            CASE 5
               hPos = (10+65+380)+(col-3)*65 : bWidth = 75
         END SELECT
         Edit_Text(row, col) = EditBox_New(hPos, vPos+bHeight*(row-1), bWidth+1, bHeight+1, "",, Window_Main)
   NEXT
NEXT

FOR row = 2 TO 4
   FOR col = 3 TO 5
         SELECT CASE col
            CASE 3 TO 4
                hpos =  col*65+(455-65*3) : bWidth = 65
            CASE 5
                hPos = (10+65+380)+(col-3)*65 : bWidth = 75   
         END SELECT
         Edit_Text(row, col) = EditBox_New(hPos, vPos+bHeight*(row-1), bWidth+1, bHeight+1, "",ES_RIGHT, Window_Main)
   NEXT   
NEXT


'-----------------------------------
' SET UP HEADINGS IN ROW 1
'-----------------------------------
row = 1
For col = 3 To NumOfCols
   EditBox_SetText(Edit_Text(row,col), "Number" + Str(col-2))
   'EditBox_SetText(Edit_Text2(row,col), "Col" + Str(col-1))
Next
 EditBox_SetText(Edit_Text(row,2), "Description")
 EditBox_SetText(Edit_Text(row,5), "TOTAL")


'----------------------------------
' SET UP HEADINGS IN COL 1
'----------------------------------
 col = 1
For row = 2 To NumOfRows -1
   For col = 1 To 1
      EditBox_SetText(Edit_Text(row,col), "Row" + Str(row-1))
   Next
Next
 EditBox_SetText(Edit_Text(4,1), "TOTAL" )
 

'Set timer to 300 miliseconds:
SETTIMER(Window_Main, 0, 300, 0 )

DO
   WaitEvent(Window_Main,msg)
   SELECT CASE msg.message
      CASE WM_TIMER
         'Check contents of the edit box every 300 millisecinds
         For row = 2 to 3
            FOR col = 3 TO 4
               sTxt = EditBox_GetText(Edit_Text(row,col))   'get text from edit box
               oldsTxt = sTxt      'make text the oldtext                                                                                                                                     
               sTxt = sNum(sTxt)  'gets new text from function sNum(sTxt) which does the checking
               IF oldsTxt <> sTxt THEN
                  EditBox_SetText(Edit_Text(row,col), sTxt)   'if old text is not the same as the new text then use new text
                  pos0 = LEN(sTxt)   'position of character is the length of the current text
                  SENDMESSAGE(Edit_Text(row,col), EM_SETSEL, pos0, pos0)
               END IF
            NEXT col
         NEXT row
      CASE WM_LBUTTONDOWN
         'If Calculate! button is clicked then carry out calculation
         IF msg.hwnd = Button_Calc THEN
            FOR row = 2 to 4
               FOR col = 3 TO 5                                     
                    ' Total Rows
                    sTxt =  EditBox_GetText(Edit_Text(row,col))
                    numb(row,col) = VAL(sTxt)
                    totalRows(row,5) = numb(row, 3) + numb(row,4)
                    sTxt = STR(totalRows(row,5))
                    EditBox_SetText(Edit_Text(row,5), sTxt)
                    'Total Columns
                   totalCols(4,col) =  numb(2,col) +  numb(3,col)
                   sTxt = STR(totalCols(4,col))
                   EditBox_SetText(Edit_Text(4,col), sTxt)                       
               NEXT
            NEXT 
         END IF
   END SELECT
LOOP UNTIL Window_Event_Close(Window_Main, msg)

End



[Provoni]

Hey Lothar,

Thank you for the updates.

Is it possible to use/have a spacer line between menu items?

[RNBW]

For the latest code for entering numerics into a grid of textboxes using Lothar Schirm's Simple WinAPI Library please see this post https://www.freebasic.net/forum/viewtopic.php?f=7&t=26816. You may also wish to view BasicCoder2's thread at https://www.freebasic.net/forum/viewtopic.php?f=7&t=26941.

Hope they are helpful in using Lothar's library.

[Carlos Herrera]

Hi All,
Is it possible to close a main window, return to the console and keep program running?
Thanks in advance,
Carlos

[RNBW]

My reason for wanting the simple numeric input routine I previously posted, is so that I can use it to enter numerics into a grid of textboxes for a program I am developing. I have now got this working and the code (again using Lothar Schirm's Simple Windows API Library) is shown below. What remains to be done is to tidy up the displayed numbers because they are a bit straggly.

Instructions for use:
Enter numbers into columns 3 and 4 on rows 2 and 3. Click the calculate button and simple addition takes place displaying the totals of columns 3 and 4 in column 5 and the totals of columns 3, 4 and 5 in row 4.

I hope it's of use and if anyone can see where the coding might be done better, I'm sure we would all like to see it (my code is not always the best, I'm of the school "if it works, use it").

I have expanded on the above.

The new code allows you to enter the number of rows to be calculated. It also makes the end total column and the bottom total row to be read only. As it stands the computations are all addition, but this is easily changed in the code to *, /, or -.

Code: Select all

'=========================================================
' NumericEntryIntoGridOfTextboxes_Dev06.bas
' Author: RNBW
' 7 October 2018
'---------------------------------------------------------------------------------

'INSTRUCTIONS:
'Enter any text you want in col 2, rows 2 & 3.  It is superfluous to the exercise  and is only
'included for my own future use.
'Enter numbers into columns 3 and 4 in rows 2 and 3.  They will be automatically
'checked for numeric validity in the range 0 to 9, minus and period and for only one
'inclusion of minus and period and ensuring that the minus only occurs as the first
'character. 
'The final display presents the numbers to 3 decimal places
'=========================================================

#Include "WinGUI.bi"
#include "string.bi"
 
Dim  Shared As Long NumOfRows = 10  'this is an arbitrary value, it doesn't seem to matter
dim shared as long NumOfCols = 5
Dim Shared As String sRows, sCols

Dim Shared As HWND Window_Main, Static_Text, Label_a, Edit_a, Button_Num, Button_CloseGrid, Label_b
Dim Shared As MSG msg
Dim Shared As String text, text2
Dim Shared As HWND Edit_Text(1 To NumOfRows, 1 To NumOfCols)
Dim Shared As HWND Button_Calc
Dim Shared As Long vPos, hPos, bWidth, bHeight, row, col
DIM Shared AS STRING sTxt, oldsTxt
DIM Shared AS INTEGER pos0
DIM Shared AS DOUBLE numb(2 TO NumOfRows, 3 TO NumOfCols)
DIM Shared AS DOUBLE totalRows(2 TO NumOfRows, NumOfCols)
DIM Shared AS DOUBLE totalCols(NumOfRows, 3 TO NumOfCols)
dim shared as double number


FUNCTION sNum(BYVAL sTxt AS STRING) AS STRING
   'Function to check that character input is 0-9, - or .
   DIM AS STRING sNum1
   DIM AS INTEGER i, a, t

   FOR i = 1 TO LEN(sTxt)
      a = ASC(MID(sTxt,i,1))
      IF a = 46 THEN t = t + 1
      IF (a = 46) AND (t > 1) THEN a = 0    'only DOT after FIRST is cleared
      IF a = 45 AND i>1 THEN a = 0          'so really almost anything do, not just 8
      'IF a = 46 AND i = 1 THEN sNum1 = "0" + sNum1
      IF a = 45 OR a = 46 OR a > 47 AND a < 58 THEN sNum1 = sNum1 + CHR(a)
   NEXT

   'a=ASC(MID(sTxt,1,1))
   'IF a = 45 AND MID(sTxt,2,1) = "." THEN sNum1 = "-0" + sNum1

   RETURN sNum1

END FUNCTION


'---------------------
' MAIN WINDOW
'---------------------
Sub OpenWindow_Main()
   Window_Main = Window_New(100, 100, 750, 400, "Numeric Input Into A Grid of Textboxes")
End Sub

OpenWindow_Main()

' Gadgets to state number of rows
'sub identifyGrid(NumOfRows)
Label_a = Label_New(10,10,270,20,"How many rows do you want to calculate",, Window_Main)
Edit_a = EditBox_New(300,10,30,20,"", ES_CENTER or WS_BORDER, Window_Main)
Button_Num = Button_New(350,10,100,20, "Enter",, Window_Main)
'end sub

'sub resizeGrid(NumOfRows)
Label_b =  Label_New(10,40,350,20,"To resize the grid FIRST click resize button",, Window_Main)
Button_CloseGrid = Button_New(350,40,100,20, "Resize Grid",, Window_Main)
'end sub

'Open console
'Screen 12
'open cons for output as #1

Button_Calc = Button_New(10, 60, 100, 20, "Calculate!",, Window_Main)

   '-------------------------------
   '  SET UP THE GRID
   '-------------------------------
sub setUpGrid(NumOfRows as long)
    reDim As HWND Edit_Text(1 To NumOfRows, 1 To NumOfCols)
   reDIM AS DOUBLE numb(2 TO NumOfRows, 3 TO NumOfCols)
   reDIM AS DOUBLE totalRows(2 TO NumOfRows, NumOfCols)
   reDIM AS DOUBLE totalCols(NumOfRows, 3 TO NumOfCols)
   Dim ES_x as Integer
   vPos = 90: bHeight = 20
   For row = 1 To NumOfRows-1
      For col = 1 To 5
         ES_x=ES_LEFT       ' ## default  left justified ##
         select Case col
            Case 1
               hPos = 10: bWidth = 65: ES_x=ES_LEFT
            Case 2
               hPos = 75: bWidth = 380: ES_x=ES_LEFT
            CASE 3 TO 4
               hpos =  col*65+(455-65*3) : bWidth = 65: ES_x = ES_RIGHT    'right justify
            CASE 5
               hPos = (10+65+380)+(col-3)*65 : bWidth = 75: ES_x = ES_RIGHT or ES_READONLY   'right justify
         End Select
         Edit_Text(row, col) = EditBox_New(hPos, vPos+bHeight*(row-1), bWidth+1, bHeight+1, "",ES_x, Window_Main)
       Next
   Next
   ' This is a bit clumsy but is the best I could come up with
   ' It takes the last row of the grid which includes the column totals
   ' and makes them READONLY.
  For row = NumOfRows To NumOfRows
      For col = 1 To 5
         ES_x=ES_LEFT       ' ## default  left justified ##
         select Case col
            Case 1
               hPos = 10: bWidth = 65:  ES_x=ES_LEFT or ES_READONLY
            Case 2
               hPos = 75: bWidth = 380 : ES_x=ES_LEFT or ES_READONLY
            CASE 3 TO 4
               hpos =  col*65+(455-65*3) : bWidth = 65: ES_x = ES_RIGHT or ES_READONLY    'right justify
            CASE 5
               hPos = (10+65+380)+(col-3)*65 : bWidth = 75: ES_x = ES_RIGHT or ES_READONLY   'right justify
         End Select
         Edit_Text(row, col) = EditBox_New(hPos, vPos+bHeight*(row-1), bWidth+1, bHeight+1, "",ES_x, Window_Main)
       Next
   Next
   
   '-----------------------------------
   ' SET UP HEADINGS IN ROW 1
   '-----------------------------------
   row = 1
   For col = 3 To NumOfCols
      EditBox_SetText(Edit_Text(row,col), "Number" + Str(col-2))
   Next
   EditBox_SetText(Edit_Text(row,2), "Description")
   EditBox_SetText(Edit_Text(row,5), "TOTAL")
   
   '----------------------------------
   ' SET UP HEADINGS IN COL 1
   '----------------------------------
   col = 1
   For row = 2 To NumOfRows -1
      For col = 1 To 1
         EditBox_SetText(Edit_Text(row,col), "Row" + Str(row-1))
      Next
   Next
   EditBox_SetText(Edit_Text(numOfRows,1), "TOTAL")

end sub


'Set timer to 300 miliseconds:
SETTIMER(Window_Main, 0, 300, 0 )

DO
   WaitEvent(Window_Main,msg)
   SELECT CASE msg.message
      ' CASE WM_LBUTTONDOWN
      'SELECT CASE msg.message
      CASE WM_TIMER
         'Check contents of the edit box every 300 millisecinds
         For row = 2 to NumOfRows
            FOR col = 3 TO 4
               sTxt = EditBox_GetText(Edit_Text(row,col))   'get text from edit box
               oldsTxt = sTxt      'make text the oldtext
               sTxt = sNum(sTxt)  'gets new text from function sNum(sTxt) which does the checking
               IF oldsTxt <> sTxt THEN
                  EditBox_SetText(Edit_Text(row,col), sTxt)   'if old text is not the same as the new text then use new text
                  pos0 = LEN(sTxt)   'position of character is the length of the current text
                  SENDMESSAGE(Edit_Text(row,col), EM_SETSEL, pos0, pos0)
               END IF
            NEXT col
         NEXT row
      CASE WM_LBUTTONDOWN
         if msg.hwnd = Button_Num then
            text = EditBox_GetText(Edit_a)
            NumOfRows = val(text)
            NumOfRows = NumOfRows + 2
            setUpGrid(NumOfRows)
            SendMessage(Edit_a, WM_CLOSE, 0, 0)
            print NumOfRows
           
         Else
            ' Click Close Grid button to close grid
            if msg.hwnd = Button_CloseGrid THEN
               for row = 1 to NumOfRows
                  for col = 1 to  5                       
                       DestroyWindow(Edit_Text(row,col))
                  next
               Next
                Edit_a = EditBox_New(300,10,30,20,"", ES_CENTER or WS_BORDER, Window_Main)
               
            Else
               'If Calculate! button is clicked then carry out calculation
               IF msg.hwnd = Button_Calc THEN
                  totalCols(NumOfRows,col) = 0
                  FOR row = 2 to NumOfRows
                     FOR col = 3 TO 5
                        ' Total Rows--->
                        sTxt =  EditBox_GetText(Edit_Text(row,col))
                        numb(row,col) = VAL(sTxt)
                        sTxt = format(numb(row,col), "###0.000")
                        EditBox_SetText(Edit_Text(row,col), sTxt)
                        totalRows(row,5) = numb(row, 3) + numb(row,4)
                        sTxt = format(totalRows(row,5), "####0.000")
                        EditBox_SetText(Edit_Text(row,5), sTxt)
                        'Total Columns--->
                        sTxt = EditBox_GetText(Edit_Text(row,col))
                        numb(row,col) = val(sTxt)
                        totalCols(NumOfRows,col) =  totalCols(NumOfRows,col) +  numb(row-1,col)
                        sTxt = format(totalCols(NumOfRows,col), "####0.000")                       
                        EditBox_SetText(Edit_Text(NumOfRows,col), sTxt)
                        print row; "  "; col; "  "; numb(row,col)
                     NEXT
                  NEXT
               end if
            END IF
         End if
   END SELECT
LOOP UNTIL Window_Event_Close(Window_Main, msg)

End


I think the code shows what can be done with simple code. However, I am looking to use sub-editing, which I am working on at present.

I hope the code is useful and gives users ideas on how they can utilise it for their own purposes. it would be nice to see examples posted.

[oyster]

bug in `ListBox_Table.bas`, the line `Control_SetFont(List_Table, "Courier New")` should be `Control_SetFont(List_Table, Control_Createfont("Courier New"))`

btw, is it difficult to add an advanced EXCEL-like list widget? i.e. th columns width, row height can be set by mouse or code; the font style for cell can be set; the value in cell can be aligned left/right/middle/top/down/center, can be set to wrap; the background of cell can be set

thanks

[Carlos Herrera]

Hey,

First of I would like thank the creator for this nice library.
Later when using the library I realized that it would be nice if we could also put freebasic image buffers onto a window.
I already compiled a subroutine of code (from various code snippets from the forum) that gets the job done, ...

Code: Select all

'=============================================================================================

sub draw_buffer(x as integer, y as integer, source_image as fb.Image ptr, dest_hwnd as HWND)
    if source_image = 0 then
        exit sub
    end if

    dim as BITMAPV4HEADER bmi
    dim as RECT dest_rect
    dim as integer dest_w, dest_h, src_w, src_h
   
    with bmi
        .bV4Size = Len(BITMAPV4HEADER)
        .bv4width = source_image->Pitch shr 2
        .bv4height = -(source_image->Height)
        .bv4planes = 1
        .bv4bitcount = 32
        .bv4v4compression = 0
        .bv4sizeimage = ((source_image->Pitch shr 2) * source_image->Height) shl 2
        .bV4RedMask = &h0f00
        .bV4GreenMask = &h00f0
        .bV4BlueMask = &h000f
        .bV4AlphaMask = &hf000
    end With
   
    var hdc = GetDC(dest_hwnd)
    GetClientRect(dest_hwnd , @dest_rect)
   
    if dest_rect.Bottom > source_image->Height Then
        src_h = source_image->Height       
    else
        src_h = dest_rect.Bottom
    end if
    dest_h = src_h
   
    if dest_rect.right > source_image->Width Then
        src_w = source_image->Width       
    else
        src_w = dest_rect.Right
    end if
    dest_w = src_w
   
    StretchDIBits(hDC, _
                  x, _
                  y, _
                  dest_w, _
                  dest_h, _
                  0, _
                  0, _
                  src_w, _
                  src_h, _
                  cptr(any ptr, source_image) + sizeof(fb.Image), _
                  cptr(BITMAPINFO ptr, @bmi), _
                  DIB_RGB_COLORS, _
                  SRCCOPY)
    DeleteDC(hdc)
end sub


Pim,
Would you be so kind and provide a simple example of use?
Thanks in advance. Carlos

[UEZ]

Hey,

First of I would like thank the creator for this nice library.
Later when using the library I realized that it would be nice if we could also put freebasic image buffers onto a window.
I already compiled a subroutine of code (from various code snippets from the forum) that gets the job done, ...

Code: Select all

'=============================================================================================

sub draw_buffer(x as integer, y as integer, source_image as fb.Image ptr, dest_hwnd as HWND)
    if source_image = 0 then
        exit sub
    end if

    dim as BITMAPV4HEADER bmi
    dim as RECT dest_rect
    dim as integer dest_w, dest_h, src_w, src_h
   
    with bmi
        .bV4Size = Len(BITMAPV4HEADER)
        .bv4width = source_image->Pitch shr 2
        .bv4height = -(source_image->Height)
        .bv4planes = 1
        .bv4bitcount = 32
        .bv4v4compression = 0
        .bv4sizeimage = ((source_image->Pitch shr 2) * source_image->Height) shl 2
        .bV4RedMask = &h0f00
        .bV4GreenMask = &h00f0
        .bV4BlueMask = &h000f
        .bV4AlphaMask = &hf000
    end With
   
    var hdc = GetDC(dest_hwnd)
    GetClientRect(dest_hwnd , @dest_rect)
   
    if dest_rect.Bottom > source_image->Height Then
        src_h = source_image->Height       
    else
        src_h = dest_rect.Bottom
    end if
    dest_h = src_h
   
    if dest_rect.right > source_image->Width Then
        src_w = source_image->Width       
    else
        src_w = dest_rect.Right
    end if
    dest_w = src_w
   
    StretchDIBits(hDC, _
                  x, _
                  y, _
                  dest_w, _
                  dest_h, _
                  0, _
                  0, _
                  src_w, _
                  src_h, _
                  cptr(any ptr, source_image) + sizeof(fb.Image), _
                  cptr(BITMAPINFO ptr, @bmi), _
                  DIB_RGB_COLORS, _
                  SRCCOPY)
    DeleteDC(hdc)
end sub


Pim,
Would you be so kind and provide a simple example of use?
Thanks in advance. Carlos

Here an example:

Code: Select all

#Include "fbgfx.bi"
#Include "windows.bi"

'=============================================================================================

Sub draw_buffer(x As Integer, y As Integer, source_image As fb.Image Ptr, dest_hwnd As HWND)
    If source_image = 0 Then
        Exit Sub
    End If
      
    Dim As BITMAPV4HEADER bmi
    Dim As RECT dest_rect
    Dim As Integer dest_w, dest_h, src_w, src_h
   
    With bmi
        .bV4Size = Len(BITMAPV4HEADER)
        .bv4width = source_image->Pitch Shr 2
        .bv4height = -(source_image->Height)
        .bv4planes = 1
        .bv4bitcount = 32
        .bv4v4compression = 0
        .bv4sizeimage = ((source_image->Pitch Shr 2) * source_image->Height) Shl 2
        .bV4RedMask = &h0f00
        .bV4GreenMask = &h00f0
        .bV4BlueMask = &h000f
        .bV4AlphaMask = &hf000
    End With

    Var hdc = GetDC(dest_hwnd)
    GetClientRect(dest_hwnd , @dest_rect)
   
    If dest_rect.Bottom > source_image->Height Then
        src_h = source_image->Height       
    Else
        src_h = dest_rect.Bottom
    End If
    dest_h = src_h
   
    If dest_rect.Right > source_image->Width Then
        src_w = source_image->Width       
    Else
        src_w = dest_rect.Right
    End If
    dest_w = src_w
   
    StretchDIBits(hDC, _
                  x, _
                  y, _
                  dest_w, _
                  dest_h, _
                  0, _
                  0, _
                  src_w, _
                  src_h, _
                  Cptr(Any Ptr, source_image) + Sizeof(fb.Image), _
                  Cptr(BITMAPINFO Ptr, @bmi), _
                  DIB_RGB_COLORS, _
                  SRCCOPY)
    DeleteDC(hdc)
End Sub

Const As UShort iW = 640, iH = 640
ScreenControl FB.SET_DRIVER_NAME, "GDI"
Screenres iW, iH, 32


'Generate Xor graphic
Dim As Any Ptr pImage = Imagecreate(iW, iH, 0, 32)

For y As Ushort = 0 To iH - 1
   For x As Ushort = 0 To iW - 1
      Pset pImage, (x, y), (x - y Xor y + x) Shl 16 Or (2 * x Xor 2 * y) Shl 8 Or (x Xor y)
   Next
Next

Dim As HWND hHWND
ScreenControl(FB.GET_WINDOW_HANDLE, Cast(Integer, hHWND))

draw_buffer(0, 0, pImage, hHWND)

Sleep

Imagedestroy(pImage)


[Carlos Herrera]

@UEZ
Great, beautiful pattern. However, it is not clear, at least for me, how to use this procedure
in the context of WinGUI library. For example with

Code: Select all

...
Dim As HWND hHWND
'ScreenControl(FB.GET_WINDOW_HANDLE, Cast(Integer, hHWND))
hHWND = Window_New (40, 40, 860, 860, "Test")
draw_buffer(20, 20, pImage, hHWND)
...


window "Test" with pattern is created, but it is not responding.
Carlos

[UEZ]

You can do something like this here.

Modified "Window.bas" example:

Code: Select all

'===============================================================================
' Window.bas
' How to create a window and how to use simple controls
' Created on 08/04/2015
' Last changes on October 20, 2016
'===============================================================================

#Include "WinGUI.bi"
#Include "fbgfx.bi"

Using FB

Sub draw_buffer(x As Integer, y As Integer, source_image As fb.Image Ptr, dest_hwnd As HWND)
    If source_image = 0 Then
        Exit Sub
    End If
      
    Dim As BITMAPV4HEADER bmi
    Dim As RECT dest_rect
    Dim As Integer dest_w, dest_h, src_w, src_h
   
    With bmi
        .bV4Size = Len(BITMAPV4HEADER)
        .bv4width = source_image->Pitch Shr 2
        .bv4height = -(source_image->Height)
        .bv4planes = 1
        .bv4bitcount = 32
        .bv4v4compression = 0
        .bv4sizeimage = ((source_image->Pitch Shr 2) * source_image->Height) Shl 2
        .bV4RedMask = &h0f00
        .bV4GreenMask = &h00f0
        .bV4BlueMask = &h000f
        .bV4AlphaMask = &hf000
    End With

    Var hdc = GetDC(dest_hwnd)
    GetClientRect(dest_hwnd , @dest_rect)
   
    If dest_rect.Bottom > source_image->Height Then
        src_h = source_image->Height       
    Else
        src_h = dest_rect.Bottom
    End If
    dest_h = src_h
   
    If dest_rect.Right > source_image->Width Then
        src_w = source_image->Width       
    Else
        src_w = dest_rect.Right
    End If
    dest_w = src_w
   
    StretchDIBits(hDC, _
                  x, _
                  y, _
                  dest_w, _
                  dest_h, _
                  0, _
                  0, _
                  src_w, _
                  src_h, _
                  Cptr(Any Ptr, source_image) + Sizeof(fb.Image), _
                  Cptr(BITMAPINFO Ptr, @bmi), _
                  DIB_RGB_COLORS, _
                  SRCCOPY)
    DeleteDC(hdc)
End Sub


Dim As HWND Window_Main, Editor_txt, Button_Ok
Dim As MSG msg

Const As UShort iW = 640, iH = 640

'Create a window with a text editor and a button:
Window_Main = Window_New   (100, 100, iW, iH, "I am a beautiful window!")

Screenres 1, 1, 32, 1, GFX_NULL

'Generate Xor graphic
Dim As Any Ptr pImage = Imagecreate(iW, iH, 0, 32)

For y As Ushort = 0 To iH - 1
   For x As Ushort = 0 To iW - 1
      Pset pImage, (x, y), (x - y Xor y + x) Shl 16 Or (x Shl 1 Xor y Shl 1) Shl 8 Or (x Xor y)
   Next
Next

draw_buffer(0, 0, pImage, Window_Main)

'Event loop:
Do
   WaitEvent(Window_Main, msg)

Loop Until Window_Event_Close(Window_Main, msg)

End


The important thing is to have a windows handle (HWND). Unfortunately to create an empty image in FB you must create a screen before you can create an empty image -> Screenres 1, 1, 32, 1, GFX_NULL.

[Provoni]

A user of my software at http://zodiackillersite.com/viewtopic.php?f=81&t=3198 which uses Lothar's library, found that under WineHQ windows were unable to be closed, he issued this fix for a function found in WinGUI.bi:

Code: Select all

Function Window_Event_Close(ByVal hWnd As HWND, ByRef msg As MSG) As Long
   'Returns 1 when the close button (X) of the window has been clicked. Parameters:
   '- hWnd = handle of the window
   '- msg = Message (see Sub WaitEvent)
   
   'Windows
   If msg.hwnd = hWnd And msg.message = 161 Then
      If msg.wParam = 20 Then Return 1 Else Return 0
   End if
   
   'Fix for WineHQ (by Largo)
   If msg.hwnd = hWnd And msg.message = 274 Then
      If msg.wParam = 61536 Then Return 1 Else Return 0
   End if
   
End Function