tb_graphx

[Lionheart008]

hello.

perhaps somebody can check the "powerbasic" code for my "graphx" example. it's just a test how to understand building a thinbasic module coming from powerbasic. I have some ideas for sdk windows or other graphic input things, I am not quite sure, but want to try it to realize...

I have done some mistakes in pb code, I am sure, but wanted to do this experiment.

demo: powerbasic code

[code=thinbasic] #IF 0
=============================================================================
Program NAME: UserDefinedLib.bas
Author : Eros Olmi
Version :
Description : DLL TO test thinBasic loading library
=============================================================================
'COPYRIGHT AND PERMISSION NOTICE
'============================================================================
Copyright (c) 2003 - 2009, Eros Olmi, <eros.olmi@thinbasic.com>

ALL rights reserved.

Permission TO use this software IS granted ONLY FOR the purpose TO develop
thinBasic language modules both FOR commercial OR non commercial purpose.
IN ANY CASE the above copyright notice AND this permission notice must appear
IN ALL copies.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF THIRD PARTY RIGHTS.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
USE OR OTHER DEALINGS IN THE SOFTWARE.
=============================================================================
#ENDIF

#COMPILE DLL
#REGISTER NONE
#DIM ALL

'---Resource file. Change UserDefinedLib.RC resource file as needed and remember to compile
' into UserDefinedLib.PBR file using resource compiler
#RESOURCE "UserDefinedLib.PBR"

#INCLUDE "WIN32API.INC"

'---Every used defined thinBasic module must include this file
#INCLUDE "thinCore.inc"

%ButtonClose = 1001

'----------------------------------------------------------------------------
FUNCTION Exec_HEX() AS STRING
' Return a string that is the hexadecimal (base 16) representation of its argument.
' Usage: s$ = HEX$(numeric_expression [, digits])
'----------------------------------------------------------------------------
LOCAL lNumber AS EXT
LOCAL lDigits AS EXT

'---Here we have to parse the syntax we have decided this new keyword will have
' Syntax is: an open pares
' followed by a numeric expression
' followed by an optional comma with an optional numeric expression
' a close parens
'---Here how to do

'---Parse open pares
IF thinBasic_CheckOpenParens() THEN

'---If ok, parse a numeric expression and return it's value.
' Remember to always use EXT numeric type even if you need a different one
thinBasic_ParseNumber lNumber

'---Here we see if there is a comma.
' If not, we have instruct not to produce a runtime error and to put back
' the found token into the parsing stack
IF thinBasic_CheckComma(%TRUE, %TRUE) THEN

'---If optional comma was specified we parse another numeric expression
thinBasic_ParseNumber lDigits

END IF

'---At the end check if close parens was specified
IF thinBasic_CheckCloseParens() THEN

'---At the end here we are. If optional parameter was specified, call the function
' with the optional parameter
IF lDigits > 0 THEN
FUNCTION = HEX$(lNumber, lDigits)
ELSE

'---otherwise call function without optional parameter
FUNCTION = HEX$(lNumber)
END IF

END IF

END IF

END FUNCTION

'######################################################################################################

FUNCTION Exec_windowMe (BYVAL hdlg AS LONG, BYVAL windox AS LONG, BYVAL cbDialox AS LONG) AS Ext 'LONG

DIM a AS LONG
DIM b AS LONG

DIALOG NEW 0, "Frankos_Test_Dialogue",-1,-1, 330, 203, _
%WS_POPUP OR _
%WS_VISIBLE OR _
%WS_CLIPCHILDREN OR _
%WS_CAPTION OR _
%WS_SYSMENU OR _
%WS_MINIMIZEBOX, _
0 TO hDlg

CONTROL ADD BUTTON, hDlg, %ButtonClose, "Click to kill me softly", 90, 50, 150, 100
DIALOG SHOW MODAL hDlg CALL cbDialog

IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseLong hDlg
IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseLong windox
IF thinBasic_CheckCloseParens() THEN
windox = %TRUE
IF thinBasic_CheckCloseParens() THEN
hdlg = %TRUE

IF hDlg THEN windox = %buttonclose

FUNCTION = windox

END IF
END IF
END IF
END IF
END FUNCTION

'######################################################################################################

'------------------------------------------------
' Callback function used to handle dialog events
'------------------------------------------------

CALLBACK FUNCTION cbDialog() AS LONG

SELECT CASE CBMSG
CASE %WM_COMMAND
IF CBWPARAM = %ButtonClose THEN DIALOG END CBHNDL

CASE %WM_DESTROY
MSGBOX "Window is to be destroyed.", %MB_OK, "tbGraphx_yes!"
END SELECT

END FUNCTION


'----------------------------------------------------------------------------
FUNCTION Exec_Console_FColor() AS EXT
' Compose a new console foreground color.
' Usage: n = Console_fColor ( R AS LONG, G AS LONG, B AS LONG, Intense AS LONG)
'----------------------------------------------------------------------------
LOCAL R AS EXT, lR AS LONG
LOCAL G AS EXT, lG AS LONG
LOCAL B AS EXT, lB AS LONG
LOCAL Intense AS EXT, lIntense AS LONG
LOCAL ForeColor AS LONG

IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseNumber R
IF thinBasic_CheckComma() THEN
thinBasic_ParseNumber G
IF thinBasic_CheckComma() THEN
thinBasic_ParseNumber B
IF thinBasic_CheckComma() THEN
thinBasic_ParseNumber Intense
IF thinBasic_CheckCloseParens() THEN
lR = R
lG = G
lB = B
lIntense = Intense

