View Full Version : thinbasic+gdiplus experiments
largo_winch
28-10-2011, 20:30
http://www.thinbasic.com/community/showthread.php?11428-UI-ImageCTX-quot-IMAGECTX_SaveImage-quot/page2&p=85085#post85085
'------------------------------------------------------------------------------------>
Info: mainly source codes were adepted from Jose Roca's website about "gdiplus" examples and headers were cut from "windows api headers". If there are changes in the include file they are related to my translation experience for Thinbasic language ;)
1) gdiplus examples:
http://www.jose.it-berater.org/smfforum/index.php?PHPSESSID=8477a536a4f54048cdd19bc3bec14f49&board=277.0
2) windows api headers for gdiplus and all related include files:
http://www.jose.it-berater.org/smfforum/index.php?topic=4232.0
'------------------------------------------------------------------------------------>
hello! here's my first testing for gdiplus + thinbasic. I am not sure how to make the right setup, cause I don't know where a) to initialize Gdiplus and (for this example "DrawImage" function) how to place the Image into dialog (in callback below "%WM_INITIDIALOG" and I have to make a own "label" for it? )
It's possible to get more hints for right gdiplus setup in callback?
the example was compiled (interpreted) well but without showing the image. I make an Include file with important things for gdiplus. (the last part of include file isn't ready, but I don't need it at the moment)
here my first gdiplus example for thinbasic:
' Empty GUI script created on 10-28-2011 13:00:11 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' ========================================================================================
Sub GDIP_DrawImage (ByVal hdc As DWord)
Local hStatus As Long
Local pGraphics As DWord
Local pImage As DWord
Local strFileName As String
hStatus = GdipCreateFromHDC(hdc, pGraphics)
' // Create the Image object
strFileName = Ucode$("haderer1.jpg")
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), pImage)
' // Draw the image
hStatus = GdipDrawImage(pGraphics, pImage, 10, 10)
' // Cleanup
If pImage Then GdipDisposeImage(pImage)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "Managing gdiplus Controls",-1,-1, 420, 250, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
' -- Place controls here
Dim cx, cy As Long
Dialog Pixels hDlg, 400, 300 To Units cx, cy
Control Add Canvas, hDlg, %Canvas_Gdip, "", 5, 5, cx, cy
Control Add Button, hDlg, %bClose, "Close", 80+cx, cy+5-14, 50, 18, Call bCloseProc
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
Canvas_Attach(CBHNDL, %Canvas_Gdip, %FALSE)
DrawGraphics()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' =================
Sub DrawGraphics()
Local hdc As DWord, hDlg As Long
Local token As DWord
Local StartupInput As GdiplusStartupInput
Canvas_Color Rgb(128, 255, 0), Rgb(0, 0, 0)
Canvas_Clear(Rgb(0,0,0)) '255
Canvas_Scale Pixels
Canvas_Attach hDlg, %Canvas_Gdip, Redraw '0
' Clear the entire selected graphic window
Canvas_Clear(Rgb(0,0,0))
' Retrieve the handle of the device context
Canvas_GetDC 'To hdc
' Draw the graphics
GDIP_DrawImage
End Sub
' -- Callback for close button
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
PrintL "test gdiplus"
all I've saved in zip file you can see below.
notice: all gdip features and functions I collected this+last day from various powerbasic sources and from jose roca's website and from my uncle.
bye largo
Michael Clease
29-10-2011, 00:10
Here is a version that doesn't require canvas but you will need to use the includes that I modified for TB (originally from Jose) not all of the includes have been converted because most of them will work just fine. Its been 2 years since i played with the includes (i think).
largo_winch
29-10-2011, 01:02
before I go to bed I say thank you :) I never saw command like "Win_Show(CBHNDL, %SW_SHOWNORMAL)" before! that's a good way to catch the image, but it's also possible to manipulate and save this image too? I will check tomorrow.
I included "GdipCreateFromHWND" function into my "gdip_lw1a.inc" file too. thanks for this help michael! I was very close last hour to your solution with my example but after I have used a label in %WM_INITDIALOG and nothing happened because I couldn't show the image missing the "cbhndl" and like you did with "Win_Show Command". I didn't know yet if there is a equal good way for it using a label and canvas modus ? but I am sure there must be a way.
my new example as zip file I send again with my updated "Gdiplus_lw1a" include file.
bye, largo
Michael Clease
29-10-2011, 09:52
its best not to try an attach the same canvas several times.
You seem to have an identity crisis you don't know if you are a canvas or a gdi device both can do almost the same job but Canvas is easier because it is wrapped up for you.
largo_winch
29-10-2011, 17:09
I show two new gdiplus examples with canvas controls:
a) gdiplus_closed curves
b) gdiplus_draw_bezier
both thinbasic examples for testing:
' Empty GUI script created on 10-28-2011 13:00:11 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "tb_gdiplus draw_Closed_curve",-1,-1, 620, 400, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
Local cx, cy As Long, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- Place controls here
Dialog Pixels CBHNDL, 600, 400 To Units cx, cy
Control Add Canvas, CBHNDL, %Canvas_Gdip, "", 5, 5, cx+100, cy+100
Control Add Button, CBHNDL, %bClose, "Close", 80+cx, cy+5-84, 50, 18, 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_PAINT
GDIP_DrawClosedCurve()
'GDIP_DrawBezier()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' -- Callback for close button
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
Sub GDIP_DrawClosedCurve () '(ByVal hDc As DWord)
Local hStatus As Long
Local hDc As DWord
Local pGraphics As DWord
Local pGreenPen As DWord
Local pRedBrush As DWord
Local point1 As POINTF
Local point2 As POINTF
Local point3 As POINTF
Local point4 As POINTF
Local point5 As POINTF
Local point6 As POINTF
Local point7 As POINTF
Local point8 As POINTF
Dim curvePoints(8) As POINTF
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics) 'hdc
' // Create a green Pen
hStatus = GdipCreatePen1(GDIP_ARGB(255, 0, 255, 0), 1.0, %UnitWorld, pGreenPen)
point1.x = 100.0 : point1.y = 100.0
point2.x = 200.0 : point2.y = 50.0
point3.x = 400.0 : point3.y = 10.0
point4.x = 500.0 : point4.y = 100.0
point5.x = 600.0 : point5.y = 200.0
point6.x = 700.0 : point6.y = 400.0
point7.x = 500.0 : point7.y = 500.0
curvePoints(1) = point1
curvePoints(2) = point2
curvePoints(3) = point3
curvePoints(4) = point4
curvePoints(5) = point5
curvePoints(6) = point6
curvePoints(7) = point7
' // Draw the closed curve
hStatus = GdipDrawClosedCurve(pGraphics, pGreenPen, curvePoints(1), 7)
' // Create the brush
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 255, 0, 0), pRedBrush)
' //Draw the points in the curve
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 95, 95, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 495, 95, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 495, 495, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 195, 45, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 395, 5, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 595, 195, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 695, 395, 10, 10)
' // Cleanup
If pRedBrush Then GdipDeleteBrush(pRedBrush)
If pGreenPen Then GdipDeletePen(pGreenPen)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
Sub GDIP_DrawBezier() '(ByVal hdc As DWord)
Local hStatus As Long
Local hDc As DWord
Local pGraphics As DWord
Local pGreenPen As DWord
Local pRedBrush As DWord
Local pBlueBrush As DWord
Local startPointx As Single
Local startPointy As Single
Local ctrlPoint1x As Single
Local ctrlPoint1y As Single
Local ctrlPoint2x As Single
Local ctrlPoint2y As Single
Local endPointx As Single
Local endPointy As Single
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Create a green Pen
hStatus = GdipCreatePen1(GDIP_ARGB(255, 0, 255, 0), 1.0, %UnitWorld, pGreenPen)
startPointx = 100.0
startPointy = 100.0
ctrlPoint1x = 200.0
ctrlPoint1y = 10.0
ctrlPoint2x = 350.0
ctrlPoint2y = 50.0
endPointx = 500.0
endPointy = 100.0
' // Draw the curve
hStatus = GdipDrawBezier(pGraphics, pGreenPen, startPointx, startPointy, ctrlPoint1x, ctrlPoint1y, ctrlPoint2x, ctrlPoint2y, endPointx, endPointy)
' // Create the brushes
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 255, 0, 0), pRedBrush)
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 0, 255), pBlueBrush)
' //Draw the end points and control points.
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 100 - 5, 100 - 5, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pRedBrush, 500 - 5, 100 - 5, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pBlueBrush, 200 - 5, 10 - 5, 10, 10)
hStatus = GdipFillEllipse(pGraphics, pBlueBrush, 350 - 5, 50 - 5, 10, 10)
' // Cleanup
If pBlueBrush Then GdipDeleteBrush(pBlueBrush)
If pRedBrush Then GdipDeleteBrush(pRedBrush)
If pGreenPen Then GdipDeletePen(pGreenPen)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
both two new gdiplus examples I send as attachement with pics and include file updated.
info: both examples are adepted from jose roca's website and the thread about gdiplus:
http://www.jose.it-berater.org/smfforum/index.php?PHPSESSID=0de410051ccec88fdf8dd665bc858e21&board=277.0
bye, largo
largo_winch
31-10-2011, 10:11
here I show a new gdip example: "GdipDrawImageRect"
If anybody likes these "gdiplus" examples and see to continue, send a reply. otherwise I stop this working, if there's no interest for it.
"gdipDrawImageRect"
' Empty GUI script created on 10-31-2011 09:12:11 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "tb_gdiplus draw_ImageRect",-1,-1, 420, 200, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
Local cx, cy As Long, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- Place controls here
Dialog Pixels CBHNDL, 400, 150 To Units cx, cy
Control Add Canvas, CBHNDL, %Canvas_Gdip, "", 5, 5, cx+100, cy+100
Control Add Button, CBHNDL, %bClose, "Close", 80+cx, cy+5-84, 50, 18, 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_PAINT
GDIP_GdipDrawImageRect()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' -- Callback for close button
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
' =================
Sub GDIP_GdipDrawImageRect()
Local hStatus As Long
Local pGraphics As DWord
Local pImage As DWord
Local strFileName As String
Local pPen As DWord
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Create the Image object
strFileName = Ucode$("samsung1.jpg")
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), pImage)
' // Create a red Pen
hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1.0, %UnitWorld, pPen)
' // Draw the original source image.
hStatus = GdipDrawImage(pGraphics, pImage, 10, 10)
' // Draw the rectangle that bounds the image.
hStatus = GdipDrawRectangle(pGraphics, pPen, 200+38, 50+38, 152, 80)
' // Draw the image
'hStatus = GdipDrawImageRect(pGraphics, pImage, 200 + 1, 50 + 1 , 150 - 1, 75 - 1)
hStatus = GdipDrawImageRect(pGraphics, pImage, 200 + 40, 50 + 40, 148, 77)
' // Cleanup
If pPen Then GdipDeletePen(pPen)
If pImage Then GdipDisposeImage(pImage)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
bye, largo
Hi largo
of course keep posting those GDIp examples and any possible variations, your examples and Michael examples are valuable. it is not only the possible users are who live on the time line of october-november-2011 , the possible users are sitting there in the future and also from someone googling about gdi and redirected here.
some of my posts i consider it as a personal notes and references and when i can't find it on my hard disk i find it here.
ErosOlmi
31-10-2011, 13:59
I am not interested but very interested from a GDIP thinBasic module point of view.
I will start very soon to document current GDIP module and implement it.
As zak said, do not do things because there is or there is not interest. Do things because you like, because you have some passion for the argument.
Maybe the interest of other people will follow or not, it doesn't matter.
If I had to develop thinBasic because there was interests I would have stopped 2 days after the start.
largo_winch
31-10-2011, 16:07
thanks zak for taking interests and eros :)
1) question one:
...
Local BlackFullTranslucent as Dword
...
hStatus = GdipSetPathGradientSurroundColorsWithCount(pBrush1, BlackFullTranslucent, 1)
'error for "BlackFullTranslucent": Expected a parameter passed BYREF but found something else.
declare function:
Declare Function GdipSetPathGradientSurroundColorsWithCount Lib "GDIPLUS.DLL" Alias "GdipSetPathGradientSurroundColorsWithCount" ( _
ByVal brush As DWord _ ' __in GpPathGradient *brush
, ByRef Color As DWord _ ' __out GDIPCONST ARGB *color
, ByRef count As Long _ ' __out INT *count
) As Long ' GpStatus
I've got an "error message code 300" about this BYREF parameter "BlackFullTranslucent" (it's not a value, ok, but how to convert it to thinbasic?)
2) yes, I know all about motivation and enthusiasm, no problem! I agree to you eros. It's possible to explore more about GDIP module ? Or it's possible to co-work at this module? ;)
bye, largo
ErosOlmi
31-10-2011, 16:57
problem is not "Color" parametre but "Count". It expects a "BYREF Long" variable but you passes value 1 (I have to improve determination of current token during error checking)
Create a LONG varible, assign 1 to it and pass it as parameter
the only way to collaborate is to publish GDIP module as source code in thinBasic SVN server and you need to have PowerBasic Compiler at least 9.x or better 10.x
Ciao
Eros
largo_winch
31-10-2011, 17:15
thank you eros, problem was indeed "count" parameter :)
for this example I have to adept and updated "gdiplus_lw1a.inc" features.
working example "gdiplus draw spheres":
' Empty GUI script created on 10-31-2011 09:12:11 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "tb_gdiplus draw_Spheres",-1,-1, 420, 270, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
Local cx, cy As Long, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- 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", 80+cx, cy+5-84, 50, 18, 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_PAINT
GDIP_DrawSpheres()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' -- Callback for close button
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
Sub GDIP_DrawSpheres ()
Local hStatus As Long
Local hDc As DWord
Local x As Long
Local y As Long
Local nSize As Long
Local pGraphics As DWord
Local pPath1 As DWord
Local pBrush1 As DWord
Local pPath2 As DWord
Local pBrush2 As DWord
Local MiddleColorToOpaque As DWord
Local BlackFullTranslucent As DWord
Local counts As Long
counts = 1
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Create a GraphicsPath object.
hStatus = GdipCreatePath(%FillModeAlternate, pPath1)
' // Add an ellipse to the path.
x = 100 : y = 50 : nSize = 220
hStatus = GdipAddPathEllipseI(pPath1, x, y, nSize, nSize)
' // Create a path gradient based on the ellipse.
hStatus = GdipCreatePathGradientFromPath(pPath1, pBrush1)
' // Set the middle color of the path.
MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_MediumAquamarine, 0)
hStatus = GdipSetPathGradientCenterColor(pBrush1, MiddleColorToOpaque)
' // Set the entire path boundary to Alpha Black using 50% translucency.
BlackFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Black, 128)
hStatus = GdipSetPathGradientSurroundColorsWithCount(pBrush1, BlackFullTranslucent, counts)
' // Draw the ellipse, keeping the exact coordinates defined for the path,
' // and using antialising mode (+ 2 and - 4 are used to better achieve antialiasing)
hStatus = GdipSetSmoothingMode(pGraphics, %SmoothingModeAntiAlias)
hStatus = GdipFillEllipseI(pGraphics, pBrush1, x + 2, y + 2, nSize - 4, nSize - 4)
' // Create a second GraphicsPath object.
hStatus = GdipCreatePath(%FillModeAlternate, pPath2)
' // Add an ellipse to the path
x = 200 : y = 200 : nSize = 150
hStatus = GdipAddPathEllipseI(pPath2, x, y, nSize, nSize)
' // Create a path gradient based on the ellipse.
hStatus = GdipCreatePathGradientFromPath(pPath2, pBrush2)
' // Set the middle color of the path.
MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_Yellow, 64)
hStatus = GdipSetPathGradientCenterColor(pBrush2, MiddleColorToOpaque)
' // Set the entire path boundary to Alpha Black using 50% translucency
BlackFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Red, 128)
GdipSetPathGradientSurroundColorsWithCount(pBrush2, BlackFullTranslucent, counts) '1
' // Draw the ellipse, keeping the exact coords we defined for the path
hStatus = GdipFillEllipseI(pGraphics, pBrush2, x + 2, y + 2, nSize - 4, nSize - 4)
' // Cleanup
If pPath1 Then GdipDeletePath(pPath1)
If pPath2 Then GdipDeletePath(pPath2)
If pBrush1 Then GdipDeleteBrush(pBrush1)
If pBrush2 Then GdipDeleteBrush(pBrush2)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
b)
the only way to collaborate is to publish GDIP module as source code in thinBasic SVN server and you need to have PowerBasic Compiler at least 9.x or better 10.x
that's a good idea, do it! :)
"gdiplus_spheres" example as zip file as attachement.
bye, largo
have you noticed that when the two spheres picture needs to be repainted it gets darker like the attached picture. either when covering it or moving the form.
7588
largo_winch
01-11-2011, 17:00
1) hello zak, nice to see what happened to redraw the sphere sub in %WM_Paint twice a time, thanks.
2) "gdip-setTextRenderingHint" example:
this is a hard rock for me. the sub works ok as I have tested.
after placing everything at right place (below: %WM_Paint) and updated the thinbasic gdip include file the "gdip_setTextRenderingHint" example stops after compiling. looking at the error I've found
modname: "oleout32.dll" error
'--------------------> thinbasic error
Case %WM_PAINT
'GDIP_SetTextRenderingHint() 'not working
'modname: "oleout32.dll" error
Canvas_Redraw
'--------------------> thinbasic error
I don't know what's the problem showing rendering text in my canvas control scene. anybody has an idea?
"GDIP_SetTextRenderingHint()" isn't working. I have desactivate this line for testing, you have to desactivate this line to see the error ;).
attention: use at own risk!
' Empty GUI script created on 11-01-2011 15:02:20 by (ThinAIR)
Uses "console", "ui"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
%bPush
End ControlID
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
Local StartupInput As GdiplusStartupInput
' Initialize GDI+
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, 0)
If hr Then
MsgBox "Error initializing GDI+"
Exit Function
End If
Dialog New 0, "tb_gdiplus draw_Text_RenderingHint",-1,-1, 420, 270, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
'----------------------------->
'GDIP_SetTextRenderingHint() ' only for test to see if sub is working :)
End Function
CallBack Function DlgProc() As Long
Local cx, cy, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- Place controls here
Dialog Pixels CBHNDL, 400, 250 To Units cx, cy
Control Add Canvas, CBHNDL, %Canvas_Gdip, "", 5, 5, cx+100, cy+100 'area+size of rendering content
Control Add Button, CBHNDL, %bClose, "Close", 80+cx, cy+5-84, 40, 18, Call bCloseProc
Control Add Button, CBHNDL, %bpush, "push", 5+cx, cy+5-84, 40, 18
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
'--------------------> thinbasic error
Case %WM_PAINT
'GDIP_SetTextRenderingHint() 'not working
'modname: "oleout32.dll" error
Canvas_Redraw
'--------------------> thinbasic error
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
'---------> tests
Case %bPush
If CBCTLMSG = %BN_CLICKED Then
GDIP_SetTextRenderingHint() 'only for testing if sub is working
Canvas_Redraw
End If
'---------> tests
End Select
End Select
End Function
'---------------------------------->
Sub GDIP_SetTextRenderingHint()
'---------------------------------->
Local hStatus As Long
Local hDc As DWord
Local pGraphics As DWord
Local pPen As DWord
Local pFont As DWord
Local pFontFamily As DWord
Local pFormat As DWord
Local pBrush As DWord
Local strFontName As String
Local strText As String
Local rcf As RECTF
Local counts As Long
counts = 1
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
MsgBox 0, "test 1 begin sub"
' // Set the text rendering hint to TextRenderingHintSingleBitPerPixel.
hStatus = GdipSetTextRenderingHint(pGraphics, %TextRenderingHintSingleBitPerPixel)
' // Create the font
strFontName = Ucode$("Arial")
hStatus = GdipCreateFontFamilyFromName(StrPtr(strFontName), %NULL, pFontFamily)
If hStatus = %StatusOk And pFontFamily <> %NULL Then
hStatus = GdipCreateFont(pFontFamily, 24, %FontStyleRegular, %UnitPoint, pFont)
GdipDeleteFontFamily(pFontFamily)
End If
' // Create a solid brush
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 0, 0), pBrush)
' // Draw text
strText = Ucode$("Low quality rendering")'
hStatus = GdipDrawString(pGraphics, StrPtr(strText), Len(strText) \ 2, pFont, rcf, pFormat, pBrush)
MsgBox 0, "test 2 middle sub"
' // Set the text rendering hint to TextRenderingHintAntiAlias.
hStatus = GdipSetTextRenderingHint(pGraphics, %TextRenderingHintAntiAlias)
' // Draw more text to demonstrate the difference.
strText = Ucode$("High quality rendering")
rcf.y = 50
hStatus = GdipDrawString(pGraphics, StrPtr(strText), Len(strText) \ 2, pFont, rcf, pFormat, pBrush)
' // Cleanup
If pFont Then GdipDeleteFont(pFont)
If pPen Then GdipDeletePen(pPen)
If pBrush Then GdipDeleteBrush(pBrush)
If pFormat Then GdipDeleteStringFormat(pFormat)
If pGraphics Then GdipDeleteGraphics(pGraphics)
MsgBox 0, "test 3 end sub ok :)"
End Sub
' -- Callback for close button
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
may be the problem concern another thing but I cannot find it.
new include in zip file.
addendum:
3) new infos: problem seems to be a missing include file as "ole32" or "objIdl.inc" with a (for example)
...
$IID_IStorage = GUID$("{0000000B-0000-0000-C000-000000000046}")
INTERFACE IStorage $IID_IStorage
...
and much more. the example above isn't very important for me but I guess this cannot be converted into thinbasic because of missing GUID's and Methods. I am not sure about these things, but I guess so.
Declare Function OleBuildVersion Lib "OLE32.DLL" Alias "OleBuildVersion" ( _
) As DWord ' DWORD
'/* helper functions */
Declare Function ReadClassStg Lib "OLE32.DLL" Alias "ReadClassStg" ( _
ByVal pStg As IStorage _ ' __in IStorage* pStg
, ByRef pclsid As Guid _ ' __out CLSID* pclsid
) As Long ' HRESULT
bye, largo
largo_winch
02-11-2011, 11:04
two new gdip examples for thinbasic
a) Gdip_BmpSetPixel
b) Gdip_BmpGetPixel
both examples in one you only have to change the "sub" line below %WM_Paint.
' Empty GUI script created on 10-31-2011 + 11-02-2011, 09:12:11 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "tb_gdiplus BitmapSetPixel",-1,-1, 420, 270, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
Local cx, cy As Long, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- 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", 80+cx, cy+5-84, 50, 18, 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_PAINT
GDIP_SetPixel()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' -- Callback for close button
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
Sub GDIP_SetPixel ()
Local hStatus As Long
Local pGraphics As DWord
Local pBitmap As DWord
Local strFileName As String
Local pixelColor As DWord
Local nWidth As DWord
Local nHeight As DWord
Local row As Long
Local col As Long
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Create a Bitmap object from a JPEG file.
strFileName = Ucode$("metallica1.jpg")
hStatus = GdipCreateBitmapFromFile(StrPtr(strFileName), pBitmap)
' // Draw the bitmap
hStatus = GdipDrawImageI(pGraphics, pBitmap, 10, 10)
' // Get the width and height of the bitmap
hStatus = GdipGetImageWidth(pBitmap, nWidth)
hStatus = GdipGetImageHeight(pBitmap, nHeight)
' // Make an ARGB color
pixelColor = GDIP_ARGB(255, 0, 0, 0)
'modify if you like ----------------->
'pixelColor = GDIP_ARGB(255, 0, 255, 100)
' // Create a checkered pattern with black pixels.
For row = 1 To nWidth - 1 Step 2
For col = 1 To nHeight Step 2
hStatus = GdipBitmapSetPixel(pBitmap, row, col, pixelColor)
Next
Next
' // Draw the altered bitmap.
hStatus = GdipDrawImageI(pGraphics, pBitmap, 200, 200)
' // Cleanup
If pBitmap Then GdipDisposeImage(pBitmap)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
Sub GDIP_GetPixel ()
Local hStatus As Long
Local pGraphics As DWord
Local pBitmap As DWord
Local pSolidBrush As DWord
Local strFileName As String
Local pixelColor As DWord
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Create a Bitmap object from a JPEG file.
strFileName = Ucode$("metallica1.jpg")
hStatus = GdipCreateBitmapFromFile(StrPtr(strFileName), pBitmap)
' // Get the value of a pixel from myBitmap.
hStatus = GdipBitmapGetPixel(pBitmap, 10, 10, pixelColor)
' // Fill a rectangle with the pixel color.
hStatus = GdipCreateSolidFill(pixelColor, pSolidBrush)
hStatus = GdipFillRectangleI(pGraphics, pSolidBrush, 0, 0, 100, 100)
' // Cleanup
If pSolidBrush Then GdipDeleteBrush(pSolidBrush)
If pBitmap Then GdipDisposeImage(pBitmap)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
zip file attached (incl. updated thinbasic_gdiplus include file)
info: For some converting gdip example I need "iStream" and that inherits to "iUnknown" class that doesn't work with current thinbasic issue (so far as I've explored it). These examples are waiting to get the light of day at future times of thinbasic 1.9 or 2.x version, but I have no problem to wait.
all in all these are good thingies to learn more about programming language between powerbasic + thinbasic ! and the website of microsoft for commands and syntax. (funny thing is that I am not programming with powerbasic at all) ;)
bye, largo
largo_winch
03-11-2011, 16:06
new example:
' Empty GUI script created on 11-03-2011 15:11:33 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "tb_gdiplus GetImageGraphicsContext",-1,-1, 420, 210, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
Local cx, cy As Long, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- Place controls here
Dialog Pixels CBHNDL, 400, 200 To Units cx, cy
Control Add Canvas, CBHNDL, %Canvas_Gdip, "", 5, 5, cx+100, cy+100
Control Add Button, CBHNDL, %bClose, "Close", 80+cx, cy+5-84, 50, 18, 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_PAINT
GDIP_GetImageGraphicsContext()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' -- Callback for close button
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
'------------------------------------>
Sub GDIP_GetImageGraphicsContext ()
'------------------------------------>
Local hStatus As Long
Local pGraphics As DWord
Local pImage As DWord
Local pImageGraphics As DWord
Local pBrush As DWord
Local strFileName As String
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Create an Image object from a PNG file.
strFileName = Ucode$("pattern.png")
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), pImage)
' // Create a Graphics object that is associated with the image.
hStatus = GdipGetImageGraphicsContext(pImage, pImageGraphics)
' // Alter the image.
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 255, 100), pBrush)
hStatus = GdipFillEllipse(pImageGraphics, pBrush, 30, 30, 100, 50) '10, 40, 100, 50)
' // Draw the altered image.
hStatus = GdipDrawImage(pGraphics, pImage, 50, 50)
' // Cleanup
If pBrush Then GdipDeleteBrush(pBrush)
If pImage Then GdipDisposeImage(pImage)
If pImageGraphics Then GdipDeleteGraphics(pImageGraphics)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
example and new GDIPLUS_LW1a.INC as zipfile.
bye, largo
largo_winch
03-11-2011, 16:32
thinbasic gdip_drawImage:
' Empty GUI script created on 10-31-2011 + 11-03-2011, 15:32:15 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "tb_gdiplus DrawImage",-1,-1, 420, 270, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
Local cx, cy As Long, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- 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", 80+cx, cy+5-84, 50, 18, 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_PAINT
GDIP_DrawImage()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' -- Callback for close button
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
'-------------------->
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$("Metallica1a.jpg")
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), pImage)
' // Draw the image
hStatus = GdipDrawImage(pGraphics, pImage, 10, 10)
' // Cleanup
If pImage Then GdipDisposeImage(pImage)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
lydia_sp
15-11-2011, 13:30
hello largo, that's a good job! I am interesting to see more of gdiplus examples! I thought it was impossible to use gdiplus functions with thinbasic ;) lydia
ErosOlmi
15-11-2011, 17:20
hello largo, that's a good job! I am interesting to see more of gdiplus examples! I thought it was impossible to use gdiplus functions with thinbasic ;) lydia
Why impossible?
As far as a library uses standard dll, thinBasic can use it.
In the case of GDI+ library, it exposes a flat application programming interface (API, that is standard dll) that consists of about 600 functions, which are implemented in Gdiplus.dll.
Microsoft has than wrapped these functions with classes but they are still available as standard dll interface.
largo_winch
17-11-2011, 11:58
new thinbasic example "tb_gdiplus_SetTextRenderingHint":
http://www.jose.it-berater.org/smfforum/index.php?topic=1829.0
' Empty GUI script created on 11-17-2011 10:22:23 by (ThinAIR)
' http://www.jose.it-berater.org/smfforum/index.php?topic=1829.0
Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_STRINGS.INC"
'---------------------------->
Begin ControlID
%Canvas_Gdip
%bClose
End ControlID
'-------------> BEGIN OF EXAMPLE ----------------------->
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function TBMain() As Long
Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
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
Dialog New 0, "tb_gdiplus setTextRenderingHint",-1,-1, 420, 200, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
' Shutdown GDI+
GdiplusShutdown token
End Function
' ========================================================================================
' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CallBack Function DlgProc() As Long
Local cx, cy, hDc As Long
' -- Test for messages
Select Case CBMSG
Case %WM_INITDIALOG
' -- 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", 80+cx, cy+5-84, 50, 18, 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_PAINT
GDIP_SetTextRenderingHint()
Canvas_Redraw
Case %WM_COMMAND
Select Case CBCTL
Case %IDCANCEL
If CBCTLMSG = %BN_CLICKED Then Dialog End CBHNDL, 0
End Select
End Select
End Function
' -- Callback for close button
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
Sub GDIP_SetTextRenderingHint (ByVal hdc As DWord)
Local hStatus As Long
Local pGraphics As DWord
Local pPen As DWord
Local pFont As DWord
Local pFontFamily As DWord
Local pFormat As DWord
Local pBrush As DWord
Local strFontName As String
Local strText As String
Local rcf As RECTF
hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)
' // Set the text rendering hint to TextRenderingHintSingleBitPerPixel.
hStatus = GdipSetTextRenderingHint(pGraphics, %TextRenderingHintSingleBitPerPixel)
' // Create the font
strFontName = Ucode$("Arial")
hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(strFontName), %NULL, ByVal VarPtr(pFontFamily) )
If hStatus = %StatusOk And pFontFamily <> %NULL Then
hStatus = GdipCreateFont(pFontFamily, 24, %FontStyleRegular, %UnitPoint, ByVal VarPtr(pFont ))
GdipDeleteFontFamily(pFontFamily)
End If
' Note: You can use the wrapper function GdiPlusCreateFontFromName to create the font:
' hStatus = GdiPlusCreateFontFromName("Arial", 24, %FontStyleRegular, %UnitPoint, pFont)
' // Create a solid brush
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 0, 0), ByVal VarPtr(pBrush) )
' // Draw text
strText = Ucode$("Low quality rendering")
hStatus = GdipDrawString(pGraphics, ByVal StrPtr(strText), Len(strText) \ 2, pFont, ByVal VarPtr(rcf), pFormat, pBrush)
' // Set the text rendering hint to TextRenderingHintAntiAlias.
hStatus = GdipSetTextRenderingHint(pGraphics, %TextRenderingHintAntiAlias)
' // Draw more text to demonstrate the difference.
strText = Ucode$("High quality rendering")
rcf.y = 50
hStatus = GdipDrawString(pGraphics, ByVal StrPtr(strText), Len(strText) \ 2, pFont, ByVal VarPtr(rcf), pFormat, pBrush)
' // Cleanup
If pFont Then GdipDeleteFont(pFont)
If pPen Then GdipDeletePen(pPen)
If pBrush Then GdipDeleteBrush(pBrush)
If pFormat Then GdipDeleteStringFormat(pFormat)
If pGraphics Then GdipDeleteGraphics(pGraphics)
End Sub
I have add for these examples with "strings" a new "GDIPLUS_STRINGS.INC" file. I will collect all gdiplus functions in one file again after some days, if I have changed and updated my last "gdiplus_lw1b.inc" file. "tb_gdiplus_createStringFormat" new examples I add in zip file too.
bye, largo