byref parameter

[largo_winch]

anybody can help to fix this example? do you get any errors or this example is running well?

uses at own risk:


' Empty GUI script created on 11-03-2011 16:21:37 by (ThinAIR)

Uses "console"

Declare Function GdipGetImageEncodersSize Lib "GDIPLUS.DLL" Alias "GdipGetImageEncodersSize" ( _
ByRef numEncoders As Long _ 'DWord
, ByRef lSize As Long _ 'DWord
) As Long

Dim vx As Long
Dim tx As Long
vx = 10
tx = 20

'---------------> error ----------------->
PrintL GdipGetImageEncodersSize(vx,tx)
'---------------> error ----------------->

WaitKey

'Expected a parameter passed BYREF but found something else.



here's a problem with "ntdll.dll" and this example isn't working fine.

bye, largo

[Petr Schreiber]

As the documentation of GDIPlus says, before using the library functions you need to call GdiplusStartup. I think this is why your example fails, because according to my tests with such a call it works as expected.

On more serious note, regarding "your" headers (posted in your other GDI+ related recent threads)
Issue #1:
They seem to me ripped off José Roca headers, especially because I can see some PB syntax in declarations (alignment in types, ...), original C declares in comments exactly like José does.
It would be very polite to cite the sources in comment on the beginning of the file. José does all the conversions with enormous precision manually and spends a lot of time on it.

Many of the functions are just Ctrl-C, Ctrl-V from PB, for example GdiPlusGetEncoderClsid2, where I can see PowerBASIC @ pointer syntax, which is something not present in ThinBASIC.

Issue #2:
Many of the parameter names, such as:


ByVal Bitmap As DWord

for example in GdipBitmapSetPixel will collide with ThinBASIC keywords, if it is highlighted, better to change it to something else (for example Bitmap -> pBitmap)

The example code you post lately seems to me again mostly translation of work of José, again citation of original version would be on place.


Thanks for understanding,
Petr

[largo_winch]

http://www.thinbasic.com/community/showthread.php?11433-thinbasic-gdiplus-experiments

hello petr. thanks for your reply! I have added a notice to my first gdip translation for thinbasic and credits to jose's website and headers. I've collected various sources (have noticed that in one of my post, I am sure) and therefore I have different issues for "gdipplus" include files for thinbasic. I know about these problems with colliding with tb commands/syntax and powerbasic language, but I was able to convert some example they are working very well.

I haven't background to convert all perfect, I am learning by doing. But I wanted to search a middle golden way for adepting powerbasic code (that I didn't know very well) to thinbasic. I was surprised how equal a lot of commands looks like! But there were a lot of commands they didn't work. Example for converting BMP into PNG with my "gdiplus_lw1a.inc" failed because of pointers and GUID's. I tried to separate different code parts to see where are the main problems. but that's not easy after some hours of exploring gdiplus headers from jose roca (he did a great job I know, I know! :) ).

I will explore and know more about these differences between powerbasic + thinbasic and my aim is to convert all examples for thinbasic about gdiplus topics.

btw: my problem remains with error. but I know there are commands they aren't working with current thinbasic issue. But I don't know what's all possible with Thinbasic power and therefore I ask here at board.


' Empty GUI script created on 11-03-2011 16:21:37 by (ThinAIR)

Uses "console", "ui"

'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->

Dim vx, tx As Long

Function TBMain() As Long

Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
Local StartupInput As GdiplusStartupInput

vx = 10
tx = 20

' Initialize GDI+
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, ByVal %NULL)
If hr Then
MsgBox "Error initializing GDI+"
Exit Function
End If

'---------------> error ----------------->
'PrintL GdipGetImageEncodersSize(vx, tx)
'---------------> error ----------------->

' Shutdown GDI+
GdiplusShutdown token

End Function

MsgBox 0, "end of example"

WaitKey




This is only a code part of another gdiplus example ("Converting BMP", see below). I can show a lot of other translation copy's of my work but that will cause trouble or confusion. I will proof closer what's possible and making more tests. I like that converting work.

only an experimental code part "converting bmp":


'------------------->
Sub convertingBMP()
'------------------->

Local hLib, hLib1 As Long
Local token As DWord
Local EncoderClsid As Guid
Local pImage As DWord
Local eps As EncoderParameters
Local ep As EncoderParameter
Local nWidth As DWord
Local nHeight As DWord
Local transformation As DWord
Local strFileName As String
Local hStatus As Long
Local s1 As String = Guid$
Local s2 As String = GuidTxt$(s1)
MsgBox 0, s2

hLib = LoadLibrary("Oleaut32.dll")
MsgBox 0, Str$(hLib)

' hLib1 = LoadLibrary("ntdll.dll")
' MsgBox 0, Str$(hLib1)

's1="image/png"
'Guid$={00000000-0000-0000-0000-000000000000}

strFileName = Ucode$("Metallica1.bmp")

'------------> Problemzone 1) ------------------------------->
'hStatus = GdipLoadImageFromFile(StrPtr(strFileName), pImage)
'------------> Problemzone 1) ------------------------------->

Encoderclsid = Guid$(s1)

MsgBox 0, "here's begin of converting_Bmp Sub"

' // Get the CLSID of the PNG encoder.

'------------> Problemzone 2) ------------------------------->
'a)
'EncoderClsid = Guid$(GdiPlusGetEncoderClsid("image/png"))
'b)
'EncoderClsid = Guid$(GdiPlusGetEncoderClsid(s1) )
'------------> Problemzone 2) ------------------------------->

' // Save the image.
strFileName = Ucode$("Metallica1.png")

'------------> Problemzone 3) ------------------------------->
'hStatus = GdipSaveImageToFile(pImage, StrPtr(strFileName), EncoderClsid, 0) 'ByVal %NULL
'------------> Problemzone 3) ------------------------------->

If hStatus = %StatusOk Then
PrintL "Shapes.png saved successfully"
Else
PrintL "Attempt to save Shapes.png failed"
End If

' // Cleanup
If pImage Then GdipDisposeImage(pImage)

' // Shutdown GDI+
GdiplusShutdown token
MsgBox 0, "here's end of converting_Bmp Sub"
End Sub




thanks for feedback, petr. I agree in most parts with you. but what would you recommend (for example) translation pointer problems to thinbasic ? last not least, I don't give, I like thinbasic! I know you are a very good programmer and you know my problems for converting code in general.

bye, largo

[Petr Schreiber]

Hi Largo,

the problem is you probably accidentaly misunderstood the program flow in the first case - it waits for keypress in the beginning, instead of the end.
Why? Because ThinBASIC, as documented, first executes global space and then jumps to TBMain, which means the order of execution is:

Uses "console", "ui"
#INCLUDE "GDIPLUS_LW1a.INC"
Dim vx, tx As Long
MsgBox 0, "end of example"
Waitkey ' -- Here it makes you think program does nothing
TBMain()


The working code listing for #1 is this:


Uses "console", "ui"

'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->

Dim vx, tx As Long

Function TBMain() As Long

Local hr As Long
Local hDlg As DWord
Local hdc As DWord
Local token As DWord
Local StartupInput As GdiplusStartupInput

vx = 10
tx = 20

' Initialize GDI+
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, ByVal %NULL)
If hr Then
MsgBox "Error initializing GDI+"
Exit Function
End If

'--------------->
PrintL GdipGetImageEncodersSize(vx, tx)
PrintL vx
PrintL tx
'--------------->

' Shutdown GDI+
GdiplusShutdown token

PrintL "Press any key to quit..."
WaitKey
End Function


To address the problem with converting pointer syntax. ThinBASIC offers these functions to work on pointer-related stuff:

PEEK/POKE
PEEK$/POKE$
VARPTR/STRPTR
DIM..AT syntax, along with SetAt, GetAt

To give example, the original code in PB:


Local pImageCodecInfo As ImageCodecInfo Ptr
...
hr = GdipGetImageEncoders(numEncoders, nSize, ByVal pImageCodecInfo)
...
Function = GuidTxt$(@pImageCodecInfo.Clsid)

becomes this in ThinBASIC (would work in PB as well):


Local myImageCodecInfo As ImageCodecInfo ' -- No need to create pointer
...
hr = GdipGetImageEncoders(numEncoders, nSize, VarPtr(myImageCodecInfo)) ' -- Passing the pointer just here, to get pointer to variable you can use VarPtr
...
Function = GuidTxt$(myImageCodecInfo.Clsid) ' -- Returning it directly, no pointer dereferencing needed


This is one particular case. In general, I like very much the Dim..At concept.


' -- Example for dynamically allocating EXT precition variable

Dim pVariable As DWord ' -- Our pointer, DWord can hold the address to -any- variable just fine

' -- Allocate memory dynamically, for the variable of type EXT
pVariable = HEAP_Alloc( SizeOf(Ext) )

' -- To write/read at that address we can create DIM..AT overlay instead of using pointers
Dim myVariable As Ext At pVariable ' -- Literally "Look at address pVariable as place for EXT variable"

myVariable = 5 ' -- In PB, you would do @pVariable = 5
MsgBox 0, myVariable ' -- In PB, you would do MSGBOX FORMAT$(@pVariable )

' -- Release memory
HEAP_Free(pVariable)

Of course, the allocations are needed only if it is your memory, you can create overlays over existing "normal" variables as well, and in such a case no such a operation is needed.
PB pointer version:


' -- Accessing 3rd array element via pointer

Dim myArray(3) As Ext
ARRAY ASSIGN myArray() = 1, 2, 3 ' -- Initial values 1, 2, 3

Dim pViewAtElement3 As Ext Pointer
pViewAtElement3 = VarPtr(myArray(3))

@pViewAtElement3 = 456 ' -- Accessing it and changing

MsgBox 0, format$(myArray(1))+","+format$(myArray(2))+","+format$(myArray(3)) ' -- Voila! It really changed 3rd index value to 456


ThinBasic Dim..At version:


' -- Accessing 3rd array cell via Dim..At

Dim myArray(3) As Ext = 1, 2, 3 ' -- Initial values 1, 2, 3

Dim myViewAtElement3 As Ext At VarPtr(myArray(3)) ' -- Overlaying logical variable over 3rd element

myViewAtElement3 = 456 ' -- Accessing it and changing