IF lR THEN ForeColor = %FOREGROUND_RED
IF lG THEN ForeColor = ForeColor OR %FOREGROUND_GREEN
IF lB THEN ForeColor = ForeColor OR %FOREGROUND_BLUE
IF lIntense THEN ForeColor = ForeColor OR %FOREGROUND_INTENSITY

FUNCTION = ForeColor
END IF
END IF
END IF
END IF
END IF

END FUNCTION


SUB Exec_tbgraphx_Test

LOCAL VPTR AS LONG
LOCAL VAbsPos AS LONG
LOCAL myValue AS EXT
VPTR = 123456789

IF thinBasic_CheckOpenParens( ) THEN
thinBasic_VariableParse(VPtr, VAbsPos)
IF thinBasic_CheckCloseParens( ) THEN
MSGBOX STR$ (VPtr) & "," & STR$ (VAbsPos) & ", [" & "]", , "tbGraphx"
MyValue = 2009
thinBasic_ChangeVariableNumberDirect (VPtr, VAbsPos, MyValue)
END IF
END IF
END SUB


'----------------------------------------------------------------------------
FUNCTION LoadLocalSymbols ALIAS "LoadLocalSymbols" (OPTIONAL BYVAL sPath AS STRING) EXPORT AS LONG
' This function is automatically called by thinCore whenever this DLL is loaded.
' This function MUST be present in every external DLL you want to use
' with thinBasic
' Use this function to initialize every variable you need and for loading the
' new symbol (read Keyword) you have created.
'----------------------------------------------------------------------------

'---
'Add here Initialization code if needed
'---


'---
'Here define/add new thinBasic keywords
'---
'---Here an example. Defined a new keyword named HEX$ which will return a string.
' Connect this keyword with Exec_HEX internal function passing its pointer with CODEPTR.
' Last parameter tells thinBasic that even if HEX$ keyword has already been defined, this new
' definition will have priority and will overwite previous keyword configuration
thinBasic_LoadSymbol "MyHEX$", %thinBasic_ReturnString, CODEPTR(Exec_HEX), %thinBasic_ForceOverWrite
thinBasic_LoadSymbol "Console_fColor", %thinBasic_ReturnNumber, CODEPTR(Exec_Console_FColor), %thinBasic_ForceOverWrite

thinBasic_LoadSymbol "tbGraphx_Test", %thinBasic_ReturnNone, CODEPTR(Exec_tbGraphx_Test ), %thinBasic_ForceOverWrite
thinBasic_LoadSymbol "windowMe", %thinBasic_ReturnCodeLong, CODEPTR(Exec_windowMe ), %thinBasic_ForceOverWrite


'---
'Here define/add new thinBasic equates
'---
thinBasic_AddEquate "%MyNumericEquate", "" , 1
thinBasic_AddEquate "$MyStringEquate", "ABC" , 0



END FUNCTION

'----------------------------------------------------------------------------
FUNCTION UnLoadLocalSymbols ALIAS "UnLoadLocalSymbols" () EXPORT AS LONG
' This function is automatically called by thinCore whenever this DLL is unloaded.
' This function CAN be present but it is not necessary. If present, this function
' will be executed by thinBasic core when module will be released.
' Use this function to perform uninitialize process, if needed.
'----------------------------------------------------------------------------

'---
'Add here DeInitialization code if needed
'---

FUNCTION = 0&
END FUNCTION


FUNCTION LIBMAIN ALIAS "LibMain" (BYVAL hInstance AS LONG, _
BYVAL fwdReason AS LONG, _
BYVAL lpvReserved AS LONG) EXPORT AS LONG
SELECT CASE fwdReason
CASE %DLL_PROCESS_ATTACH

FUNCTION = 1
EXIT FUNCTION
CASE %DLL_PROCESS_DETACH

FUNCTION = 1
EXIT FUNCTION
CASE %DLL_THREAD_ATTACH

FUNCTION = 1
EXIT FUNCTION
CASE %DLL_THREAD_DETACH

FUNCTION = 1
EXIT FUNCTION
END SELECT

END FUNCTION
[/code]



here the thinbasic test code:

[code=thinbasic]MODULE "graphx" '
uses "console"

dim res as long
dim u as ext
dim x,y,z as long
dim s as string

tbGraphx_Test(u)
res = Msgbox(0, "Ute was born in:" & str$(u))

x = msgbox 0, "color_value: " + Console_fColor(1,2,3,4)
printl "color_value: " + Console_fColor(1,2,3,4)

z = msgbox 0, "hex_value: " + MyHex$(2,4)
printl "hex_value: " + MyHex$(2,4)

y = msgbox 0, "window: " + windowMe(1,2,3), %MB_OK, "graphx_test value: "


[/code]

would be nice if somebody can tell what's the main reason I have got the gpf
to check the code it isn't so important to do this one fast. I can wait.

best regards, Frank

[Petr Schreiber]

Frank,

[code=thinbasic]
IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseLong hDlg
IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseLong windox
IF thinBasic_CheckCloseParens() THEN
windox = %TRUE
IF thinBasic_CheckCloseParens() THEN
hdlg = %TRUE

IF hDlg THEN windox = %buttonclose

FUNCTION = windox

END IF
END IF
[/code]

OpenParens = (
CloseParens = )

So your code follows this pattern:
(hDlg(windox))

So correct line would be (and works):
[code=thinbasic]
y = msgbox (0, "window: " + windowMe(1(2)), %MB_OK, "graphx_test value: ")
[/code]

Pretty weird syntax, isn't it If you want to have it separated by comma, just use thinbasic_CheckCommaMandatory.

Also one detail - run time error is not GPF. When GPF (general protection fault) occurs, you see message from Windows, not from thinBASIC.

I hope it helped.

[Lionheart008]

hi petr. many thanks. it was last evening very late, I have built this little pb code (incl. thinbasic test code) and I can agree, this is weired syntax and was not my intention

y = msgbox (0, "window: " + windowMe(1(2)), %MB_OK, "graphx_test value: ")

good to know, that I have done the main part with correct powerbasic code, so I am proud of it. one good start for me

I will check more possibilities to make graphic inputs by powerbasic I will show my examples, if there is more time for this module.

I will have a closer look for your advice, I have used an old powerbasic example from thinbasic sdk. thank you for help.

Also one detail - run time error is not GPF. When GPF (general protection fault) occurs, you see message from Windows, not from thinBASIC.

I have meant "run time error" in my first example !

best wishes, Frank
oh yes, I know, I was too fast with writing down, sorry.

[Lionheart008]

hello.

simple improvements, simple modifications, but it wasn't so simple to make it.
- if you like this little experiment, test this tb_graphx example. I have included two new buttons with open ("click to openGraphx") new dialog and ColorBox
- cleared the tb syntax too. no more weird code !
- treeview feature I will build next time, have already started with this example.
- colorBox

[code=thinbasic]MODULE "graphx"
uses "console"

dim res as long
dim u as ext
dim x,y,z as long
dim s as string

tbGraphx_Test(u)
res = Msgbox(0, "Ute was born in:" & str$(u))

x = msgbox 0, "color_value: " + Console_fColor(1,2,3,4)
printl "color_value: " + Console_fColor(1,2,3,4)

z = msgbox 0, "hex_value: " + MyHex$(2,4)
printl "hex_value: " + MyHex$(2,4)

y = msgbox (0, "window: " + windowMe(1,2), %MB_OK, "graphx_test value: ")
printl
printl "windowMe: " + windowMe(1,2)
printl
printl "return any key to exit"
waitkey

[/code]

any feedback is welcome. I will try to start a sdk like window with gradient style.
info: graphx.dll + thinbasic example as attachement

best regards, Frank

[Lionheart008]