MsgBox 0, Join$(myArray, ",") ' -- Voila! It really changed 3rd index value to 456

... and as a bonus, super short variable declaration ThinBASIC version:


' -- Accessing 3rd array cell via Dim..At

Ext myArray(3) = 1, 2, 3 ' -- Initial values 1, 2, 3

Ext myViewAtElement3 At VarPtr(myArray(3)) ' -- Overlaying logical variable over 3rd element

myViewAtElement3 = 456 ' -- Accessing it and changing

MsgBox 0, Join$(myArray, ",") ' -- Voila! It really changed 3rd index value to 456

Petr

[largo_winch]

thanks for pointer infos and arrays, I will proof this concept petr too! :)

my second problem zone (from three, four zones!) :


...
Local hr As Long
Local i As Long
' Local pImageCodecInfo As ImageCodecInfo Ptr ''powerbasic
Local myImageCodecInfo As ImageCodecInfo ' -- No need to create pointer
Local numEncoders As DWord
'Local nSize As DWord 'powerbasic
Local nSize As Long Value 10000 'my idea: only as a test value !
Local buffer As String

'-------------------------------------------------------------------------->
hr = GdipGetImageEncoders(numEncoders, nSize, VarPtr(myImageCodecInfo))
' -- Passing the pointer just here, to get pointer to variable you can use VarPtr

'new my idea ------>
Dim MyBufferArray(Len(Buffer)) As Byte At StrPtr(Buffer) ' my idea
'new my idea ------>

'ReDim buffer(nSize - 1) As Byte 'powerbasic
ReDim MyBufferArray(nSize - 1) As Byte
'myImageCodecInfo = VarPtr(buffer(0)) 'powerbasic
myImageCodecInfo = VarPtr(MyBufferArray(1))
'pImageCodecInfo = VarPtr(bufferArray(0))'powerbasic

'-------------------------------------------------------------------------->




ReDim buffer(nSize - 1) As Byte

caused problems too. My idea was to make an array with "MyBufferArray(nSize-1) as Byte. but that's not perfect I guess. any idea for making better? (green : powerbasic, black : thinbasic)

again the original powerbasic code part for needing translation:


...
LOCAL hr AS LONG
LOCAL i AS LONG
LOCAL pImageCodecInfo AS ImageCodecInfo PTR
LOCAL numEncoders AS DWORD
LOCAL nSize AS DWORD

hr = GdipGetImageEncodersSize(numEncoders, nSize)
REDIM buffer(nSize - 1) AS BYTE
pImageCodecInfo = VARPTR(buffer(0))
...



thank's for help!, bye largo

[Petr Schreiber]

Local nSize As Long Value 10000 'my idea: only as a test value !

This is not necessary, the nSize parameter is actually filled by call to GdipGetImageEncodersSize.

Because nSize is number of elements (in this case BYTEs), and ThinBASIC arrays are 1 based, the correct array declaration would be:


ReDim MyBufferArray(nSize) As Byte


Otherwise you risk memory corruption.


Petr

[largo_winch]

thanks petr first of all for your last correction!

(use at own risk) my next problemzone concerns :


'------------> Problemzone 3) ------------------------------->
'Expected a parameter passed BYREF but found something else.

hStatus = GdipSaveImageToFile(myImage, StrPtr(strFileName), EncoderClsid, 0) 'ByVal %NULL
'------------> Problemzone 3) ------------------------------->



I am not sure if I have to use Byval %Null at the end of function (then error with saving file) or only using "0", then "EncoderClsid" (GUID) expected a parameter passed byref.

here's the whole code example part and still it isn't perfect, but very close to the correct solution:


' Empty GUI script created on 11-04-2011 18:56:29 by largo_winch (ThinAIR)

Uses "console"

Uses "UI", "console"
'---------------------------->
#INCLUDE "GDIPLUS_LW1a.INC"
'---------------------------->
Declare Function LoadLibrary Lib "KERNEL32.DLL" _
Alias "LoadLibraryA" _
(lpLibFileName As Asciiz) As Long


Dim vx, tx As Long

'---------------------------> 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
Local sx As String

vx = 10
tx = 20

' Initialize GDI+
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, ByVal %NULL)
If hr Then
MsgBox "Error initializing GDI+"
Exit Function
End If

PrintL GdiPlusGetEncoderClsid(sx)

'--------------->
PrintL GdipGetImageEncodersSize(vx, tx)
PrintL vx
PrintL tx
'--------------->

PrintL convertingBMP()

' Shutdown GDI+
GdiplusShutdown token

PrintL "Press any key to quit..."
WaitKey
End Function

'Guid variables are a special form of 16-Byte String
'that are used To contain a 128-Bit Globally Unique Identifier (Guid),
'primarily For use With COM Objects.

'-------------------> TestZone * TestZone * TestZone * TestZone * TestZone
Sub convertingBMP()
'------------------->

Local hLib, hLib1 As Long
Local token As DWord
Local EncoderClsid As Guid
Local myImage As DWord
Local pGraphics As DWord
Local pBitmap As DWord
Local eps As EncoderParameters
Local ep As EncoderParameter
Local nWidth As DWord
Local nHeight As DWord
Local transformation As DWord
Local strFileName As String
Local hStatus As Long
Local s1 As String = Guid$
Local s2 As String = GuidTxt$(s1)
Local sx As String

sx = "image/png"

MsgBox 0, s2

'hLib = LoadLibrary("Oleaut32.dll")
'MsgBox 0, Str$(hLib)

'Guid$={00000000-0000-0000-0000-000000000000}

'hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)

' // Create a Bitmap object from a JPEG file.
strFileName = Ucode$("Metallica1.bmp")
hStatus = GdipCreateBitmapFromFile(StrPtr(strFileName), pBitmap)

' // Draw the bitmap ---> not needed at the moment
'hStatus = GdipDrawImageI(pGraphics, pBitmap, 10, 10)

'------------> Problemzone 1) solved ------------------------------->
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), myImage)
'------------> Problemzone 1) solved ------------------------------->

Encoderclsid = Guid$(s1)

MsgBox 0, "here's begin of converting_Bmp Sub"

' // Get the CLSID of the PNG encoder.
PrintL GdiPlusGetEncoderClsid(sx)

'--------------->
PrintL GdipGetImageEncodersSize(vx, tx)
PrintL vx
PrintL tx
'--------------->

'------------> Problemzone 2) solved ? ------------------------------->
'EncoderClsid = Guid$(GdiPlusGetEncoderClsid("image/png"))
EncoderClsid = GdiPlusGetEncoderClsid(sx)

' // Save the image.
strFileName = Ucode$("Metallica1.png")
EncoderClsid = GdiPlusGetEncoderClsid(sx)
'------------> Problemzone 2) solved ? ------------------------------->


'------------> Problemzone 3) ------------------------------->
'Expected a parameter passed BYREF but found something else.

hStatus = GdipSaveImageToFile(myImage, StrPtr(strFileName), EncoderClsid, 0) 'ByVal %NULL
'------------> Problemzone 3) ------------------------------->

If hStatus = %StatusOk Then
PrintL "Shapes.png saved successfully"
Else
PrintL "Attempt to save Metallica1.png failed"
End If

' // Cleanup
If myImage Then GdipDisposeImage(myImage)

' // Shutdown GDI+
GdiplusShutdown token
MsgBox 0, "here's end of converting_Bmp Sub"
End Sub

'-------------------> END OF TestZone * TestZone * TestZone * TestZone * TestZone

other two problems from beginning seems to be solved by your help :)

bye, largo

[Petr Schreiber]

Hi Largo,

#1)
The header file and this example you attach, which seems to be port of this code from José forum (http://www.jose.it-berater.org/smfforum/index.php?topic=1862.msg6504#msg6504), still do not give credit to José.
The tip with array is not applied as well.

#2)
GdipSaveImageToFile is declared (http://www.jose.it-berater.org/smfforum/index.php?topic=1861.0)as:


DECLARE FUNCTION GdipSaveImageToFile ( _
BYVAL pImage AS DWORD, _
BYVAL pFilename AS STRING, _
BYREF clsidEncoder AS GUID, _
BYREF encoderParams AS EncoderParameters _
) AS LONG




So the last param expects the ByRef parameter. That means, passing variable directly or passing pointer with ByVal override (which means "I pass address directly").
In this case, Byval %Null or ByVal 0 will work just fine.


Petr

[largo_winch]

original example: "gdip_convertingBMPtoPNG"
http://www.jose.it-berater.org/smfforum/index.php?topic=1862.0

thank you petr again for your feedback. Here's my next attempt but failed to convert *.bmp Image to *.png Image. I guess

a) problem zone is still:

EncoderClsid = Guid$(GdiPlusGetEncoderClsid("image/png")

b) my adepted code for "GdiPlusGetEncoderClsid" (my approach, see include file):



Function GdiPlusGetEncoderClsid (ByRef wszMimeType As String) As String

Local hr As Long
Local i As Long
' Local pImageCodecInfo As ImageCodecInfo Ptr ''powerbasic
Local myImageCodecInfo As ImageCodecInfo ' -- No need to create pointer
Local numEncoders As DWord
Local nSize As DWord 'powerbasic
' Local nSize As Long 'Value 10000 'my idea: only as a test value !
Local buffer As String
Local myMimeType as string
nSize = 1
'-------------------------------------------------------------------------->
hr = GdipGetImageEncoders(numEncoders, nSize, VarPtr(myImageCodecInfo))
' -- Passing the pointer just here, to get pointer to variable you can use VarPtr

'new my idea ------>
Dim MyBufferArray(Len(Buffer)) As Byte At StrPtr(Buffer) ' my idea
'new my idea ------>

'ReDim buffer(nSize - 1) As Byte 'powerbasic
ReDim MyBufferArray(nSize) As Byte 'nSize - 1

'myImageCodecInfo = VarPtr(buffer(0)) 'powerbasic
myImageCodecInfo = VarPtr(MyBufferArray(1))

'-------------------------------------------------------------------------->

hr = GdipGetImageEncoders(numEncoders, nSize, myImageCodecInfo) 'ByVal
If hr = 0 Then
For i = 1 To numEncoders '@MimeType
If InStr(Ucase$(myImageCodecInfo.myMimeType), Ucase$(wszMimeType)) Then
Function = GuidTxt$(myImageCodecInfo.Clsid)
' -- Returning it directly, no pointer dereferencing needed
' Function = GuidTxt$(@pImageCodecInfo.Clsid)
Exit For
End If
Incr myImageCodecInfo '// Increments pointer
Next
End If

End Function
'-------------------------> ORIGINAL ------------>




2) test gdip example for converting to thinbasic:


' Empty GUI script created on 11-07-2011 09:42:26 by largo_winch (ThinAIR)
' original example: http://www.jose.it-berater.org/smfforum/index.php?topic=1862.0
'

Uses "console", "ui"

#INCLUDE "gdiplus_lw1b.inc"


' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long

Local hStatus As Long
Local token As DWord
Local StartupInput As GdiplusStartupInput
Local EncoderClsid As Guid
Local myImage As DWord
Local eps As EncoderParameters
Local ep As EncoderParameter
Local nWidth As DWord
Local nHeight As DWord
Local transformation As DWord
Local strFileName As String
Local sx As String

sx = "image/png"

' // Initialize GDI+
StartupInput.GdiplusVersion = 1
hStatus = GdiplusStartup(token, StartupInput, ByVal %NULL)
If hStatus Then
Print "Error initializing GDI+"
Exit Function
End If

strFileName = Ucode$("Metallica1a.bmp")
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), myImage)
PrintL hStatus 'ok

' // Get the CLSID of the PNG encoder.

'--------> last problem zone ------------------------------------------->
EncoderClsid = Guid$(GdiPlusGetEncoderClsid("image/png")) 'original, doesn't work

' EncoderClsid = Guid$(GdiPlusGetEncoderClsid(sx) ) 'my idea
'PrintL EncoderClsid 'only for a test , ok :)

'--------> last problem zone ------------------------------------------->

' // Save the image.
strFileName = Ucode$("Metallica1a.png")
hStatus = GdipSaveImageToFile(myImage, StrPtr(strFileName), EncoderClsid, ByVal %NULL)
If hStatus = %StatusOk Then
PrintL "Shapes.png saved successfully"
Else
PrintL "Attempt to save Metallica1a.png failed"
End If

PrintL hStatus 'ok

' // Cleanup
If myImage Then GdipDisposeImage(myImage)

' // Shutdown GDI+
GdiplusShutdown token

PrintL "end of sub, press any key to exit"
WaitKey

End Function


attachement: zip file + new include file
bye, largo

[Petr Schreiber]

I am checking... stay tuned.


Petr

[Petr Schreiber]

Hi Largo,

got it working, here is single file example, you need to place your metallica1.bmp to same directory as script of course.
I recoded it from José's original, as there was lot of redundant code in your original example.


'original example: http://www.jose.it-berater.org/smfforum/index.php?topic=1862.0

Uses "console"

' ========================================================================================
' Main
' ========================================================================================
Function TBMain() As Long

Local hStatus As Long
Local token As DWord
Local StartupInput As GdiplusStartupInput
Local EncoderClsid As Guid
Local pImage As DWord
Local eps As EncoderParameters
Local ep As EncoderParameter
Local nWidth As DWord
Local nHeight As DWord
Local transformation As DWord
Local strFileName As String

' // Initialize GDI+
StartupInput.GdiplusVersion = 1
hStatus = GdiplusStartup(token, StartupInput, ByVal %NULL)
If hStatus Then
PrintL "Error initializing GDI+"
Exit Function
End If

strFileName = Ucode$("metallica1.bmp")
hStatus = GdipLoadImageFromFile(StrPtr(strFileName), pImage)

' // Get the CLSID of the PNG encoder.
EncoderClsid = Guid$(GdiPlusGetEncoderClsid("image/png"))

' // Save the image.
strFileName = Ucode$("metallica1.png")
hStatus = GdipSaveImageToFile(pImage, StrPtr(strFileName), EncoderClsid, ByVal %NULL)
If hStatus = %StatusOk Then
PrintL "metallica1.png saved successfully"
Else
PrintL "Attempt to save metallica1.png failed"
End If

' // Cleanup
If pImage Then GdipDisposeImage(pImage)

' // Shutdown GDI+
GdiplusShutdown token

Console_WaitKey


End Function

' -- Definitions from Josés headers
%StatusOk = 0

Type GdiplusStartupInput
GdiplusVersion As DWord
DebugEventCallback As DWord
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
If SizeOf(GdiplusStartupInput) <> 16 Then MsgBox 0, "Invalid size of GdiplusStartupInput"

Type GdiplusStartupOutput
NotificationHook As DWord
NotificationUnhook As DWord
End Type
If SizeOf(GdiplusStartupOutput) <> 8 Then MsgBox 0, "Invalid size of GdiplusStartupOutput"

Type EncoderParameter
pGuid As String * 16 ' // GUID of the parameter
NumberOfValues As DWord ' // Number of the parameter values
dwType As DWord ' // Value type, like ValueTypeLONG etc.
Value As DWord ' // A pointer to the parameter values
End Type
If SizeOf(EncoderParameter) <> 28 Then MsgBox 0, "Invalid size of EncoderParameter"

Type EncoderParameters
Count As DWord ' // Number of parameters in this structure
Parameter As EncoderParameter ' // Parameter values - variable-length array
End Type
If SizeOf(EncoderParameters) <> 32 Then MsgBox 0, "Invalid size of EncoderParameters"

Type ImageCodecInfo
Clsid As String * 16 ' CLSID
FormatID As String * 16 ' GUID
CodecName As Word Ptr ' const WCHAR*
DllName As Word Ptr ' const WCHAR*
FormatDescription As Word Ptr ' const WCHAR*
FilenameExtension As Word Ptr ' const WCHAR*
MimeType As Word Ptr ' const WCHAR*
Flags As DWord ' DWORD
Version As DWord ' DWORD
SigCount As DWord ' DWORD
SigSize As DWord ' DWORD
SigPattern As Byte Ptr ' const BYTE*
SigMask As Byte Ptr ' const BYTE*
End Type
If SizeOf(ImageCodecInfo) <> 76 Then MsgBox 0, "Invalid size of ImageCodecInfo"

Declare Function GdiplusStartup Lib "GDIPLUS.DLL" Alias "GdiplusStartup" (
ByRef token As DWord ' __out token ULONG_PTR
, ByRef input As GdiplusStartupInput ' __in input GdiplusStartupInput <record>
, ByRef output As GdiplusStartupOutput ' __out output GdiplusStartupOutput <record>
) As Long ' GpStatus

Declare Function GdipLoadImageFromFile Lib "GDIPLUS.DLL" Alias "GdipLoadImageFromFile" (
ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef Image As DWord ' __out GpImage **image
) As Long ' GpStatus

Declare Function lstrlenw Lib "KERNEL32.DLL" Alias "lstrlenW" ( _
ByVal lpString As DWord _ ' __in LPCWSTR lpString
) As Long

Declare Function GdipGetImageEncodersSize Lib "GDIPLUS.DLL" Alias "GdipGetImageEncodersSize" (
ByRef numEncoders As DWord ' __in UINT *numEncoders
, ByRef Size As DWord ' __out UINT *size
) As Long ' Status

Declare Function GdipGetImageEncoders Lib "GDIPLUS.DLL" Alias "GdipGetImageEncoders" (
ByVal numEncoders As DWord ' __in UINT numEncoders
, ByVal Size As DWord ' __in UINT size
, ByRef encoders As Any ' __out ImageCodecInfo *encoders
) As Long ' Status

Declare Function GdipSaveImageToFile Lib "GDIPLUS.DLL" Alias "GdipSaveImageToFile" (
ByVal Image As DWord ' __in GpImage *image
, ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef clsidEncoder As Guid ' __in GDIPCONST CLSID clsidEncoder
, ByRef encoderParams As EncoderParameters ' __out GDIPCONST EncoderParameters *encoderParams
) As Long

Declare Function GdipDisposeImage Lib "GDIPLUS.DLL" Alias "GdipDisposeImage" (
ByVal Image As DWord ' __in GpImage *image
) As Long ' GpStatus

Declare Sub GdiplusShutdown Lib "GDIPLUS.DLL" Alias "GdiplusShutdown" ( _
ByVal token As DWord _ ' __in token ULONG_PTR
) ' void
Function GdiPlusGetEncoderClsid (ByVal strMimeType As String) As String

Local hr As Long
Local pImageCodecInfo As DWord
Local numEncoders As DWord
Local nSize As DWord
Local i As Long
Local wstrlen As Long
Local sMimeType As String

hr = GdipGetImageEncodersSize(numEncoders, nSize)
Dim buffer(nSize) As Byte

pImageCodecInfo = VarPtr(buffer(1))
Local myImageCodecInfo As ImageCodecInfo At pImageCodecInfo

hr = GdipGetImageEncoders(numEncoders, nSize, ByVal pImageCodecInfo)
If hr = 0 Then
For i = 1 To numEncoders
wstrlen = lstrlenW(myImageCodecInfo.MimeType)
If wstrlen Then sMimeType = Acode$(Peek$(myImageCodecInfo.MimeType, wstrlen * 2))
If InStr(Ucase$(sMimeType), Ucase$(strMimeType)) Then
Function = GuidTxt$(myImageCodecInfo.Clsid)
Exit For
End If

pImageCodecInfo += SizeOf(ImageCodecInfo) '// Increments pointer
SetAt(myImageCodecInfo, pImageCodecInfo)
Next
End If

End Function


Petr

[largo_winch]

hi petr, thanks with reputation for you. there are only few differences between your new gdiplus encoder features, but very important and precious one, good job! I was frustrated (middle of last week) to see nearly no light for solving this example! do you get the headers of gdiplus from jose's website of the actual winapi headers?, bye largo

[Petr Schreiber]

Hi,

as written in the code comment, I used José's declares. Those for PB/WIN 9 to be precise. I had to modify the GUIDs, adapt the pointer syntax to TB but the rest worked fine.


Petr

[largo_winch]

http://www.jose.it-berater.org/smfforum/index.php?topic=1827.0

here's a new example with "tb_gdiplus create_StringFormat". only the "string" to show in rectangle box is missing. I've controlled and separated all needed gdip functions and declares in this example (like you did it in last example).

all in code example is working fine here, but the string doesn't work:


'-------------> problemzone ------------------------------------------------->
hStatus = GdipCreateStringFormat(0, %LANG_NEUTRAL, pFormat ) 'StrPtr(pFormat ) no!
'-------------> problemzone ------------------------------------------------->





' Empty GUI script created on 11-14-2011 14:33:05 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->

'------------------------->
' Example original from
' http://www.jose.it-berater.org/smfforum/index.php?topic=1827.0
'------------------------->

Uses "UI", "console"
'---------------------------->
'#INCLUDE "GDIPLUS_LW1b.INC"
'---------------------------->

'--------------------------------------------------------------------------------------------------
%UnitPixel = 2 ' Sets each unit to be one device pixel
'--------------------------------------------------------------------------------------------------

Begin ControlID
%Canvas_Gdip
%bClose
End ControlID

Type RectF
x As Long
y As Long
width As Long
height As Long
End Type

Type GDIP_BGRA_STRUCT Byte
blue As Byte
green As Byte
red As Byte
alpha As Byte
End Type

' // Size = 4 bytes
Union GDIP_BGRA_UNION
Color As DWord
GDIP_BGRA_STRUCT
End Union

'-------------------------->

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 create_StringFormat",-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_CreateStringFormat()
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_CreateStringFormat()
'------------------------------>

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 pBlackBrush As DWord
Local strFontName As String
Local strText As String
Local rcf As RECTF

hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)

' // Create the font
strFontName = Ucode$("Arial")
hStatus = GdipCreateFontFamilyFromName(StrPtr(strFontName), %NULL, pFontFamily)
If hStatus = %StatusOk And pFontFamily <> %NULL Then
hStatus = GdipCreateFont(pFontFamily, 16, %FontStyleRegular, %UnitPoint, pFont)
GdipDeleteFontFamily(pFontFamily)
End If

' Note: You can use the wrapper function GdiPlusCreateFontFromName to create the font:
'hStatus = GdiPlusCreateFontFromName("Arial", 16, %FontStyleRegular, %UnitPoint, pFont)

' // Create a solid brush
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 0, 0), pBlackBrush)

' // Draw the string
rcf.x = 30.0! : rcf.y = 30.0! : rcf.Width = 200.0! : rcf.Height = 25.0!

'-------------> problemzone ------------------------------------------------->
hStatus = GdipCreateStringFormat(0, %LANG_NEUTRAL, pFormat ) 'StrPtr(pFormat ) no!
'-------------> problemzone ------------------------------------------------->

hStatus = GdipSetStringFormatAlign(pFormat, %StringAlignmentCenter)
strText = Ucode$("Sample text")
hStatus = GdipDrawString(pGraphics, StrPtr(strText), Len(strText) \ 2, pFont, rcf, pFormat, pBlackBrush)

' // Create a Pen
hStatus = GdipCreatePen1(GDIP_ARGB(255,0, 0, 0), 3, %UnitPixel, pPen)

' // Draw a rectangle
hStatus = GdipDrawRectangle(pGraphics, pPen, rcf.x, rcf.y, rcf.Width, rcf.Height)

' // Cleanup
If pFont Then GdipDeleteFont(pFont)
If pBlackBrush Then GdipDeleteBrush(pBlackBrush)
If pPen Then GdipDeletePen(pPen)
If pFormat Then GdipDeleteStringFormat(pFormat)
If pGraphics Then GdipDeleteGraphics(pGraphics)

End Sub

'----------------> GDIP INCLUDE HELPERS ------------------------------------------------------>

' enum FillMode
%FillModeAlternate = 0
%FillModeWinding = 1
'---------------------------------->

%LANG_NEUTRAL = &H00??
%LANG_INVARIANT = &H7f??
'---------------------------------->

' enum StringAlignment

' // Left edge for left-to-right text,
' // right for right-to-left text,
' // and top for vertical

%StringAlignmentNear = 0
%StringAlignmentCenter = 1
%StringAlignmentFar = 2

Declare Function GdipSetStringFormatAlign Lib "GDIPLUS.DLL" Alias "GdipSetStringFormatAlign" ( _
ByVal pFormat As DWord, _
ByVal align As Long _
) As Long

Declare Function GdipCreateStringFormat Lib "GDIPLUS.DLL" Alias "GdipCreateStringFormat" ( _
ByVal formatAttributes As Long _ ' __in INT formatAttributes
, ByVal language As Word _ ' __in LANGID language
, ByRef format As DWord _ ' __out GpStringFormat **format '''[out] Pointer to a variable that receives a pointer to the new StringFormat object.
) As Long ' GpStatus

Declare Function GdipCreateFromHDC Lib "GDIPLUS.DLL" Alias "GdipCreateFromHDC" ( _
ByVal hdc As DWord _
, ByRef graphics As DWord _
) As Long

Declare Function GdipCreateFontFamilyFromName Lib "GDIPLUS.DLL" Alias "GdipCreateFontFamilyFromName" ( _
ByRef Names As String _ ' __in GDIPCONST WCHAR *name
, ByVal fontCollection As DWord _ ' __in GpFontCollection *fontCollection
, ByRef fontFamily As DWord _ ' __out GpFontFamily **fontFamily
) As Long ' GpStatus

Declare Function GdipCreateSolidFill Lib "GDIPLUS.DLL" Alias "GdipCreateSolidFill" ( _
ByVal Color As DWord _ ' __in ARGB color
, ByRef brush As DWord _ ' __out GpSolidFill **brush
) As Long ' GpStatus

Declare Function GdipDeleteFontFamily Lib "GDIPLUS.DLL" Alias "GdipDeleteFontFamily" ( _
ByVal fontFamily As DWord _ ' __in GpFontFamily *fontFamily
) As Long ' GpStatus

Declare Function GdipCreateFont Lib "GDIPLUS.DLL" Alias "GdipCreateFont" ( _
ByVal fontFamily As DWord _ ' __in GDIPCONST GpFontFamily *fontFamily
, ByVal emSize As Single _ ' __in REAL emSize
, ByVal style As Long _ ' __in INT style
, ByVal unit As Long _ ' __in GpUnit unit
, ByRef Font As DWord _ ' __out GpFont **font
) As Long ' GpStatus

'----------------------------------------------------------->
' -- Definitions from Josés headers
%StatusOk = 0

Type GdiplusStartupInput
GdiplusVersion As DWord
DebugEventCallback As DWord
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
If SizeOf(GdiplusStartupInput) <> 16 Then MsgBox 0, "Invalid size of GdiplusStartupInput"

Type GdiplusStartupOutput
NotificationHook As DWord
NotificationUnhook As DWord
End Type
If SizeOf(GdiplusStartupOutput) <> 8 Then MsgBox 0, "Invalid size of GdiplusStartupOutput"

Type EncoderParameter
pGuid As String * 16 ' // GUID of the parameter
NumberOfValues As DWord ' // Number of the parameter values
dwType As DWord ' // Value type, like ValueTypeLONG etc.
Value As DWord ' // A pointer to the parameter values
End Type
If SizeOf(EncoderParameter) <> 28 Then MsgBox 0, "Invalid size of EncoderParameter"

Type EncoderParameters
Count As DWord ' // Number of parameters in this structure
Parameter As EncoderParameter ' // Parameter values - variable-length array
End Type
If SizeOf(EncoderParameters) <> 32 Then MsgBox 0, "Invalid size of EncoderParameters"

Type ImageCodecInfo
Clsid As String * 16 ' CLSID
FormatID As String * 16 ' GUID
CodecName As Word Ptr ' const WCHAR*
DllName As Word Ptr ' const WCHAR*
FormatDescription As Word Ptr ' const WCHAR*
FilenameExtension As Word Ptr ' const WCHAR*
MimeType As Word Ptr ' const WCHAR*
Flags As DWord ' DWORD
Version As DWord ' DWORD
SigCount As DWord ' DWORD
SigSize As DWord ' DWORD
SigPattern As Byte Ptr ' const BYTE*
SigMask As Byte Ptr ' const BYTE*
End Type
If SizeOf(ImageCodecInfo) <> 76 Then MsgBox 0, "Invalid size of ImageCodecInfo"

Declare Function GdiplusStartup Lib "GDIPLUS.DLL" Alias "GdiplusStartup" (
ByRef token As DWord ' __out token ULONG_PTR
, ByRef input As GdiplusStartupInput ' __in input GdiplusStartupInput <record>
, ByRef output As GdiplusStartupOutput ' __out output GdiplusStartupOutput <record>
) As Long ' GpStatus

Declare Function GdipLoadImageFromFile Lib "GDIPLUS.DLL" Alias "GdipLoadImageFromFile" (
ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef Image As DWord ' __out GpImage **image
) As Long ' GpStatus

Declare Function lstrlenw Lib "KERNEL32.DLL" Alias "lstrlenW" ( _
ByVal lpString As DWord _ ' __in LPCWSTR lpString
) As Long

Declare Function GdipGetImageEncodersSize Lib "GDIPLUS.DLL" Alias "GdipGetImageEncodersSize" (
ByRef numEncoders As DWord ' __in UINT *numEncoders
, ByRef Size As DWord ' __out UINT *size
) As Long ' Status

Declare Function GdipGetImageEncoders Lib "GDIPLUS.DLL" Alias "GdipGetImageEncoders" (
ByVal numEncoders As DWord ' __in UINT numEncoders
, ByVal Size As DWord ' __in UINT size
, ByRef encoders As Any ' __out ImageCodecInfo *encoders
) As Long ' Status

Declare Function GdipSaveImageToFile Lib "GDIPLUS.DLL" Alias "GdipSaveImageToFile" (
ByVal Image As DWord ' __in GpImage *image
, ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef clsidEncoder As Guid ' __in GDIPCONST CLSID clsidEncoder
, ByRef encoderParams As EncoderParameters ' __out GDIPCONST EncoderParameters *encoderParams
) As Long

Declare Function GdipDisposeImage Lib "GDIPLUS.DLL" Alias "GdipDisposeImage" (
ByVal Image As DWord ' __in GpImage *image
) As Long ' GpStatus

Declare Sub GdiplusShutdown Lib "GDIPLUS.DLL" Alias "GdiplusShutdown" ( _
ByVal token As DWord _ ' __in token ULONG_PTR
)
' void
Function GdiPlusGetEncoderClsid (ByVal strMimeType As String) As String