(post: part one

hello.

some month ago I've tried to use "gdiplus" feature for this experimental "graphx" (just a word play) module. that last attempt couldn't load pictures, because my background wasn't fit for that one
For learning effects and how to understand the sdk with loading any image. this is the first successfully way for me to load an image (fixed image I add with this zip file). I am not sure, if it's 100 per cent best way, but it does what it's for. making some calculations by functions for simple testing and loading by a dialog (window) a new popup window to show this picture

you can test it if you like.

thinbasic test code:
[code=thinbasic]Module "graphxA"
Uses "console", "ui"

dim res as long
dim u as ext
Dim x,y,z,t As Long
dim s as string

tbGraphx_Test(u)
res = MsgBox(0, "Genivieve was born in:" & Str$(u))

x = MsgBox 0, "my ColorValue: " + Console_fColor(100,250,255,1)
PrintL "my ColorValue: " + Console_fColor(100,250,255,1)

z = MsgBox 0, "String HexValue: " + MyHex$(1,2)
PrintL "String HexValue: " + MyHex$(1,2)

y = MsgBox (0, "Popup window: " + graphMe(1,2,""), %MB_OK, "tb graphx feedback Test: ")

PrintL
PrintL "windowMe: " + graphMe(1,2,"")
printl
printl "return any key to exit"
waitkey

[/code]

I have some more question, but I like it and it's perhaps possible to use this module for next thinbasic issues.

would be nice to get any feedback.

more infos about powerbasic and very good "cWindow.in" class from josé roca (thanks a lot!) you can find here according to this exercise follow with next post

http://www.jose.it-berater.org/smffo...p?topic=3497.0

best regards, frank

[Lionheart008]

(post part two

...

powerbasic code:
[code=thinbasic]'----------------------------------------------------------------------------------------
'-- tb_graphx module by frank brübach, germany, 14-18.nov.2009 / and: 03.03-04.03.2010 /

#COMPILE DLL
#REGISTER NONE
#DIM ALL

'---Resource file. Change UserDefinedLib.RC resource file as needed and remember to compile
' into UserDefinedLib.PBR file using resource compiler
' #RESOURCE "UserDefinedLib.PBR"

#INCLUDE "WIN32API.INC"
#INCLUDE "commctrl.inc"
#INCLUDE "objbase.inc"
#INCLUDE "gdiplus.inc"
GLOBAL ghInstance AS DWORD

'---Every used defined thinBasic module must include this file
#INCLUDE "thinCore.inc"

%ButtonClose = 1001
%ButtonOpen = 1002
%TreeView = 1003
%IDCombobox = 1004
%IDTEXT = 1005
%ButtonColBox = 1006
%ButtonImage = 1007
%ButtonColor = 10024
%IDC_IMAGENAME = 1008
%MyImage = 1009
%lImage = 1010
%lText = 1011
'----------------------------------------------------------------------------
FUNCTION Exec_HEX() AS STRING
'----------------------------------------------------------------------------
LOCAL lNumber AS EXT
LOCAL lDigits AS EXT

'---Parse open pares
IF thinBasic_CheckOpenParens() THEN

thinBasic_ParseNumber lNumber

IF thinBasic_CheckComma(%TRUE, %TRUE) THEN
thinBasic_ParseNumber lDigits
END IF

'---At the end check if close parens was specified
IF thinBasic_CheckCloseParens() THEN
IF lDigits > 0 THEN
FUNCTION = HEX$(lNumber, lDigits)
ELSE
'---otherwise call function without optional parameter
FUNCTION = HEX$(lNumber)
END IF
END IF
END IF
END FUNCTION

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

FUNCTION Exec_graphMe (BYVAL hdlg AS LONG, BYVAL windox AS LONG, BYVAL cbDialox AS LONG) AS EXT

DIM a AS LONG
DIM b AS LONG
LOCAL lvbi AS LVBKIMAGE
LOCAL szFile AS STRING 'ASCIIZ*%MAX_PATH
LOCAL lvi AS LVITEM
LOCAL sFilter AS STRING

InitCommonControls

DIALOG NEW 0, "TB Graphx_Test_Dialogue 1",-1,-1, 340, 290, _
%WS_POPUP OR _
%WS_VISIBLE OR _
%WS_CLIPCHILDREN OR _
%WS_CAPTION OR _
%WS_SYSMENU OR _
%WS_MINIMIZEBOX, _
0 TO hDlg

' Set the color with an RGB value
DIALOG SET COLOR hDlg, -1, RGB(0,100,255)
CONTROL ADD BUTTON, hDlg, %ButtonImage, "load new fixed Image", 90, 20, 140, 140, CALL PopupDlgProc
'CONTROL ADD BUTTON, hDlg, %ButtonOpen, "Click to open Dialog", 210, 200, 80, 20 CALL PopupDlgProc
CONTROL ADD BUTTON, hDlg, %ButtonColBox, "open ColBox", 220, 200, 80, 20, CALL PopupDlgProc
CONTROL ADD BUTTON, hDlg, %ButtonClose, "Click to kill me softly", 60, 180, 100, 80, CALL PopupDlgProc
'CONTROL SET COLOR hDlg, %ButtonColor, RGB(255,255,255), RGB(0,0,255)

lvbi.ulFlags = %LVBKIF_STYLE_NORMAL OR %LVBKIF_SOURCE_URL

lvbi.pszImage = VARPTR(szFile)
lvbi.cchImageMax = LEN(szFile)

CONTROL SEND hDlg, 500, %LVM_SETBKIMAGE, 0, VARPTR(lvbi)
DIALOG SHOW MODAL hDlg CALL cbDialog

IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseLong hDlg
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong windox
windox = %TRUE
IF thinBasic_CheckComma() THEN
thinBasic_ParseString szFile

IF thinBasic_CheckCloseParens() THEN
hdlg = %TRUE
IF hDlg THEN windox = %buttonclose
IF windox THEN szFile = ""
FUNCTION = hDlg
FUNCTION = VARPTR(szFile) + windox
END IF
END IF
END IF
END IF
END FUNCTION

'------------------------------------------------
' Callback function used to handle dialog events
'------------------------------------------------

CALLBACK FUNCTION cbDialog() AS LONG
SELECT CASE CBMSG
CASE %WM_COMMAND
IF CBWPARAM = %ButtonClose THEN DIALOG END CBHNDL
CASE %WM_DESTROY
MSGBOX "Graphx is to be destroyed.", %MB_OK, "tbGraphx_yes!"
END SELECT

END FUNCTION

'----------------------------------------------------------------------------
FUNCTION Exec_Console_FColor() AS EXT
' Compose a new console foreground color.
' Usage: n = Console_fColor ( R AS LONG, G AS LONG, B AS LONG, Intense AS LONG)
'----------------------------------------------------------------------------
LOCAL R AS EXT, lR AS LONG
LOCAL G AS EXT, lG AS LONG
LOCAL B AS EXT, lB AS LONG
LOCAL Intense AS EXT, lIntense AS LONG
LOCAL ForeColor AS LONG

IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseNumber R
IF thinBasic_CheckComma() THEN
thinBasic_ParseNumber G
IF thinBasic_CheckComma() THEN
thinBasic_ParseNumber B
IF thinBasic_CheckComma() THEN
thinBasic_ParseNumber Intense
IF thinBasic_CheckCloseParens() THEN
lR = R
lG = G
lB = B
lIntense = Intense
IF lR THEN ForeColor = %FOREGROUND_RED
IF lG THEN ForeColor = ForeColor OR %FOREGROUND_GREEN
IF lB THEN ForeColor = ForeColor OR %FOREGROUND_BLUE
IF lIntense THEN ForeColor = ForeColor OR %FOREGROUND_INTENSITY
FUNCTION = ForeColor
END IF
END IF
END IF
END IF
END IF

END FUNCTION

'---------------------------------------------------------------------
SUB Exec_tbgraphx_Test
'---------------------------------------------------------------------
LOCAL VPTR AS LONG
LOCAL VAbsPos AS LONG
LOCAL myValue AS EXT
VPTR = 123456789

IF thinBasic_CheckOpenParens( ) THEN
thinBasic_VariableParse(VPtr, VAbsPos)
IF thinBasic_CheckCloseParens( ) THEN
MSGBOX STR$ (VPtr) & "," & STR$ (VAbsPos) & ", [" & "]", , "tbGraphx: " + DATE$
MyValue = 2010
thinBasic_ChangeVariableNumberDirect (VPtr, VAbsPos, MyValue)
END IF
END IF
END SUB

'------------------------------------------------------------------------------------
FUNCTION LoadLocalSymbols ALIAS "LoadLocalSymbols" (OPTIONAL BYVAL sPath AS STRING) EXPORT AS LONG
'------------------------------------------------------------------------------------
thinBasic_LoadSymbol "MyHEX$", %thinBasic_ReturnString, CODEPTR(Exec_HEX), %thinBasic_ForceOverWrite
thinBasic_LoadSymbol "Console_fColor", %thinBasic_ReturnNumber, CODEPTR(Exec_Console_FColor), %thinBasic_ForceOverWrite
thinBasic_LoadSymbol "tbGraphx_Test", %thinBasic_ReturnNone, CODEPTR(Exec_tbGraphx_Test ), %thinBasic_ForceOverWrite
thinBasic_LoadSymbol "graphMe", %thinBasic_ReturnCodeLong, CODEPTR(Exec_graphMe ), %thinBasic_ForceOverWrite
'---
'Here define/add new thinBasic equates
'---
thinBasic_AddEquate "%MyNumericEquate", "" , 1
thinBasic_AddEquate "$MyStringEquate", "ABC" , 0

END FUNCTION

'----------------------------------------------------------------------------
FUNCTION UnLoadLocalSymbols ALIAS "UnLoadLocalSymbols" () EXPORT AS LONG

FUNCTION = 0&
END FUNCTION


FUNCTION LIBMAIN ALIAS "LibMain" (BYVAL hInstance AS LONG, _
BYVAL fwdReason AS LONG, _
BYVAL lpvReserved AS LONG) EXPORT AS LONG
SELECT CASE fwdReason
CASE %DLL_PROCESS_ATTACH

FUNCTION = 1
EXIT FUNCTION
CASE %DLL_PROCESS_DETACH

FUNCTION = 1
EXIT FUNCTION
CASE %DLL_THREAD_ATTACH

FUNCTION = 1
EXIT FUNCTION
CASE %DLL_THREAD_DETACH

FUNCTION = 1
EXIT FUNCTION
END SELECT

END FUNCTION

' ======================
' Popup dialog procedure
' ==================================================================
FUNCTION PopupDlgProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL szFile AS STRING
LOCAL hParent AS LONG

SELECT CASE wMsg
CASE %WM_CREATE
EnableWindow GetWindow(hWnd, %GW_OWNER), %FALSE ' To make the popup dialog modal

CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
IF HI(WORD, wParam) = %BN_CLICKED THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF

CASE %ButtonOpen
IF HI(WORD, wParam) = %BN_CLICKED THEN
'ShowPopupDialog hwnd
EXIT FUNCTION
END IF

CASE %ButtonImage
IF HI(WORD, wParam) = %BN_CLICKED THEN
MSGBOX "test loading for new dialog with picture ok?", %MB_OK, "thinbasic Image Tester"
ShowImageDialog hwnd
'---------------------------------------------------------------------
' SendMessage hWnd, EXE.PATH$ & "leopardenX.jpg"
'IF wParam THEN SendMessage hWnd,1,1, %LVM_SETBKIMAGE '%WM_COMMAND
EXIT FUNCTION
END IF

CASE %ButtonColBox
MSGBOX "Coloured Box first part ", %MB_ICONINFORMATION, "tb_graphx Test"
LOCAL hWinx AS DWORD
LOCAL z AS LONG
LOCAL vt AS LONG
LOCAL xt AS LONG
GRAPHIC WINDOW "BoxColEffect", 300, 300, 240, 240 TO hWinx
GRAPHIC ATTACH hWinx, 0
FOR z& = 0 TO 255
GRAPHIC LINE (0, z&) - (255, z&), RGB(55, 210, z&+50)*128
NEXT
FOR vt& = 0 TO 255
GRAPHIC LINE (0, vt&) - (255, vt&), RGB(255, 210, vt&+150)*255
NEXT
SLEEP 1500

END SELECT

CASE %WM_CLOSE
EnableWindow GetWindow(hWnd, %GW_OWNER), %TRUE ' Maintains parent's zorder

CASE %WM_DESTROY
PostQuitMessage 0 ' This function closes the main window
EXIT FUNCTION

END SELECT

FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION

==================================================================
FUNCTION ShowPopupDialog (BYVAL hParent AS LONG) AS LONG 'hParent

LOCAL hWndPopup AS LONG
LOCAL hCtl AS LONG
LOCAL hFont AS LONG
LOCAL rc AS RECT
LOCAL wcex AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 80
LOCAL szCaption AS ASCIIZ * 255
LOCAL hInstance AS DWORD

hFont = GetStockObject(%ANSI_VAR_FONT)

szClassName = "MyPopupClassName"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(PopupDlgProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = GetModuleHandle("")
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %COLOR_3DFACE + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIcon = 0
wcex.hIconSm = 0
RegisterClassEx wcex

GetWindowRect hParent, rc ' For centering child in parent
rc.nRight = rc.nRight - rc.nLeft ' Parent's width
rc.nBottom = rc.nBottom - rc.nTop ' Parent's height

szCaption = "Graphx_Popup dialog"
hWndPopup = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_CONTROLPARENT, _
szClassName, szCaption, %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE OR %WS_OVERLAPPEDWINDOW OR %WS_CLIPCHILDREN, _
rc.nLeft + (rc.nRight - 290) / 2, _
rc.nTop + (rc.nBottom - 180) / 2, _
360, 220, hParent, 0, GetModuleHandle(""), BYVAL %NULL)

hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
200, 118, 75, 23, hWndPopup, %IDCANCEL, hInstance, BYVAL %NULL)
hCtl = CreateWindowEx(0, "BUTTON", "&Batman", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
60, 118, 75, 23, hWndPopup, %IDOK, hInstance, BYVAL %NULL)
IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

ShowWindow hWndPopup, %SW_SHOW
UpdateWindow hWndPopup
' Message handler loop
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
IF ISFALSE IsDialogMessage(hWndPopup, uMsg) THEN
TranslateMessage uMsg
DispatchMessage uMsg
END IF
WEND

FUNCTION = uMsg.wParam

END FUNCTION

'--- last part of code follows[/code]

for any ideas for optimizing this code I would be appreciated

best regards, frank

[Lionheart008]

I had to split this post because I couldn't send more characters in this postbox editor
more than 20000 characters aren't possible I have got this error message.

=>last part of powerbasic code:

[code=thinbasic]' ==================================================================

FUNCTION WindowProc4 (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

LOCAL hDC AS DWORD
LOCAL pPaint AS PAINTSTRUCT
LOCAL rc AS RECT

SELECT CASE uMsg

CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
IF HI(WORD, wParam) = %BN_CLICKED THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF

CASE %IDOK
IF HI(WORD, wParam) = %BN_CLICKED THEN
'
EXIT FUNCTION
END IF

END SELECT

CASE %WM_PAINT
hDC = BeginPaint(hwnd, pPaint)
GetClientRect hwnd, rc
SetBkMode hDC, %TRANSPARENT
SetTextColor hDC, %GREEN
DrawText hDC, "Hello, thinbasic Image Test", -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
EndPaint hwnd, pPaint
FUNCTION = %TRUE
EXIT FUNCTION

CASE %WM_ERASEBKGND
hDC = wParam
DrawGradient hwnd, hDC
GDIP_SetImageAttributesWrapMode hDC
FUNCTION = %TRUE
EXIT FUNCTION

CASE %WM_SIZE
IF wParam <> %SIZE_MINIMIZED THEN
GetClientRect hwnd, rc
MoveWindow GetDlgItem(hwnd, %IDOK), (rc.nRight - rc.nLeft) - 185, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
MoveWindow GetDlgItem(hwnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
END IF

CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION

END SELECT

FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION

' ==================================================================
SUB DrawGradient (BYVAL hwnd AS DWORD, BYVAL hdc AS DWORD)

LOCAL rc AS RECT
DIM vertex(1) AS TRIVERTEX

GetClientRect hwnd, rc

vertex(0).x = 0
vertex(0).y = 0
vertex(0).Red = &HFF00
vertex(0).Green = &HFF00
vertex(0).Blue = &H0000 'HF lila
vertex(0).Alpha = &H0000

vertex(1).x = rc.nRight - rc.nLeft
vertex(1).y = rc.nBottom - rc.nTop
vertex(1).Red = &H8000
vertex(1).Green = &H0000
vertex(1).Blue = &HF000 '&H0000
vertex(1).Alpha = &H0000

LOCAL gRect AS GRADIENT_RECT

gRect.UpperLeft = 0
gRect.LowerRight = 1

GradientFill hDc, vertex(0), 2, gRect, 1, %GRADIENT_FILL_RECT_H

END SUB

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

SUB GDIP_SetImageAttributesWrapMode (BYVAL hdc AS DWORD)

LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
LOCAL pImage AS DWORD
LOCAL pImgAttr AS DWORD
LOCAL strFileName AS STRING
LOCAL nWidth AS LONG
LOCAL nHeight AS LONG

hStatus = GdipCreateFromHDC(hdc, pGraphics)

strFileName = UCODE$("sonnenuntergang.png")
hStatus = GdipLoadImageFromFile(STRPTR(strFileName), pImage)
hStatus = GdipCreateImageAttributes(pImgAttr)

GdipSetImageAttributesWrapMode(pImgAttr, %WrapModeClamp, GDIP_ARGB(255, 255, 0, 0), %FALSE)
hStatus = GdipGetImageWidth(pImage, nWidth)
hStatus = GdipGetImageHeight(pImage, nHeight)
hStatus = GdipDrawImageRectRectI(pGraphics, pImage, _
10, 10, nWidth, nHeight, _ ' dest rect
0, 0, 2*nWidth, 2*nHeight, _ ' source dest
%UnitPixel, pImgAttr, %NULL, %NULL)
GdipSetImageAttributesWrapMode(pImgAttr, %WrapModeTile, GDIP_ARGB(255, 255, 0, 0), %FALSE)
hStatus = GdipDrawImageRectRectI(pGraphics, pImage, _
200, 10, nWidth, nHeight, _ ' dest rect
0, 0, 2*nWidth, 2*nHeight, _ ' source dest
%UnitPixel, pImgAttr, %NULL, %NULL)

' // Cleanup
IF pImgAttr THEN GdipDisposeImageAttributes(pImgAttr)
IF pImage THEN GdipDisposeImage(pImage)
IF pGraphics THEN GdipDeleteGraphics(pGraphics)

END SUB
' ==================================================================

FUNCTION ShowImageDialog (BYVAL hParent AS LONG) AS LONG

LOCAL hWndPopup AS LONG
LOCAL hCtl AS LONG
LOCAL hFont AS LONG
LOCAL hwnd AS DWORD
LOCAL rc AS RECT
LOCAL wcex AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 80
LOCAL szCaption AS ASCIIZ * 255
LOCAL hInstance AS DWORD
LOCAL hr AS LONG
LOCAL token AS DWORD
LOCAL StartupInput AS GdiplusStartupInput

' // Initialize the control

' Initialize GDI+
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
IF hr THEN
MSGBOX "Error initializing GDI+"
EXIT FUNCTION
END IF

hFont = GetStockObject(%ANSI_VAR_FONT)

szClassName = "MyPopupClassName"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(WindowProc4)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = GetModuleHandle("")
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %COLOR_3DFACE + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIcon = 0
wcex.hIconSm = 0
RegisterClassEx wcex

GetWindowRect hParent, rc ' For centering child in parent
rc.nRight = rc.nRight - rc.nLeft ' Parent's width
rc.nBottom = rc.nBottom - rc.nTop ' Parent's height

szCaption = "Graphx_Popup 2 dialog with IMAGE "
hWndPopup = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_CONTROLPARENT, _
szClassName, szCaption, %WS_CAPTION OR %WS_POPUPWINDOW OR %WS_VISIBLE OR %WS_OVERLAPPEDWINDOW OR %WS_CLIPCHILDREN, _
rc.nLeft + (rc.nRight - 520) / 2, _
rc.nTop + (rc.nBottom - 300) / 2, _
560, 380, hParent, 0, GetModuleHandle(""), BYVAL %NULL)

hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
390, 310, 75, 23, hWndPopup, %IDCANCEL, hInstance, BYVAL %NULL)
hCtl = CreateWindowEx(0, "BUTTON", "&TIGER", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
60, 310, 75, 23, hWndPopup, %IDOK, hInstance, BYVAL %NULL)

IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

ShowWindow hWndPopup, %SW_SHOW
UpdateWindow hWndPopup
' Message handler loop
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
IF ISFALSE IsDialogMessage(hWndPopup, uMsg) THEN
TranslateMessage uMsg
DispatchMessage uMsg
END IF
WEND

' // Force the resizing of the buttons by sending a WM_SIZE message
SendMessage hwnd, %WM_SIZE, 0, 0
GdiplusShutdown token

FUNCTION = uMsg.wParam

END FUNCTION[/code]

cut this last part and copy at the end of my last post, if somebody has fun to test the powerbasic code

If I understand how to handle with gdiplus features I can translate some ideas from powerbasic to thinbasic too. but it's more a learning tree for me to understand more about using "sdk" grasping. next step could be to load a different picture format (jpg, png, bmp, ico) and save it.


servus, frank

[Lionheart008]

good morning all.

hi eros. thanks first of all for this new topic column for "tb_graphx" !

1) one important question how to compile a function like "GetImageThumbnail(dc)" for thinbasic sdk:

my mind says this could be right way, but what I need to use for function?

'---------frankos how to do question with powerbasic

FUNCTION Exec_GetImageThumbnail (BYVAL hdc AS DWORD) AS Ext

LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
LOCAL strFileName AS STRING
LOCAL pImage AS DWORD
LOCAL nWidth AS DWORD
LOCAL nHeight AS DWORD
LOCAL pThumbnail AS DWORD
LOCAL nThumbnailWidth AS DWORD
LOCAL nThumbnailHeight AS DWORD

'---Parse open pares
IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseLong pImage
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong nWidth
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong nHeigth
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong pThumbnail

'---At the end check if close parens was specified
IF thinBasic_CheckCloseParens() THEN

FUNCTION = GdipGetImageThumbnail(pImage, 50, 50, pThumbnail, 0, 0)

END IF
END IF
END IF
END IF
END IF

'--------this part isn't important, isn't it ? I can delete this one ---------???
hStatus = GdipCreateFromHDC(hdc, pGraphics)

' // Create an image and a thumbnail of the image.
strFileName = UCODE$("leoparden1.png")
hStatus = GdipLoadImageFromFile(STRPTR(strFileName), pImage)
hStatus = GdipGetImageThumbnail(pImage, 50, 50, pThumbnail, %NULL, %NULL)

' // Draw the original and the thumbnail images.
hStatus = GdipGetImageWidth(pImage, nWidth)
hStatus = GdipGetImageHeight(pImage, nHeight)
hStatus = GdipDrawImageRect(pGraphics, pImage, 70, 70, nWidth, nHeight)

hStatus = GdipGetImageWidth(pThumbnail, nThumbnailWidth)
hStatus = GdipGetImageHeight(pThumbnail, nThumbnailHeight)
hStatus = GdipDrawImageRect(pGraphics, pThumbnail, 200, 20, nThumbnailWidth, nThumbnailHeight)

' // Cleanup
IF pThumbnail THEN GdipDisposeImage(pThumbnail)
IF pImage THEN GdipDisposeImage(pImage)
IF pGraphics THEN GdipDeleteGraphics(pGraphics)


END FUNCTION

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

2) there are two ways for creating and including such "tb_graph" module:
a) with thinbasic ui features ("Dialog new pixels" etcpp) : here user have many
chances and flexibilities to get new commands and influence to Image size/formats

b) complete new own UI for loading Images using GDIplus features with own sdk
window frame code in powerbasic (this must be faster so I have heard about).

3) well, better and easier could be to use "Dialog new pixels" and make some new
commands for special Image Properties (thumbnail, setPixel, noise factor, stretch,
rgba colour switching and much more). I prefered last evening this idea