Local hr As Long
Local pImageCodecInfo As DWord
Local numEncoders As DWord
Local nSize As DWord
Local i As Long
Local wstrlen As Long
Local sMimeType As String

hr = GdipGetImageEncodersSize(numEncoders, nSize)
Dim buffer(nSize) As Byte

pImageCodecInfo = VarPtr(buffer(1))
Local myImageCodecInfo As ImageCodecInfo At pImageCodecInfo

hr = GdipGetImageEncoders(numEncoders, nSize, ByVal pImageCodecInfo)
If hr = 0 Then
For i = 1 To numEncoders
wstrlen = lstrlenW(myImageCodecInfo.MimeType)
If wstrlen Then sMimeType = Acode$(Peek$(myImageCodecInfo.MimeType, wstrlen * 2))
If InStr(Ucase$(sMimeType), Ucase$(strMimeType)) Then
Function = GuidTxt$(myImageCodecInfo.Clsid)
Exit For
End If

pImageCodecInfo += SizeOf(ImageCodecInfo) '// Increments pointer
SetAt(myImageCodecInfo, pImageCodecInfo)
Next
End If

End Function

Function GDIP_ARGB (ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As DWord
Local clr As GDIP_BGRA_UNION
clr.alpha = a
clr.red = r
clr.green = g
clr.blue = b
Function = clr.Color
End Function

Declare Function GdipDrawString Lib "GDIPLUS.DLL" Alias "GdipDrawString" ( _
ByVal graphics As DWord _ ' __in GpGraphics *graphics
, ByRef Strings As String _ ' __in GDIPCONST WCHAR *string
, ByVal length As Long _ ' __in INT length
, ByVal pFont As DWord _ ' __in GDIPCONST GpFont *font
, ByRef layoutRect As RectF _ ' __in GDIPCONST GpRectF *layoutRect
, ByVal stringFormat As DWord _ ' __in GDIPCONST GpStringFormat *stringFormat
, ByVal brush As DWord _ ' __in GpBrush *brush
) As Long ' GpStatus

Declare Function GdipCreatePen1 Lib "GDIPLUS.DLL" Alias "GdipCreatePen1" ( _
ByVal pColor As DWord, _
ByVal nWidth As Single, _
ByVal unit As Long, _
ByRef pen As DWord _
) As Long

Declare Function GdipDrawRectangle Lib "GDIPLUS.DLL" Alias "GdipDrawRectangle" ( _
ByVal graphics As DWord, _
ByVal pen As DWord, _
ByVal x As Single, _
ByVal y As Single, _
ByVal nWidth As Single, _
ByVal nHeight As Single _
) As Long

Declare Function GdipDeleteBrush Lib "GDIPLUS.DLL" Alias "GdipDeleteBrush" ( _
ByVal brush As DWord _
) As Long

Declare Function GdipDeletePen Lib "GDIPLUS.DLL" Alias "GdipDeletePen" ( _
ByVal pen As DWord _
) As Long

Declare Function GdipDeleteStringFormat Lib "GDIPLUS.DLL" Alias "GdipDeleteStringFormat" ( _
ByVal pFormat As DWord _
) As Long

Declare Function GdipDeleteGraphics Lib "GDIPLUS.DLL" Alias "GdipDeleteGraphics" ( _
ByVal graphics As DWord _
) As Long



would be nice if you can check the example again :)

bye, largo

[Petr Schreiber]

Check how do you use GdipCreateFontFamilyFromName and how did you declared the parameters.


Petr

[largo_winch]

thank you, petr, but I cannot see the solution? Tried a lot of changing, but nothing works correct.

do you are meaning


hStatus = GdipCreateFontFamilyFromName(STRPTR(strFontName), %NULL, pFontFamily) ' original

Declare Function GdipCreateFontFamilyFromName Lib "GDIPLUS.DLL" Alias "GdipCreateFontFamilyFromName" ( _
ByRef pName As String _ ' __in GDIPCONST WCHAR *name
, ByVal fontCollection As DWord _ ' __in GpFontCollection *fontCollection
, ByRef fontFamily As DWord _ ' __out GpFontFamily **fontFamily
) As Long ' GpStatus



isn't correct?

I am thinking it could be also


'-------------> problemzone ------------------------------------------------->
hStatus = GdipCreateStringFormat(0, %LANG_NEUTRAL, pFormat ) 'StrPtr(pFormat ) no!
'-------------> problemzone ------------------------------------------------->



perhaps you have one detail more for me why the string isn't shown? -thanks!

bye, largo

[Petr Schreiber]

When you watch José's codes, you can see he stores the hStatus information for many function calls.

That serves the debugging purpose - if hStatus <> %StatusOk, it means something went wrong. %StatusOk has value of zero.

Tip #1:

place breakpoint on the beginning of body of TBMain (this can be done using right click in code / Insert code block / Debugger breakpoint)
press F8 to enter debugging mode
press F5 to execute until breakpoint
repeatedly press F8 and watch if the hStatus is really zero
you will see GdipCreateFontFamilyFromName call does not return zero - so something is wrong already there

Tip #2:

Watch the declaration:

Declare Function GdipCreateFontFamilyFromName Lib "GDIPLUS.DLL" Alias "GdipCreateFontFamilyFromName" ( _
ByRef pName As String _ ' __in GDIPCONST WCHAR *name
, ByVal fontCollection As DWord _ ' __in GpFontCollection *fontCollection
, ByRef fontFamily As DWord _ ' __out GpFontFamily **fontFamily
) As Long

Watch how you use it:

hStatus = GdipCreateFontFamilyFromName(STRPTR(strFontName), %NULL, pFontFamily)
The first parameter of the function is ByRef String, that means, you should pass string variable directly (thinBasic will obtain the pointer automagically) OR BYVAL STRPTR(stringvariable) (this forces the passed value to be understood as pointer). Passing STRPTR without BYVAL has no meaning, and is the cause of the problem.


Petr

[largo_winch]

here a little test, if I have understood your explanations and thanks for more details! :)


' Empty GUI script created on 11-15-2011 23:44:20 by largo_winch (ThinAIR)

Uses "console"

Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long)

'---------------->
Sub myexample()
'---------------->
Const TEST_TEXT As String = "Hello Largo "

Dim strString As String
Dim lngCounter As Long, lngPosition As Long

strString = $SPC(20 * Len(TEST_TEXT))

For lngCounter = 1 To 20

Call CopyMemory(ByVal StrPtr(strString) + lngPosition, _
ByVal StrPtr(TEST_TEXT), Len(TEST_TEXT) )

lngPosition = lngPosition + Len(TEST_TEXT)
Next

PrintL strString
PrintL test_text

End Sub

PrintL myexample()

PrintL "hello test end"
WaitKey



so I must change one of the problem zone of my last example (gdip_createStringFormat) line into


hStatus = GdipCreateFontFamilyFromName(byval strptr(strFontName), %NULL, ByVal StrPtr(pFontFamily ) )


and some more code parts too ;)

bye, largo

[largo_winch]

after I've checked all declarations new with byref/byval parameters I've got this new example:



' Empty GUI script created on 11-15-2011 23:59:24 by (ThinAIR)
' Empty GUI script created on 11-14-2011 14:33:05 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->

'------------------------->
' Example original from
' http://www.jose.it-berater.org/smfforum/index.php?topic=1827.0
'------------------------->

Uses "UI", "console"
'---------------------------->
'#INCLUDE "GDIPLUS_LW1b.INC"
'---------------------------->

'--------------------------------------------------------------------------------------------------
%UnitPixel = 2 ' Sets each unit to be one device pixel
'--------------------------------------------------------------------------------------------------

'//--------------------------------------------------------------------------
'// FontStyle: face types and common styles
'//--------------------------------------------------------------------------

' enum FontStyle
%FontStyleRegular = 0
%FontStyleBold = 1
%FontStyleItalic = 2
%FontStyleBoldItalic = 3
%FontStyleUnderline = 4
%FontStyleStrikeout = 8

' enum Unit
%UnitWorld = 0 ' // 0 -- World coordinate (non-physical unit)
%UnitDisplay = 1 ' // 1 -- Variable -- for PageTransform only
%UnitPixel = 2 ' // 2 -- Each unit is one device pixel.
%UnitPoint = 3 ' // 3 -- Each unit is a printer's point, or 1/72 inch.
%UnitInch = 4 ' // 4 -- Each unit is 1 inch.
%UnitDocument = 5 ' // 5 -- Each unit is 1/300 inch.
%UnitMillimeter = 6 ' // 6 -- Each unit is 1 millimeter.

Begin ControlID
%Canvas_Gdip
%bClose
End ControlID

Type RectF
x As Long
y As Long
width As Long
height As Long
End Type

Type GDIP_BGRA_STRUCT Byte
blue As Byte
green As Byte
red As Byte
alpha As Byte
End Type

' // Size = 4 bytes
Union GDIP_BGRA_UNION
Colors As DWord
GDIP_BGRA_STRUCT
End Union

'-------------------------->

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 create_StringFormat",-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, 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_CreateStringFormat()
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_CreateStringFormat()
'------------------------------>

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 pBlackBrush As DWord
Local strFontName As String
Local strText As String
Local rcf As RECTF
Local fontCollection As DWord

hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)

' // Create the font
strFontName = Ucode$("Arial")
'hStatus = GdipCreateFontFamilyFromName(strFontName,0,pFontFamily ) '
hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(strFontName), %NULL, ByVal StrPtr(pFontFamily ) )

If hStatus = %StatusOk And pFontFamily <> %NULL Then
hStatus = GdipCreateFont(pFontFamily, 16, %FontStyleRegular, %UnitPoint, ByVal StrPtr(pFont) )
GdipDeleteFontFamily(pFontFamily)
End If

' Note: You can use the wrapper function GdiPlusCreateFontFromName to create the font:
' hStatus = GdiPlusCreateFontFromName("Arial", 16, %FontStyleRegular, %UnitPoint, pFont)

' // Create a solid brush
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 0, 0), ByVal StrPtr(pBlackBrush) )

' // Draw the string
rcf.x = 30.0 : rcf.y = 30.0 : rcf.Width = 200.0 : rcf.Height = 25.0