4) interesting part would however be to create complete new dialogue window forms with
loading/saving/renaming/ changing Image formats and their properties.
(see my next post to point "2b" )

I think loud, because I am not sure what's the best way to do that.

any suggestions would be nice to hear, many thanks, nice sunday, Frank

[Petr Schreiber]

Ciao Frank,

I must say I consider it not very practical to have function to show dialog with hardwired buttons inside.

You can see UI module in ThinBASIC has Canvas control, which accepts data in BGRA format. So function returning image in this form would be slightly more "general purpose".


Petr

[Lionheart008]

thanks petr,

I must say I consider it not very practical to have function to show dialog with hardwired buttons inside.

1) Yes, I agree! -> I've decided to go the "classical" way to include new functions for UI module. I will try it. If you (or anybody else) have time and fun to test this little function ? I don't know how to define %NULL ("0)" for thinbasic ?

I can compile this with powerbasic. if I run this example for thinbasic side to test with
for example:

printl GetImageThumbnail(pImage,50,50,1,0,0)

then I've got general protection fault, although my function definition should be correct. I hope so.

powerbasic side:

FUNCTION Exec_GetImageThumbnail (BYVAL hdc AS DWORD) AS EXT

LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
LOCAL strFileName AS STRING
LOCAL pImage AS DWORD
LOCAL nWidth AS DWORD
LOCAL nHeight AS DWORD
LOCAL pThumbnail AS DWORD
LOCAL nThumbnailWidth AS DWORD
LOCAL nThumbnailHeight AS DWORD
LOCAL pZero AS LONG ' %NULL ?
LOCAL pZero2 AS Long ' %NULL ?

'---Parse open pares
IF thinBasic_CheckOpenParens() THEN
thinBasic_ParseLong pImage
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong nWidth
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong nHeight
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong pThumbnail
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong pZero '?
IF thinBasic_CheckComma() THEN
thinBasic_ParseLong pZero2 '?

'---At the end check if close parens was specified
IF thinBasic_CheckCloseParens() THEN

' Function = GdipGetImageThumbnail(pImage, 50, 50, pThumbnail, %NULL, %NULL)
FUNCTION = GdipGetImageThumbnail(pImage, nWidth, nHeight, pThumbnail, 0, 0)
END IF
END IF
END IF
END IF
END IF
END IF
END IF
hStatus = GdipCreateFromHDC(hdc, pGraphics)

End Function

2) I've tested this gdiplus example, but adding my module the example doesn't work.
I'm thinking this is caused by my powerbasic function, there must be missing little thing.

thinbasic side:
[code=thinbasic] '------------------------------------------------------------------------------
' Load needed modules
'------------------------------------------------------------------------------
Uses "UI"
Module "graphx"

'------------------------------------------------------------------------------
' Equates
'------------------------------------------------------------------------------
Begin Const
%lImage = 1000
%lText
End Const

Function TBMain()
'---Test if module was loaded. If not, abort!
If Uses("GDIP") < 0 Then
MsgBox 0, "GDI+ lib not found"
Stop
End If

'------------------------------------------------------------------------------
' Create dialog
'------------------------------------------------------------------------------
Dim hDlg As DWord

Dialog NEW PIXELS, 0, "thinBasic using GDI+", -1, -1, 400, 326, _
%WS_DLGFRAME Or _
%DS_CENTER Or _
%WS_CAPTION Or _
%WS_SYSMENU Or _
%WS_CLIPCHILDREN Or _
%WS_OVERLAPPEDWINDOW, _
0 To hDlg

'------------------------------------------------------------------------------
' Show dialog
'------------------------------------------------------------------------------
Dialog SHOW MODAL hDlg, Call dlgCallback

End Function
'------------------------------------------------------------------------------
' Main loop
'------------------------------------------------------------------------------
CallBack Function dlgCallback() As Long
Dim JPGFileName As String = APP_SourcePath + "Images\ferrari-enzo.png"
Dim JPGFileName2 As String = APP_SourcePath + "Images\leoparden1.png"
Dim lWidth As Long
Dim lHeight As Long
Dim hBitmap, hGpBitmap As Long
Dim x,y As Long
'Dim pThumbnail as long = 120

Select Case CBMSG

Case %WM_INITDIALOG
'------------------------------------------------------------------------------
' Create constrols and Load images
'------------------------------------------------------------------------------
Control ADD LABEL, CBHNDL, %lImage,"", 20, 20, 380, 300, %SS_BITMAP

'---Create an image handle
hGpBitmap = GDIp_CreateBitMapFromFile(JPGFileName2)
'---Convert to a BMP handle
hBitmap = GDIP_HBitMapFromBitmap(hGpBitmap)

Control SEND CBHNDL, %lImage, %STM_SETIMAGE, %IMAGE_BITMAP, hBitmap
Control REDRAW CBHNDL, %lImage

'---Get image W and H
lWidth = GDIP_GetImageWidth(hGpBitmap)
lHeight = GDIP_GetImageHeight(hGpBitmap)

'-------------------------------------------- frankos new attempt
lWidth = GetImageThumbnail(hGpBitmap,50, 50, 120, 0, 0)
lHeight = GetImageThumbnail(hGpBitmap,50, 50, 120, 0, 0)
'-------- (pImage, 50, 50, pThumbnail, %NULL, %NULL)
'-------------------------------------------- frankos new attempt

Control ADD LABEL, CBHNDL, %lText, "thinBasic GDI+ module wrapper example (" & lWidth & " x " & lHeight & ")", 0, 311, 400, 15, %SS_CENTER
Control SET COLOR CBHNDL, %lText, RGB(0,0,0), RGB(255,128,0)
Control REDRAW CBHNDL, %lText

Control SET RESIZE CBHNDL, %lImage, 1, 1, 1, 1
Control SET RESIZE CBHNDL, %lText , 1, 1, 0, 1

DoEvents

Case %WM_SIZE
Control REDRAW CBHNDL, %lImage

Case %WM_CLOSE
' -- Erase resources
'---Release temp hBitmap
Object_Delete(hBitmap)
'---Release GDI image
GDIP_DisposeImage(hGpBitmap)

End Select

End Function[/code]


best regards, thanks, frank