'-------------> problemzone ------------------------------------------------->
hStatus = GdipCreateStringFormat(0, %LANG_NEUTRAL, ByVal StrPtr(pFormat ) ) 'StrPtr(pFormat ) no!
'-------------> problemzone ------------------------------------------------->

'hStatus = GdipSetStringFormatAlign(pFormat, %StringAlignmentCenter)
strText = Ucode$("Sample text")
'hStatus = GdipDrawString(pGraphics, StrPtr(strText), Len(strText) \ 2, pFont, rcf, pFormat, pBlackBrush)
hStatus = GdipDrawString(pGraphics, ByVal StrPtr(strText), Len(strText) \ 2, pFont, ByVal StrPtr(rcf), pFormat, pBlackBrush)

' // Create a Pen
hStatus = GdipCreatePen1(GDIP_ARGB(255,0, 0, 0), 3, %UnitPixel, pPen )

' // Draw a rectangle
hStatus = GdipDrawRectangle(pGraphics, pPen, rcf.x, rcf.y, rcf.Width, rcf.Height)

' // Cleanup
If pFont Then GdipDeleteFont(pFont)
If pBlackBrush Then GdipDeleteBrush(pBlackBrush)
If pPen Then GdipDeletePen(pPen)
If pFormat Then GdipDeleteStringFormat(pFormat)
If pGraphics Then GdipDeleteGraphics(pGraphics)

End Sub

'----------------> GDIP INCLUDE HELPERS ------------------------------------------------------>

' enum FillMode
%FillModeAlternate = 0
%FillModeWinding = 1
'---------------------------------->

%LANG_NEUTRAL = &H00??
%LANG_INVARIANT = &H7f??
'---------------------------------->

' enum StringAlignment

' // Left edge for left-to-right text,
' // right for right-to-left text,
' // and top for vertical

%StringAlignmentNear = 0
%StringAlignmentCenter = 1
%StringAlignmentFar = 2

Declare Function GdipSetStringFormatAlign Lib "GDIPLUS.DLL" Alias "GdipSetStringFormatAlign" ( _
ByVal pFormat As DWord, _
ByVal align As Long _
) As Long

Declare Function GdipCreateStringFormat Lib "GDIPLUS.DLL" Alias "GdipCreateStringFormat" ( _
ByVal formatAttributes As Long _ ' __in INT formatAttributes
, ByVal language As Word _ ' __in LANGID language
, ByRef format As DWord _ ' __out GpStringFormat **format '''[out] Pointer to a variable that receives a pointer to the new StringFormat object.
) As Long ' GpStatus

Declare Function GdipCreateFromHDC Lib "GDIPLUS.DLL" Alias "GdipCreateFromHDC" ( _
ByVal hdc As DWord _
, ByRef graphics As DWord _
) As Long

Declare Function GdipCreateFontFamilyFromName Lib "GDIPLUS.DLL" Alias "GdipCreateFontFamilyFromName" ( _
ByRef pName As String _ ' __in GDIPCONST WCHAR *name
, ByVal fontCollection As DWord _ ' __in GpFontCollection *fontCollection
, ByRef fontFamily As DWord _ ' __out GpFontFamily **fontFamily
) As Long ' GpStatus

Declare Function GdipCreateSolidFill Lib "GDIPLUS.DLL" Alias "GdipCreateSolidFill" ( _
ByVal pColor As DWord _ ' __in ARGB color
, ByRef brush As DWord _ ' __out GpSolidFill **brush
) As Long ' GpStatus

Declare Function GdipDeleteFontFamily Lib "GDIPLUS.DLL" Alias "GdipDeleteFontFamily" ( _
ByVal fontFamily As DWord _ ' __in GpFontFamily *fontFamily
) As Long ' GpStatus

Declare Function GdipCreateFont Lib "GDIPLUS.DLL" Alias "GdipCreateFont" ( _
ByVal fontFamily As DWord _ ' __in GDIPCONST GpFontFamily *fontFamily
, ByVal emSize As Single _ ' __in REAL emSize
, ByVal style As Long _ ' __in INT style
, ByVal unit As Long _ ' __in GpUnit unit
, ByRef pFont As DWord _ ' __out GpFont **font
) As Long ' GpStatus

'----------------------------------------------------------->
' -- Definitions from Josés headers
%StatusOk = 0

Type GdiplusStartupInput
GdiplusVersion As DWord
DebugEventCallback As DWord
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
If SizeOf(GdiplusStartupInput) <> 16 Then MsgBox 0, "Invalid size of GdiplusStartupInput"

Type GdiplusStartupOutput
NotificationHook As DWord
NotificationUnhook As DWord
End Type
If SizeOf(GdiplusStartupOutput) <> 8 Then MsgBox 0, "Invalid size of GdiplusStartupOutput"

Type EncoderParameter
pGuid As String * 16 ' // GUID of the parameter
NumberOfValues As DWord ' // Number of the parameter values
dwType As DWord ' // Value type, like ValueTypeLONG etc.
Value As DWord ' // A pointer to the parameter values
End Type
If SizeOf(EncoderParameter) <> 28 Then MsgBox 0, "Invalid size of EncoderParameter"

Type EncoderParameters
Count As DWord ' // Number of parameters in this structure
Parameter As EncoderParameter ' // Parameter values - variable-length array
End Type
If SizeOf(EncoderParameters) <> 32 Then MsgBox 0, "Invalid size of EncoderParameters"

Type ImageCodecInfo
Clsid As String * 16 ' CLSID
FormatID As String * 16 ' GUID
CodecName As Word Ptr ' const WCHAR*
DllName As Word Ptr ' const WCHAR*
FormatDescription As Word Ptr ' const WCHAR*
FilenameExtension As Word Ptr ' const WCHAR*
MimeType As Word Ptr ' const WCHAR*
Flags As DWord ' DWORD
Version As DWord ' DWORD
SigCount As DWord ' DWORD
SigSize As DWord ' DWORD
SigPattern As Byte Ptr ' const BYTE*
SigMask As Byte Ptr ' const BYTE*
End Type
If SizeOf(ImageCodecInfo) <> 76 Then MsgBox 0, "Invalid size of ImageCodecInfo"

Declare Function GdiplusStartup Lib "GDIPLUS.DLL" Alias "GdiplusStartup" (
ByRef token As DWord ' __out token ULONG_PTR
, ByRef input As GdiplusStartupInput ' __in input GdiplusStartupInput <record>
, ByRef output As GdiplusStartupOutput ' __out output GdiplusStartupOutput <record>
) As Long ' GpStatus

Declare Function GdipLoadImageFromFile Lib "GDIPLUS.DLL" Alias "GdipLoadImageFromFile" (
ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef pImage As DWord ' __out GpImage **image
) As Long ' GpStatus

Declare Function lstrlenw Lib "KERNEL32.DLL" Alias "lstrlenW" ( _
ByVal lpString As DWord _ ' __in LPCWSTR lpString
) As Long

Declare Function GdipGetImageEncodersSize Lib "GDIPLUS.DLL" Alias "GdipGetImageEncodersSize" (
ByRef numEncoders As DWord ' __in UINT *numEncoders
, ByRef Size As DWord ' __out UINT *size
) As Long ' Status

Declare Function GdipGetImageEncoders Lib "GDIPLUS.DLL" Alias "GdipGetImageEncoders" (
ByVal numEncoders As DWord ' __in UINT numEncoders
, ByVal Size As DWord ' __in UINT size
, ByRef encoders As Any ' __out ImageCodecInfo *encoders
) As Long ' Status

Declare Function GdipSaveImageToFile Lib "GDIPLUS.DLL" Alias "GdipSaveImageToFile" (
ByVal Image As DWord ' __in GpImage *image
, ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef clsidEncoder As Guid ' __in GDIPCONST CLSID clsidEncoder
, ByRef encoderParams As EncoderParameters ' __out GDIPCONST EncoderParameters *encoderParams
) As Long

Declare Function GdipDisposeImage Lib "GDIPLUS.DLL" Alias "GdipDisposeImage" (
ByVal Image As DWord ' __in GpImage *image
) As Long ' GpStatus

Declare Sub GdiplusShutdown Lib "GDIPLUS.DLL" Alias "GdiplusShutdown" ( _
ByVal token As DWord _ ' __in token ULONG_PTR
)
' void
Function GdiPlusGetEncoderClsid (ByVal strMimeType As String) As String

Local hr As Long
Local pImageCodecInfo As DWord
Local numEncoders As DWord
Local nSize As DWord
Local i As Long
Local wstrlen As Long
Local sMimeType As String

hr = GdipGetImageEncodersSize(numEncoders, nSize)
Dim buffer(nSize) As Byte

pImageCodecInfo = VarPtr(buffer(1))
Local myImageCodecInfo As ImageCodecInfo At pImageCodecInfo

hr = GdipGetImageEncoders(numEncoders, nSize, ByVal pImageCodecInfo)
If hr = 0 Then
For i = 1 To numEncoders
wstrlen = lstrlenW(myImageCodecInfo.MimeType)
If wstrlen Then sMimeType = Acode$(Peek$(myImageCodecInfo.MimeType, wstrlen * 2))
If InStr(Ucase$(sMimeType), Ucase$(strMimeType)) Then
Function = GuidTxt$(myImageCodecInfo.Clsid)
Exit For
End If

pImageCodecInfo += SizeOf(ImageCodecInfo) '// Increments pointer
SetAt(myImageCodecInfo, pImageCodecInfo)
Next
End If

End Function

Function GDIP_ARGB (ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As DWord
Local clr As GDIP_BGRA_UNION
clr.alpha = a
clr.red = r
clr.green = g
clr.blue = b
Function = clr.Colors
End Function

Declare Function GdipDrawString Lib "GDIPLUS.DLL" Alias "GdipDrawString" ( _
ByVal graphics As DWord _ ' __in GpGraphics *graphics
, ByRef Strings As String _ ' __in GDIPCONST WCHAR *string
, ByVal length As Long _ ' __in INT length
, ByVal pFont As DWord _ ' __in GDIPCONST GpFont *font
, ByRef layoutRect As RectF _ ' __in GDIPCONST GpRectF *layoutRect
, ByVal stringFormat As DWord _ ' __in GDIPCONST GpStringFormat *stringFormat
, ByVal brush As DWord _ ' __in GpBrush *brush
) As Long ' GpStatus

Declare Function GdipCreatePen1 Lib "GDIPLUS.DLL" Alias "GdipCreatePen1" ( _
ByVal pColor As DWord, _
ByVal nWidth As Single, _
ByVal unit As Long, _
ByRef pen As DWord _
) As Long

Declare Function GdipDrawRectangle Lib "GDIPLUS.DLL" Alias "GdipDrawRectangle" ( _
ByVal graphics As DWord, _
ByVal pen As DWord, _
ByVal x As Single, _
ByVal y As Single, _
ByVal nWidth As Single, _
ByVal nHeight As Single _
) As Long

Declare Function GdipDeleteBrush Lib "GDIPLUS.DLL" Alias "GdipDeleteBrush" ( _
ByVal brush As DWord _
) As Long

Declare Function GdipDeletePen Lib "GDIPLUS.DLL" Alias "GdipDeletePen" ( _
ByVal pen As DWord _
) As Long

Declare Function GdipDeleteStringFormat Lib "GDIPLUS.DLL" Alias "GdipDeleteStringFormat" ( _
ByVal pFormat As DWord _
) As Long

Declare Function GdipDeleteGraphics Lib "GDIPLUS.DLL" Alias "GdipDeleteGraphics" ( _
ByVal graphics As DWord _
) As Long

'------------------> GdiPlusCreateFontFromName ---------------------------------------------------------------------------------------------------------------------->
'Function GdiPlusCreateFontFromName (ByRef wszFamilyName As String, ByVal emSize As Single, ByVal lStyle As Long, ByVal unit As DWord, ByRef pFont As DWord) As Long

' Local hStatus As Long
' Local pFontFamily As DWord

' hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(wszFamilyName), %NULL, ByVal StrPtr(pFontFamily) )
' If hStatus = %StatusOk And pFontFamily <> %NULL Then
' hStatus = GdipCreateFont(pFontFamily, emSize, lStyle, unit, ByVal StrPtr(pFont))
' GdipDeleteFontFamily(pFontFamily)
' End If
' Function = hStatus
'
'End Function
' ========================================================================================


Declare Function GdipDeleteFontFamily Lib "GDIPLUS.DLL" Alias "GdipDeleteFontFamily" ( _
ByVal fontFamily As DWord _ ' __in GpFontFamily *fontFamily
) As Long ' GpStatus

Declare Function GdipDeleteFont Lib "GDIPLUS.DLL" Alias "GdipDeleteFont" ( _
ByVal Font As DWord _ ' __in GpFont *font
) As Long ' GpStatus




but the string isn't shown. Something I've done wrong?

bye, largo

[José Roca]

Type RectF
x As Long
y As Long
width As Long
height As Long
End Type


must be



Type RectF
x As Single
y As Single
width As Single
height As Single
End Type

[José Roca]

Something I've done wrong?


Yes. You are using StrPtr wrongly in all cases except one.



hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(strFontName), %NULL, ByVal StrPtr(pFontFamily ) )


must be



hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(strFontName), %NULL, pFontFamily )


or



hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(strFontName), %NULL, ByVal VarPtr(pFontFamily ) )


etc.

StrPtr is only for strings. It means string pointer.

[largo_winch]

a) using strptr and varptr in correct order that's the fact, thank you a lot josé! :) now example is running fine. I've changed all wrong strptr into varptr where needed and b) corrected Type RectF udt's into singles (that's what I didn't expected there could be a bigger problem!)


Type RectF
x As Single 'Long
y As Single 'Long
width As Single 'As Long
height As Single 'Long
End Type


here's fine running example for "tb_gdiplus create_StringFormat".


' Empty GUI script created on 11-16-2011 10:04:11 by largo_winch (ThinAIR)
' Empty GUI script created on 11-14-2011 14:33:05 by largo_winch (ThinAIR)
'--------------> GDIPLUS TEST FOR THINBASIC -------------------->

'------------------------->
' Example original from
' http://www.jose.it-berater.org/smfforum/index.php?topic=1827.0
'------------------------->

Uses "UI", "console"
'---------------------------->
'#INCLUDE "GDIPLUS_LW1b.INC"
'---------------------------->
'--------------------------------------------------------------------------------------------------
%UnitPixel = 2 ' Sets each unit to be one device pixel
'--------------------------------------------------------------------------------------------------
'//--------------------------------------------------------------------------
'// FontStyle: face types and common styles
'//--------------------------------------------------------------------------

' enum FontStyle
%FontStyleRegular = 0
%FontStyleBold = 1
%FontStyleItalic = 2
%FontStyleBoldItalic = 3
%FontStyleUnderline = 4
%FontStyleStrikeout = 8

' enum Unit
%UnitWorld = 0 ' // 0 -- World coordinate (non-physical unit)
%UnitDisplay = 1 ' // 1 -- Variable -- for PageTransform only
%UnitPixel = 2 ' // 2 -- Each unit is one device pixel.
%UnitPoint = 3 ' // 3 -- Each unit is a printer's point, or 1/72 inch.
%UnitInch = 4 ' // 4 -- Each unit is 1 inch.
%UnitDocument = 5 ' // 5 -- Each unit is 1/300 inch.
%UnitMillimeter = 6 ' // 6 -- Each unit is 1 millimeter.

Begin ControlID
%Canvas_Gdip
%bClose
End ControlID

'----------------------> problemzone solved by jose roca :)
Type RectF
x As Single 'Long
y As Single 'Long
width As Single 'As Long
height As Single 'Long
End Type
'----------------------> problemzone solved by jose roca :)

Type GDIP_BGRA_STRUCT Byte
blue As Byte
green As Byte
red As Byte
alpha As Byte
End Type

' // Size = 4 bytes
Union GDIP_BGRA_UNION
Colors As DWord
GDIP_BGRA_STRUCT
End Union

'-------------> 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 create_StringFormat",-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, 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_CreateStringFormat()
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

'------------------------------> with perfect solution :)
Sub GDIP_CreateStringFormat()
'------------------------------> with perfect solution :)

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 pBlackBrush As DWord
Local strFontName As String
Local strText As String
Local rcf As RECTF
Local fontCollection As DWord

hStatus = GdipCreateFromHDC(Canvas_GetDC, pGraphics)

' // Create the font
strFontName = Ucode$("Arial")

'hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(strFontName), %NULL, pFontFamily )
hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(strFontName), %NULL, ByVal VarPtr(pFontFamily) ) '(

If hStatus = %StatusOk And pFontFamily <> %NULL Then '
hStatus = GdipCreateFont(pFontFamily, 16, %FontStyleRegular, %UnitPoint, ByVal VarPtr(pFont ) )
GdipDeleteFontFamily(pFontFamily)
End If

' Note: You can use the wrapper function GdiPlusCreateFontFromName to create the font:
' hStatus = GdiPlusCreateFontFromName("Arial", 16, %FontStyleRegular, %UnitPoint, pFont)

' // Create a solid brush
hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 0, 0), ByVal VarPtr(pBlackBrush ) )

' // Draw the string
rcf.x = 30.0 : rcf.y = 30.0 : rcf.Width = 200.0 : rcf.Height = 25.0

'-------------> problemzone solved ------------------------------------------------->
hStatus = GdipCreateStringFormat(0, %LANG_NEUTRAL, ByVal VarPtr(pFormat) )
'-------------> problemzone solved ------------------------------------------------->

'hStatus = GdipSetStringFormatAlign(pFormat, %StringAlignmentCenter)
strText = Ucode$("Sample text")
hStatus = GdipDrawString(pGraphics, ByVal StrPtr(strText), Len(strText) \ 2, pFont, ByVal VarPtr(rcf), pFormat, pBlackBrush)

' // Create a Pen
hStatus = GdipCreatePen1(GDIP_ARGB(255,0, 0, 0), 3, %UnitPixel, ByVal VarPtr(pPen) )

' // Draw a rectangle
hStatus = GdipDrawRectangle(pGraphics, pPen, rcf.x, rcf.y, rcf.Width, rcf.Height)

' // Cleanup
If pFont Then GdipDeleteFont(pFont)
If pBlackBrush Then GdipDeleteBrush(pBlackBrush)
If pPen Then GdipDeletePen(pPen)
If pFormat Then GdipDeleteStringFormat(pFormat)
If pGraphics Then GdipDeleteGraphics(pGraphics)

End Sub
'-------------> END OF EXAMPLE ----------------------->
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'----------------> GDIP INCLUDE HELPERS ------------------------------------------------------>

' enum FillMode
%FillModeAlternate = 0
%FillModeWinding = 1
'---------------------------------->

%LANG_NEUTRAL = &H00??
%LANG_INVARIANT = &H7f??
'---------------------------------->

' enum StringAlignment

' // Left edge for left-to-right text,
' // right for right-to-left text,
' // and top for vertical

%StringAlignmentNear = 0
%StringAlignmentCenter = 1
%StringAlignmentFar = 2

Declare Function GdipSetStringFormatAlign Lib "GDIPLUS.DLL" Alias "GdipSetStringFormatAlign" ( _
ByVal pFormat As DWord, _
ByVal align As Long _
) As Long

Declare Function GdipCreateStringFormat Lib "GDIPLUS.DLL" Alias "GdipCreateStringFormat" ( _
ByVal formatAttributes As Long _ ' __in INT formatAttributes
, ByVal language As Word _ ' __in LANGID language
, ByRef format As DWord _ ' __out GpStringFormat **format '''[out] Pointer to a variable that receives a pointer to the new StringFormat object.
) As Long ' GpStatus

Declare Function GdipCreateFromHDC Lib "GDIPLUS.DLL" Alias "GdipCreateFromHDC" ( _
ByVal hdc As DWord _
, ByRef graphics As DWord _
) As Long

Declare Function GdipCreateFontFamilyFromName Lib "GDIPLUS.DLL" Alias "GdipCreateFontFamilyFromName" ( _
ByRef pName As String _ ' __in GDIPCONST WCHAR *name
, ByVal fontCollection As DWord _ ' __in GpFontCollection *fontCollection
, ByRef fontFamily As DWord _ ' __out GpFontFamily **fontFamily
) As Long ' GpStatus

Declare Function GdipCreateSolidFill Lib "GDIPLUS.DLL" Alias "GdipCreateSolidFill" ( _
ByVal pColor As DWord _ ' __in ARGB color
, ByRef brush As DWord _ ' __out GpSolidFill **brush
) As Long ' GpStatus

Declare Function GdipDeleteFontFamily Lib "GDIPLUS.DLL" Alias "GdipDeleteFontFamily" ( _
ByVal fontFamily As DWord _ ' __in GpFontFamily *fontFamily
) As Long ' GpStatus

Declare Function GdipCreateFont Lib "GDIPLUS.DLL" Alias "GdipCreateFont" ( _
ByVal fontFamily As DWord _ ' __in GDIPCONST GpFontFamily *fontFamily
, ByVal emSize As Single _ ' __in REAL emSize
, ByVal style As Long _ ' __in INT style
, ByVal unit As Long _ ' __in GpUnit unit
, ByRef pFont As DWord _ ' __out GpFont **font
) As Long ' GpStatus

'----------------------------------------------------------->
' -- Definitions from Josés headers
%StatusOk = 0

Type GdiplusStartupInput
GdiplusVersion As DWord
DebugEventCallback As DWord
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
If SizeOf(GdiplusStartupInput) <> 16 Then MsgBox 0, "Invalid size of GdiplusStartupInput"

Type GdiplusStartupOutput
NotificationHook As DWord
NotificationUnhook As DWord
End Type
If SizeOf(GdiplusStartupOutput) <> 8 Then MsgBox 0, "Invalid size of GdiplusStartupOutput"

Type EncoderParameter
pGuid As String * 16 ' // GUID of the parameter
NumberOfValues As DWord ' // Number of the parameter values
dwType As DWord ' // Value type, like ValueTypeLONG etc.
Value As DWord ' // A pointer to the parameter values
End Type
If SizeOf(EncoderParameter) <> 28 Then MsgBox 0, "Invalid size of EncoderParameter"

Type EncoderParameters
Count As DWord ' // Number of parameters in this structure
Parameter As EncoderParameter ' // Parameter values - variable-length array
End Type
If SizeOf(EncoderParameters) <> 32 Then MsgBox 0, "Invalid size of EncoderParameters"

Type ImageCodecInfo
Clsid As String * 16 ' CLSID
FormatID As String * 16 ' GUID
CodecName As Word Ptr ' const WCHAR*
DllName As Word Ptr ' const WCHAR*
FormatDescription As Word Ptr ' const WCHAR*
FilenameExtension As Word Ptr ' const WCHAR*
MimeType As Word Ptr ' const WCHAR*
Flags As DWord ' DWORD
Version As DWord ' DWORD
SigCount As DWord ' DWORD
SigSize As DWord ' DWORD
SigPattern As Byte Ptr ' const BYTE*
SigMask As Byte Ptr ' const BYTE*
End Type
If SizeOf(ImageCodecInfo) <> 76 Then MsgBox 0, "Invalid size of ImageCodecInfo"

Declare Function GdiplusStartup Lib "GDIPLUS.DLL" Alias "GdiplusStartup" (
ByRef token As DWord ' __out token ULONG_PTR
, ByRef input As GdiplusStartupInput ' __in input GdiplusStartupInput <record>
, ByRef output As GdiplusStartupOutput ' __out output GdiplusStartupOutput <record>
) As Long ' GpStatus

Declare Function GdipLoadImageFromFile Lib "GDIPLUS.DLL" Alias "GdipLoadImageFromFile" (
ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef pImage As DWord ' __out GpImage **image
) As Long ' GpStatus

Declare Function lstrlenw Lib "KERNEL32.DLL" Alias "lstrlenW" ( _
ByVal lpString As DWord _ ' __in LPCWSTR lpString
) As Long

Declare Function GdipGetImageEncodersSize Lib "GDIPLUS.DLL" Alias "GdipGetImageEncodersSize" (
ByRef numEncoders As DWord ' __in UINT *numEncoders
, ByRef Size As DWord ' __out UINT *size
) As Long ' Status

Declare Function GdipGetImageEncoders Lib "GDIPLUS.DLL" Alias "GdipGetImageEncoders" (
ByVal numEncoders As DWord ' __in UINT numEncoders
, ByVal Size As DWord ' __in UINT size
, ByRef encoders As Any ' __out ImageCodecInfo *encoders
) As Long ' Status

Declare Function GdipSaveImageToFile Lib "GDIPLUS.DLL" Alias "GdipSaveImageToFile" (
ByVal Image As DWord ' __in GpImage *image
, ByVal filename As DWord ' __in GDIPCONST WCHAR *filename
, ByRef clsidEncoder As Guid ' __in GDIPCONST CLSID clsidEncoder
, ByRef encoderParams As EncoderParameters ' __out GDIPCONST EncoderParameters *encoderParams
) As Long

Declare Function GdipDisposeImage Lib "GDIPLUS.DLL" Alias "GdipDisposeImage" (
ByVal Image As DWord ' __in GpImage *image
) As Long ' GpStatus

Declare Sub GdiplusShutdown Lib "GDIPLUS.DLL" Alias "GdiplusShutdown" ( _
ByVal token As DWord _ ' __in token ULONG_PTR
)
' void
Function GdiPlusGetEncoderClsid (ByVal strMimeType As String) As String

Local hr As Long
Local pImageCodecInfo As DWord
Local numEncoders As DWord
Local nSize As DWord
Local i As Long
Local wstrlen As Long
Local sMimeType As String

hr = GdipGetImageEncodersSize(numEncoders, nSize)
Dim buffer(nSize) As Byte

pImageCodecInfo = VarPtr(buffer(1))
Local myImageCodecInfo As ImageCodecInfo At pImageCodecInfo

hr = GdipGetImageEncoders(numEncoders, nSize, ByVal pImageCodecInfo)
If hr = 0 Then
For i = 1 To numEncoders
wstrlen = lstrlenW(myImageCodecInfo.MimeType)
If wstrlen Then sMimeType = Acode$(Peek$(myImageCodecInfo.MimeType, wstrlen * 2))
If InStr(Ucase$(sMimeType), Ucase$(strMimeType)) Then
Function = GuidTxt$(myImageCodecInfo.Clsid)
Exit For
End If

pImageCodecInfo += SizeOf(ImageCodecInfo) '// Increments pointer
SetAt(myImageCodecInfo, pImageCodecInfo)
Next
End If

End Function

Function GDIP_ARGB (ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As DWord
Local clr As GDIP_BGRA_UNION
clr.alpha = a
clr.red = r
clr.green = g
clr.blue = b
Function = clr.Colors
End Function

Declare Function GdipDrawString Lib "GDIPLUS.DLL" Alias "GdipDrawString" ( _
ByVal graphics As DWord _ ' __in GpGraphics *graphics
, ByRef Strings As String _ ' __in GDIPCONST WCHAR *string
, ByVal length As Long _ ' __in INT length
, ByVal pFont As DWord _ ' __in GDIPCONST GpFont *font
, ByRef layoutRect As RectF _ ' __in GDIPCONST GpRectF *layoutRect
, ByVal stringFormat As DWord _ ' __in GDIPCONST GpStringFormat *stringFormat
, ByVal brush As DWord _ ' __in GpBrush *brush
) As Long ' GpStatus

Declare Function GdipCreatePen1 Lib "GDIPLUS.DLL" Alias "GdipCreatePen1" ( _
ByVal pColor As DWord, _
ByVal nWidth As Single, _
ByVal unit As Long, _
ByRef pen As DWord _
) As Long

Declare Function GdipDrawRectangle Lib "GDIPLUS.DLL" Alias "GdipDrawRectangle" ( _
ByVal graphics As DWord, _
ByVal pen As DWord, _
ByVal x As Single, _
ByVal y As Single, _
ByVal nWidth As Single, _
ByVal nHeight As Single _
) As Long

Declare Function GdipDeleteBrush Lib "GDIPLUS.DLL" Alias "GdipDeleteBrush" ( _
ByVal brush As DWord _
) As Long

Declare Function GdipDeletePen Lib "GDIPLUS.DLL" Alias "GdipDeletePen" ( _
ByVal pen As DWord _
) As Long

Declare Function GdipDeleteStringFormat Lib "GDIPLUS.DLL" Alias "GdipDeleteStringFormat" ( _
ByVal pFormat As DWord _
) As Long

Declare Function GdipDeleteGraphics Lib "GDIPLUS.DLL" Alias "GdipDeleteGraphics" ( _
ByVal graphics As DWord _
) As Long

Declare Function GdipDeleteFontFamily Lib "GDIPLUS.DLL" Alias "GdipDeleteFontFamily" ( _
ByVal fontFamily As DWord _ ' __in GpFontFamily *fontFamily
) As Long ' GpStatus

Declare Function GdipDeleteFont Lib "GDIPLUS.DLL" Alias "GdipDeleteFont" ( _
ByVal Font As DWord _ ' __in GpFont *font
) As Long ' GpStatus

'------------------> GdiPlusCreateFontFromName ---------------------------------------------------------------------------------------------------------------------->
'Function GdiPlusCreateFontFromName (ByRef wszFamilyName As String, ByVal emSize As Single, ByVal lStyle As Long, ByVal unit As DWord, ByRef pFont As DWord) As Long

' Local hStatus As Long
' Local pFontFamily As DWord

' hStatus = GdipCreateFontFamilyFromName(ByVal StrPtr(wszFamilyName), %NULL, ByVal StrPtr(pFontFamily) )
' If hStatus = %StatusOk And pFontFamily <> %NULL Then
' hStatus = GdipCreateFont(pFontFamily, emSize, lStyle, unit, ByVal StrPtr(pFont))
' GdipDeleteFontFamily(pFontFamily)
' End If
' Function = hStatus
'
'End Function
' ========================================================================================



c) thanks petr for his help and patience too :) to work at night it's not even good for me because of losing concentration after hard working day at my job!

bye, largo

[ErosOlmi]

StrPtr is only for strings. It means string pointer.


Interesting (and embarrassing). I will add more error checking in StrPtr and VarPtr functions.

[José Roca]

And more specifically, for dynamic strings. The reason is that, with these kind of variables, VarPtr returns the address of the string descriptor and StrPtr the address of the string data. For all other kind of variables, including null-terminated strings and fixed-length strings, VarPtr must be used.