Image Painting Demos [Windows only]

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Image Painting Demos [Windows only]

Post by UEZ »

Here some codes to paint an image in different ways. Press rmb to save image!

1) GDI+ Image Painting1.bas

Code: Select all

'Coded by UEZ build 2019-02-08
'Windows only!
'Original idea (Crazy Painter) by Daniel Wyllie

#Include "fbgfx.bi" 
#Include "windows.bi"
#Include "vbcompat.bi"
#include "win\wininet.bi"

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include "win/gdiplus-c.bi"
#Else
    #Include "win/gdiplus.bi"
    Using gdiplus
#Endif

Using FB 

Declare Function Brightness(iColor As Ulong) As Single
Declare Function RandomRange(fStart as Single, fEnd as Single) as Single
Declare Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
Declare Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
Declare Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr

#Define _Max(a, b) (Iif(a > b, b, a))

If Messagebox(0, "Do you agree to download an image from internet?", "Information", MB_ICONQUESTION or MB_YESNO) = 7 Then
	Messagebox(0, "This demo requires an image. Please enable code line to load from local disk and disable code for download! Do not forget to adjust the path to the image!", "Information", MB_ICONWARNING)
	End
End If

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End

Dim As Single iW, iH, iPixel, iRowOffset
Dim As Any Ptr hImage


'load image from internet
Dim As Integer iSize
Dim As Byte Ptr binImg = LoadDataFromINet("https://www.noz.de/article/teaser/1395114/full", iSize)
hImage = _GDIPlus_BitmapCreateFromMemory3(binImg, iSize)
Deallocate binImg


'for local files
'GdipLoadImageFromFile("Test.jpg", @hImage)

GdipGetImageDimension(hImage, @iW, @iH)

If iW = 0 Then 
	GdiplusShutdown(gdipToken)
	Messagebox(0, "Something went wrong to download the image!", "ERROR", 16)
	End
End If


'read all colors to an array for faster access
Dim As ULong aColors(0 To iH - 1, 0 To iW - 1), iX, iY, iARGB
For iY = 0 To iH - 1
	For iX = 0 To iW - 1 
		GdipBitmapGetPixel(hImage, iX, iY, @iARGB)
		aColors(iY, iX) = iARGB
	Next
Next
   


Dim As String sTitle = "GDIPlus Image Painting 1 Demo / FPS: "
Dim As UShort iFPS = 0

Dim As Double fTimer 
Dim evt As Event 

Screencontrol SET_DRIVER_NAME, "GDI"
Screenres iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH 
Windowtitle sTitle 

Dim As HWND hHWND
Screencontrol(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As Any Ptr 	hDC = GetDC(hHWND), _
				hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
				hDC_backbuffer = CreateCompatibleDC(hDC), _
				hDC_obj = SelectObject(hDC_backbuffer, hHBitmap), _
				hCanvas, hPen, hBrush, hBitmap


GdipCreateFromHDC(hDC_backbuffer, @hCanvas)
GdipSetSmoothingMode(hCanvas, SmoothingModeAntiAlias)
GdipSetPixelOffsetMode(hCanvas, PixelOffsetModeHalf)
GdipCreateSolidFill(&hFFFF0000, @hBrush)
GdipCreatePen1(&hFF00FF00, 1, 2, @hPen)

Randomize(, 2)

Type tPoint
	As Single x, y
End Type

Dim As tPoint aPoints(4)
For i As Ubyte = 0 To 3
	aPoints(i).x = Rnd() * iW / 4
	aPoints(i).y = Rnd() * iH / 4
Next


Dim As Ulong ca, cb, cc, cd, iAmount = _Max(iW, iH) / 12
Dim As Single ba, bb, bc, bd, f, g = iAmount / 4, fSize
Dim As Integer mx, my, mb

fTimer = Timer 

Do 
	Getmouse mx, my, , mb
	mx += 1
	my += 1
	For k As UShort = 1 To iAmount
		For i As Ubyte = 0 To 3
			If aPoints(i).x < 0 Then aPoints(i).x = 0
			If aPoints(i).y < 0 Then aPoints(i).y = 0
			If aPoints(i).x > iW - 1 Then aPoints(i).x = iW - 1
			If aPoints(i).y > iH - 1 Then aPoints(i).y = iH - 1
		Next
		ca = aColors(aPoints(0).y, aPoints(0).x)
		cb = aColors(aPoints(1).y, aPoints(1).x)
		cc = aColors(aPoints(2).y, aPoints(2).x)
		cd = aColors(aPoints(3).y, aPoints(3).x)
		ba = Brightness(ca): bb = Brightness(cb): bc = Brightness(cc): bd = Brightness(cd)
		If ba - bb < 50 And bb - bc < 50 And bc - bd < 50 Then			
			GdipCreateHatchBrush(12, &hE0FFFFFF And cc, &hA0FFFFFF And cb, @hBrush)
			GdipSetPenBrushFill(hPen, hBrush)
			
			GdipSetPenWidth(hPen, my / 50)
			'GdipSetPenColor(hPen, &hE0FFFFFF And cc)
			GdipDrawBezier(hCanvas, hPen, aPoints(0).x, aPoints(0).y, aPoints(1).x, aPoints(1).y, aPoints(2).x, aPoints(2).y, aPoints(3).x, aPoints(3).y)
							
			fSize = ba / g
			f = fSize / 2
			GdipFillEllipse(hCanvas, hBrush, aPoints(0).x - f, aPoints(0).y - f, fSize, fSize)
			GdipDeleteBrush(hBrush)	
			
			'GdipSetSolidFillColor(hBrush, &hE0FFFFFF And cc)
			'GdipFillEllipse(hCanvas, hBrush, aPoints(0).x - ba / 40, aPoints(0).y - ba / 40, ba / 20, ba / 20)
				
			GdipSetPenColor(hPen, &hE0FFFFFF And cb)	
			GdipSetPenWidth(hPen, 2)
			GdipDrawEllipse(hCanvas, hPen, aPoints(0).x - f, aPoints(0).y - f, fSize, fSize)
		End If
		aPoints(0).x = Rnd() * iW
		aPoints(0).y = Rnd() * iH
		f = mx / 10
		aPoints(1).x = aPoints(0).x + RandomRange(-f, f)
		aPoints(1).y = aPoints(0).y + RandomRange(-f, f)
		aPoints(2).x = aPoints(1).x + RandomRange(-f, f)
		aPoints(2).y = aPoints(1).y + RandomRange(-f, f)
		aPoints(3).x = aPoints(2).x + RandomRange(-f, f)
		aPoints(3).y = aPoints(2).y + RandomRange(-f, f)
	Next

	BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)
		
	If(Timer - fTimer > 0.99) Then 
		Windowtitle (sTitle & iFPS) 
		iFPS = 0 
		fTimer = Timer 
	Else 
		iFPS += 1 
	Endif 
	

	If (Screenevent(@evt)) Then 
		Select Case evt.Type 
			Case SC_ESCAPE, EVENT_WINDOW_CLOSE
				'GDI
				SelectObject(hDC_backbuffer, hDC_obj)
				DeleteDC(hDC_backbuffer)
				DeleteObject(hHBitmap)
				ReleaseDC(hHWND, hDC)
				
				'GDIPlus
				GdipDeletePen(hPen)
				GdipDeleteBrush(hBrush)		
				GdipDeleteGraphics(hCanvas)
				GdiplusShutdown(gdipToken)
				Exit Do 
			Case EVENT_MOUSE_BUTTON_RELEASE
				If evt.button = BUTTON_RIGHT Then
					GdipCreateBitmapFromHBITMAP(hHBitmap, 0, @hBitmap)
					_GDIPlus_ImageSaveToFile(hBitmap, Curdir & "\Painting1_" & Format(Now(), "yyyymmdd_hhmmss") & ".jpg")
					GdipDisposeImage(hBitmap)
				End If
			End Select 
	Endif 
	Sleep(10, 1) 
Loop

Function Brightness(iColor As Ulong) As Single
	Dim As Ubyte r = (iColor Shr 16) And &hFF, g = (iColor Shr 8) And &hFF, b = iColor And &hFF
	Return Sqr(0.241 * r * r + 0.691 * g * g + 0.068 * b * b)
End Function

Function RandomRange(fStart as Single, fEnd as Single) as Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
	'check If hImage Is a GDI+ image
	Dim As Single iW, iH
	If  GdipGetImageDimension(hImage, @iW, @iH) <> 0 Then Return 0
	
	Dim As Byte iErr = 0

	Dim As Ulong count, size
	GdipGetImageEncodersSize(@count, @size)
   
	Dim As CLSID clsid
	Dim As ImageCodecInfo Ptr pImageCodecInfo
	pImageCodecInfo = Allocate(size)
	GdipGetImageEncoders(count, size, pImageCodecInfo)

	#Define _MimeType(x)	(*Cast(Wstring Ptr, pImageCodecInfo[x].MimeType))
	#Define FnSuffix	(Right(Filename, 4))	
	
	For i As Ulong = 0 To count - 1
		If _MimeType(i) = "image/bmp" And FnSuffix = ".bmp" Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/jpeg" And (FnSuffix = ".jpg" Or FnSuffix = ".jpe" Or Right(Filename, 5) = ".jpeg" Or Right(Filename, 5) = ".jfif") Then
			JPGQual = Iif(JPGQual < 0, 0, Iif(JPGQual > 100, 100, JPGQual))
			Dim tParams As EncoderParameters
			Dim EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
			tParams.Count = 1
			CLSIDFromString(Wstr(EncoderQuality), @tParams.Parameter(0).GUID)
			With tParams.Parameter(0)
				.NumberOfValues = 1
				.Type = EncoderParameterValueTypeLong
				.Value = Varptr(JPGQual)
			End With
			If GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, @tParams) <> 0 Then iErr += 1          
		Elseif _MimeType(i) = "image/gif" And FnSuffix = ".gif" Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/tiff" And (FnSuffix = ".tif" Or Right(Filename, 5) = ".tiff") Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/png" And FnSuffix = ".png" Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1     
		Else
			iErr += 1
		End If
	Next

	Deallocate(pImageCodecInfo)

	If iErr > 0 Then Return False

	Return True
End Function

Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
	Dim As HGLOBAL hGlobal
	Dim As LPSTREAM hStream
	Dim As Any Ptr hImage_Stream
	Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
	Dim As Any Ptr lpMemory = GlobalLock(hMemory)
	RtlCopyMemory(lpMemory, @aBinImage[0], iLen)
	GlobalUnlock(hMemory)
	CreateStreamOnHGlobal(hMemory, 0, @hStream)
	GdipCreateBitmapFromStream(hStream, @hImage_Stream)
	IUnknown_Release(hStream)

	If bBitmap_GDI = TRUE Then
		Dim hImage_GDI As Any Ptr
		GdipCreateHBITMAPFromBitmap(hImage_Stream, @hImage_GDI, &hFF000000)
		GdipDisposeImage(hImage_Stream)
		Return hImage_GDI
	Endif

	Return hImage_Stream
End Function

Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr
	Dim As HINTERNET hOpen = InternetOpen("IE", INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0), _
					 hFile = InternetOpenUrl(hOpen, sURL, NULL, 0, INTERNET_FLAG_RELOAD, 0)
					 
	Dim As Ulong iBuffLen = 32, iBytes = 1
	Dim As String sBuff = Space(32)
	HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, StrPtr(sBuff), @iBuffLen, NULL)
	iBuffLen = Valint(Trim(sBuff))
	Dim As Byte Ptr imgBuffer
	If iBuffLen > 0 Then
		imgBuffer = Allocate(iBuffLen)
		Do Until iBytes = 0
			InternetReadFile(hFile, imgBuffer, iBuffLen, @iBytes)
		Loop
	Endif
	InternetCloseHandle(hFile)
	InternetCloseHandle(hOpen)
	iSize = iBuffLen
	Return imgBuffer
End Function
Image will be downloaded and displayed without saving first to HDD directly to the screen. Press rmb to save current displayed image. Move mouse around to change painting style.


2) GDI+ Image Painting2.bas

Code: Select all

'Coded by UEZ build 2019-02-08
'Windows only!
'Original idea by Vamoss

#Include "fbgfx.bi" 
#Include "windows.bi"
#Include "vbcompat.bi"
#include "win\wininet.bi"

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include "win/gdiplus-c.bi"
#Else
    #Include "win/gdiplus.bi"
    Using gdiplus
#Endif

Using FB 

Declare Function Brightness(iColor As Ulong) As Single
Declare Function RandomRange(fStart as Single, fEnd as Single) as Single
Declare Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
Declare Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
Declare Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr

If Messagebox(0, "Do you agree to download an image from internet?", "Information", MB_ICONQUESTION or MB_YESNO) = 7 Then
	Messagebox(0, "This demo requires an image. Please enable code line to load from local disk and disable code for download! Do not forget to adjust the path to the image!", "Information", MB_ICONWARNING)
	End
End If

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End

Dim As Single iW, iH, iPixel, iRowOffset
Dim As Any Ptr hImage


'load image from internet
Dim As Integer iSize
Dim As Byte Ptr binImg = LoadDataFromINet("https://www.3darchitettura.com/wp-content/uploads/2018/11/maxresdefault-1.jpg", iSize)
hImage = _GDIPlus_BitmapCreateFromMemory3(binImg, iSize)
Deallocate binImg

'for local files
'GdipLoadImageFromFile("Test.png", @hImage)

GdipGetImageDimension(hImage, @iW, @iH)

If iW = 0 Then 
	GdiplusShutdown(gdipToken)
	Messagebox(0, "Something went wrong to download the image!", "ERROR", 16)
	End
End If


'read all colors to an array for faster access
Dim As ULong aColors(0 To iH - 1, 0 To iW - 1), iX, iY, iARGB
For iY = 0 To iH - 1
	For iX = 0 To iW - 1 
		GdipBitmapGetPixel(hImage, iX, iY, @iARGB)
		aColors(iY, iX) = iARGB
	Next
Next
   

Dim As String sTitle = "GDIPlus Image Painting 2 Demo / FPS: "
Dim As UShort iFPS = 0

Dim As Double fTimer 
Dim evt As Event 

Screencontrol SET_DRIVER_NAME, "GDI"
Screenres iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH 
Windowtitle sTitle 

Dim As HWND hHWND
Screencontrol(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As Any Ptr 	hDC = GetDC(hHWND), _
				hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
				hDC_backbuffer = CreateCompatibleDC(hDC), _
				hDC_obj = SelectObject(hDC_backbuffer, hHBitmap), _
				hCanvas, hPen, hBrush, hBitmap


GdipCreateFromHDC(hDC_backbuffer, @hCanvas)
GdipSetSmoothingMode(hCanvas, SmoothingModeAntiAlias)
GdipSetPixelOffsetMode(hCanvas, PixelOffsetModeHalf)
GdipCreateSolidFill(&hFFFF0000, @hBrush)
GdipCreatePen1(&hFF00FF00, 1, 2, @hPen)
GdipGraphicsClear(hCanvas, &hFF404040)

Randomize(, 2)

Type tPoint
	As Single prevPosX, prevPosY, posX, posY, radius, angle
	As Byte dir
End Type

Dim As Ushort iTotal = 200
Dim As tPoint aPoints(iTotal)
For i As Ushort = 0 To iTotal - 1
	aPoints(i).prevPosX = iW / 2
	aPoints(i).prevPosY = iH / 2
	aPoints(i).posX = iW / 2
	aPoints(i).posY = iH / 2
	aPoints(i).radius = RandomRange(3, 10)
	aPoints(i).angle = 0
	aPoints(i).dir = Iif(Rnd() > 0.5, 1, -1)
Next

Dim As Single fPI = Acos(-1), x, y, b

fTimer = Timer 

Do 
	For i As Ushort = 0 To iTotal - 1
		aPoints(i).angle += 1 / aPoints(i).radius * aPoints(i).dir
		aPoints(i).posX += Cos(aPoints(i).angle) * aPoints(i).radius
		aPoints(i).posY += Sin(aPoints(i).angle) * aPoints(i).radius
		x = aPoints(i).posX
		y = aPoints(i).posY
		x = Iif(x < 0, 0, Iif(x > iW - 1, iW - 1, x))
		y = Iif(y < 0, 0, Iif(y > iH - 1, iH - 1, y))
		b = Brightness(aColors(y, x))
		If b > 70 Or _
			aPoints(i).posX < 0 Or aPoints(i).posX > iW - 1 Or _
			aPoints(i).posY < 0 Or aPoints(i).posY > iH - 1 Then
				aPoints(i).dir *= -1
				aPoints(i).radius = RandomRange(3, 10)
				aPoints(i).angle += fPI
		End If
		GdipSetPenWidth(hPen, b / 20)
		GdipSetPenColor(hPen, &hA0FFFFFF And aColors(y, x))
		GdipDrawLine(hCanvas, hPen, aPoints(i).prevPosX, aPoints(i).prevPosY, aPoints(i).posX, aPoints(i).posY)
		aPoints(i).prevPosX = aPoints(i).posX
		aPoints(i).prevPosY = aPoints(i).posY
	Next
	BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)
		
	If(Timer - fTimer > 0.99) Then 
		Windowtitle (sTitle & iFPS) 
		iFPS = 0 
		fTimer = Timer 
	Else 
		iFPS += 1 
	Endif 
	

	If (Screenevent(@evt)) Then 
		Select Case evt.Type 
			Case SC_ESCAPE, EVENT_WINDOW_CLOSE
				'GDI
				SelectObject(hDC_backbuffer, hDC_obj)
				DeleteDC(hDC_backbuffer)
				DeleteObject(hHBitmap)
				ReleaseDC(hHWND, hDC)
				
				'GDIPlus
				GdipDeletePen(hPen)
				GdipDeleteBrush(hBrush)		
				GdipDeleteGraphics(hCanvas)
				GdiplusShutdown(gdipToken)
				Exit Do 
			Case EVENT_MOUSE_BUTTON_RELEASE
				If evt.button = BUTTON_RIGHT Then
					GdipCreateBitmapFromHBITMAP(hHBitmap, 0, @hBitmap)
					_GDIPlus_ImageSaveToFile(hBitmap, Curdir & "\Painting2_" & Format(Now(), "yyyymmdd_hhmmss") & ".jpg")
					GdipDisposeImage(hBitmap)
				Elseif evt.button = BUTTON_MIDDLE Then
					GdipGraphicsClear(hCanvas, &hFF404040)
				End If
			End Select 
	Endif 
	Sleep(10, 1) 
Loop

Function Brightness(iColor As Ulong) As Single
	Dim As Ubyte r = (iColor Shr 16) And &hFF, g = (iColor Shr 8) And &hFF, b = iColor And &hFF
	Return Sqr(0.241 * r * r + 0.691 * g * g + 0.068 * b * b)
End Function

Function RandomRange(fStart as Single, fEnd as Single) as Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
	'check If hImage Is a GDI+ image
	Dim As Single iW, iH
	If  GdipGetImageDimension(hImage, @iW, @iH) <> 0 Then Return 0
	
	Dim As Byte iErr = 0

	Dim As Ulong count, size
	GdipGetImageEncodersSize(@count, @size)
   
	Dim As CLSID clsid
	Dim As ImageCodecInfo Ptr pImageCodecInfo
	pImageCodecInfo = Allocate(size)
	GdipGetImageEncoders(count, size, pImageCodecInfo)

	#Define _MimeType(x)	(*Cast(Wstring Ptr, pImageCodecInfo[x].MimeType))
	#Define FnSuffix	(Right(Filename, 4))	
	
	For i As Ulong = 0 To count - 1
		If _MimeType(i) = "image/bmp" And FnSuffix = ".bmp" Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/jpeg" And (FnSuffix = ".jpg" Or FnSuffix = ".jpe" Or Right(Filename, 5) = ".jpeg" Or Right(Filename, 5) = ".jfif") Then
			JPGQual = Iif(JPGQual < 0, 0, Iif(JPGQual > 100, 100, JPGQual))
			Dim tParams As EncoderParameters
			Dim EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
			tParams.Count = 1
			CLSIDFromString(Wstr(EncoderQuality), @tParams.Parameter(0).GUID)
			With tParams.Parameter(0)
				.NumberOfValues = 1
				.Type = EncoderParameterValueTypeLong
				.Value = Varptr(JPGQual)
			End With
			If GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, @tParams) <> 0 Then iErr += 1          
		Elseif _MimeType(i) = "image/gif" And FnSuffix = ".gif" Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/tiff" And (FnSuffix = ".tif" Or Right(Filename, 5) = ".tiff") Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/png" And FnSuffix = ".png" Then
			If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1     
		Else
			iErr += 1
		End If
	Next

	Deallocate(pImageCodecInfo)

	If iErr > 0 Then Return False

	Return True
End Function

Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
	Dim As HGLOBAL hGlobal
	Dim As LPSTREAM hStream
	Dim As Any Ptr hImage_Stream
	Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
	Dim As Any Ptr lpMemory = GlobalLock(hMemory)
	RtlCopyMemory(lpMemory, @aBinImage[0], iLen)
	GlobalUnlock(hMemory)
	CreateStreamOnHGlobal(hMemory, 0, @hStream)
	GdipCreateBitmapFromStream(hStream, @hImage_Stream)
	IUnknown_Release(hStream)

	If bBitmap_GDI = TRUE Then
		Dim hImage_GDI As Any Ptr
		GdipCreateHBITMAPFromBitmap(hImage_Stream, @hImage_GDI, &hFF000000)
		GdipDisposeImage(hImage_Stream)
		Return hImage_GDI
	Endif

	Return hImage_Stream
End Function

Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr
	Dim As HINTERNET hOpen = InternetOpen("IE", INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0), _
					 hFile = InternetOpenUrl(hOpen, sURL, NULL, 0, INTERNET_FLAG_RELOAD, 0)
					 
	Dim As Ulong iBuffLen = 32, iBytes = 1
	Dim As String sBuff = Space(32)
	HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, StrPtr(sBuff), @iBuffLen, NULL)
	iBuffLen = Valint(Trim(sBuff))
	Dim As Byte Ptr imgBuffer
	If iBuffLen > 0 Then
		imgBuffer = Allocate(iBuffLen)
		Do Until iBytes = 0
			InternetReadFile(hFile, imgBuffer, iBuffLen, @iBytes)
		Loop
	Endif
	InternetCloseHandle(hFile)
	InternetCloseHandle(hOpen)
	iSize = iBuffLen
	Return imgBuffer
End Function
3) GDI+ Image Painting3.bas

Code: Select all

'Coded by UEZ build 2019-02-15
'Windows only!
'Original idea (Brush Drawing) by Oliver Brotherhood   

#Include "fbgfx.bi" 
#Include "windows.bi"
#Include "vbcompat.bi"
#include "win\wininet.bi"

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include "win/gdiplus-c.bi"
#Else
    #Include "win/gdiplus.bi"
    Using gdiplus
#Endif

Using FB 

Declare Function Brightness(iColor As Ulong) As Single
Declare Function RandomRange(fStart as Single, fEnd as Single) as Single
Declare Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
Declare Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
Declare Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr

If Messagebox(0, "Do you agree to download an image from internet?", "Information", MB_ICONQUESTION or MB_YESNO) = 7 Then
	Messagebox(0, "This demo requires an image. Please enable code line to load from local disk and disable code for download! Do not forget to adjust the path to the image!", "Information", MB_ICONWARNING)
	End
End If

Type Particle
   As Single x, y, vx, vy, size
End Type

'Stack
Type _Stack
   Private:
      As Particle aStack(Any)
      As Uinteger iPos = 0
   Public:
      Declare Constructor()
      Declare Destructor()
      Declare Sub Push(Particle As Particle)
      Declare Function Pop() As Particle
      Declare Function Get(iPos As Uinteger) Byref As Particle
      Declare Sub Set(iPos As Uinteger, x As Single, y As Single, vx As Single, vy As Single, size As Single)
      Declare Sub DeleteItem(iPos As Uinteger)
      Declare Function Count() As Uinteger
      Declare Sub Print()
End Type

Constructor _Stack()
   Redim This.aStack(0 To 1000) As Particle
End Constructor

Destructor _Stack()
   Redim This.aStack(0)
End Destructor

Sub _Stack.Push(Particle As Particle)
   If This.iPos >= Ubound(This.aStack) Then
      Redim Preserve This.aStack(0 To This.iPos + 1000)
   End If
   This.aStack(iPos) = Particle
   This.iPos += 1
End Sub

Function _Stack.Pop() As Particle
   If This.iPos > 0 Then This.iPos -= 1
   Return This.aStack(This.iPos)
End Function

Sub _Stack.Set(iPos As Uinteger, x As Single, y As Single, vx As Single, vy As Single, size As Single)
   If iPos >= 0 And iPos <= Ubound(This.aStack) Then 
      This.aStack(iPos).x = x
      This.aStack(iPos).y = y
      This.aStack(iPos).vx = vx
      This.aStack(iPos).vy = vy
      This.aStack(iPos).size = size
   End If
End Sub

Function _Stack.Get(iPos As Uinteger) Byref As Particle
   If iPos >= 0 And iPos <= Ubound(This.aStack) Then Return This.aStack(iPos)
End Function

Sub _Stack.DeleteItem(iPos As Uinteger)
   If This.iPos >= 0 And This.iPos <= Ubound(This.aStack) Then
      If iPos < Ubound(This.aStack) Then
         For i As Uinteger = iPos To Ubound(This.aStack) - 1
            This.aStack(i).x = This.aStack(i + 1).x
            This.aStack(i).y = This.aStack(i + 1).y
            This.aStack(i).vx = This.aStack(i + 1).vx
            This.aStack(i).vy = This.aStack(i + 1).vy
            This.aStack(i).size = This.aStack(i + 1).size
         Next
      End If
      Redim Preserve This.aStack(0 To This.iPos - 1)
      If This.iPos > 0 Then This.iPos -= 1
   End If
End Sub

Function _Stack.Count() As Uinteger
   Return This.iPos
End Function

Sub _Stack.Print()
   If This.iPos > 0 Then
      For i As Uinteger = 0 To This.iPos - 1
         ? This.aStack(i).x, This.aStack(i).x
      Next
   Else 
      ? "<empty>"
   End If
End Sub
'-----------------------------------------------------------

'--------------------------------------------------------------------------------------------------
Type float As Single 'Double 
 
Dim Shared As Integer perm(512) = { _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180, _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180} 

Function SimplexNoise2D(xin As float, yin As float, scale As float = 20.0) As float 'by D.J.Peters aka Joshy
  Const As float F2 = 0.5*(Sqr(3.0)-1.0) 
  Const As float G2 = (3.0-Sqr(3.0))/6.0 
  Const As float G22 = G2 + G2
  Static As Integer grad2(11,1) = {{ 1, 1},{-1, 1},{1,-1},{-1,-1}, _
                                   { 1, 0},{-1, 0},{1, 0},{-1, 0}, _
                                   { 0, 1},{ 0,-1},{0, 1},{ 0,-1}} 
  Dim As float s = (xin+yin)*F2
  Dim As Integer i = Int(xin+s)
  Dim As Integer j = Int(yin+s)
  Dim As float t = (i+j)*G2 
  Dim As float x  = i-t  , y = j-t 
  Dim As float x0 = xin-x, y0 = yin-y 
  Dim As Integer i1=Any, j1=Any
  i And=255
  j And=255
  
  If (x0>y0) Then
    i1=1: j1=0
  Else
    i1=0: j1=1
  End If         

  Dim As float x1 = x0 - i1 + G2 
  Dim As float y1 = y0 - j1 + G2 
  Dim As float x2 = x0 - 1.0 + G22 
  Dim As float y2 = y0 - 1.0 + G22 
  Dim As Integer ii = i 'And 255 
  Dim As Integer jj = j 'And 255 
  Dim As Integer ind = Any
  Dim As float n=Any
  t = 0.5 - x0*x0-y0*y0 
  If (t<0) Then
    n=0
  Else 
    ind = perm(i+perm(j)) Mod 12 
    n = t*t*t*t  * (grad2(ind,0)*x0 + grad2(ind,1)*y0)
  End If 
  t = 0.5 - x1*x1-y1*y1 
  If (t<0) Then
  Else 
    ind = perm(i+i1+perm(j+j1)) Mod 12 
    n+= t*t*t*t  * (grad2(ind,0)*x1 + grad2(ind,1)*y1)
  End If 
  t = 0.5 - x2*x2-y2*y2 
  If(t<0) Then 
  Else
    i+=1:j+=1  
    ind= perm(i+perm(j)) Mod 12 
    n+= t*t*t*t  * (grad2(ind,0)*x2 + grad2(ind,1)*y2)
  End If 
  ' scaled in the interval [-1,1]. 
  Return scale * n
End Function 
'--------------------------------------------------------------------------------------------------


Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End

Dim As Single iW, iH, iPixel, iRowOffset
Dim As Any Ptr hImage


'load image from internet
Dim As Integer iSize
Dim As Byte Ptr binImg = LoadDataFromINet("https://i.pinimg.com/originals/b3/7e/0f/b37e0f691a8bb179bd344d6c911bcd43.jpg", iSize)
hImage = _GDIPlus_BitmapCreateFromMemory3(binImg, iSize)
Deallocate binImg

'for local files
'GdipLoadImageFromFile("Test.png", @hImage)

GdipGetImageDimension(hImage, @iW, @iH)

If iW = 0 Then 
   GdiplusShutdown(gdipToken)
   Messagebox(0, "Something went wrong to download the image!", "ERROR", 16)
   End
End If


'read all colors to an array for faster access
Dim As ULong aColors(0 To iH - 1, 0 To iW - 1), iX, iY, iARGB
For iY = 0 To iH - 1
   For iX = 0 To iW - 1 
      GdipBitmapGetPixel(hImage, iX, iY, @iARGB)
      aColors(iY, iX) = iARGB
   Next
Next
   

Dim As String sTitle = "GDIPlus Image Painting 3 Demo / FPS: "
Dim As UShort iFPS = 0

Dim As Double fTimer 
Dim evt As Event 

Screencontrol SET_DRIVER_NAME, "GDI"
Screenres iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH 
Windowtitle sTitle 

Dim As HWND hHWND
Screencontrol(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As Any Ptr    hDC = GetDC(hHWND), _
            hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
            hDC_backbuffer = CreateCompatibleDC(hDC), _
            hDC_obj = SelectObject(hDC_backbuffer, hHBitmap), _
            hCanvas, hBrush, hBitmap


GdipCreateFromHDC(hDC_backbuffer, @hCanvas)
GdipSetSmoothingMode(hCanvas, SmoothingModeAntiAlias)
GdipSetPixelOffsetMode(hCanvas, PixelOffsetModeHalf)
GdipCreateSolidFill(&hFFFF0000, @hBrush)
GdipGraphicsClear(hCanvas, &hFF404040)

Randomize(, 2)


? "Press lmb and move mouse cursor around!"

Dim As Ushort iTotal = 20, i
Dim As _Stack Stack
Dim As Single x, y
Dim As Particle brush
Dim As Bool bLMB_pressed = False
Dim As Integer mx, my, mb
fTimer = Timer 

Do 
	Getmouse mx, my, , mb
	If mb = 1 Then 
		bLMB_pressed = True
		For i = 0 To iTotal - 1
			brush.x = mx + RandomRange(-4, 4)
			brush.y = my + RandomRange(-4, 4)
			brush.vx = RandomRange(-3, 3)
			brush.vy = RandomRange(-3, 3)
			brush.size = 16
			Stack.Push(brush)
		Next
	End If
   
	If Stack.Count() > 0 Then
		For i = 0 To Stack.Count() - 1
			x = Stack.Get(i).x
			y = Stack.Get(i).y
			x = Iif(x < 0, 0, Iif(x > iW - 1, iW - 1, x))
			y = Iif(y < 0, 0, Iif(y > iH - 1, iH - 1, y))
			GdipSetSolidFillColor(hBrush, &h80FFFFFF And aColors(y, x))
			GdipFillEllipse(hCanvas, hBrush, x - Stack.Get(i).size / 2, y - Stack.Get(i).size / 2, Stack.Get(i).size, Stack.Get(i).size)
			x += Stack.Get(i).vx + SimplexNoise2D(x, y, 500)
			y += Stack.Get(i).vy + SimplexNoise2D(x, y, 500)
			Stack.Set(i, x, y, Stack.Get(i).vx, Stack.Get(i).vy, Stack.Get(i).size * 0.9)
		Next
	  
		'cleanup stack elements
		i = Stack.Count()
		Do Until i = 0
			If Stack.Get(i).size < 0.75 Then Stack.DeleteItem(i)
			i -= 1
		Loop
	End If

	If bLMB_pressed = True Then BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)

	If(Timer - fTimer > 0.99) Then 
		Windowtitle (sTitle & iFPS) 
		iFPS = 0 
		fTimer = Timer 
	Else 
		iFPS += 1 
	Endif 
   
	If (Screenevent(@evt)) Then 
		Select Case evt.Type 
			Case EVENT_KEY_PRESS
				If evt.scancode = SC_ESCAPE Then Exit Do
			Case EVENT_WINDOW_CLOSE
				Exit Do
			Case EVENT_MOUSE_BUTTON_RELEASE
				If evt.button = BUTTON_RIGHT Then
					GdipCreateBitmapFromHBITMAP(hHBitmap, 0, @hBitmap)
					_GDIPlus_ImageSaveToFile(hBitmap, Curdir & "\Painting3_" & Format(Now(), "yyyymmdd_hhmmss") & ".jpg")
					GdipDisposeImage(hBitmap)
				Elseif evt.button = BUTTON_MIDDLE Then
					GdipGraphicsClear(hCanvas, &hFF404040)
				End If
			'Case EVENT_KEY_PRESS
				'If evt.scancode = Asc("c") Then GdipGraphicsClear(hCanvas, &hFF404040)
		End Select 
	Endif 
	Sleep(10, 1) 
Loop

'GDI
SelectObject(hDC_backbuffer, hDC_obj)
DeleteDC(hDC_backbuffer)
DeleteObject(hHBitmap)
ReleaseDC(hHWND, hDC)

'GDIPlus
GdipDeleteBrush(hBrush)      
GdipDeleteGraphics(hCanvas)
GdiplusShutdown(gdipToken)
End
				
Function Brightness(iColor As Ulong) As Single
   Dim As Ubyte r = (iColor Shr 16) And &hFF, g = (iColor Shr 8) And &hFF, b = iColor And &hFF
   Return Sqr(0.241 * r * r + 0.691 * g * g + 0.068 * b * b)
End Function

Function RandomRange(fStart as Single, fEnd as Single) as Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
   'check If hImage Is a GDI+ image
   Dim As Single iW, iH
   If  GdipGetImageDimension(hImage, @iW, @iH) <> 0 Then Return 0
   
   Dim As Byte iErr = 0

   Dim As Ulong count, size
   GdipGetImageEncodersSize(@count, @size)
   
   Dim As CLSID clsid
   Dim As ImageCodecInfo Ptr pImageCodecInfo
   pImageCodecInfo = Allocate(size)
   GdipGetImageEncoders(count, size, pImageCodecInfo)

   #Define _MimeType(x)   (*Cast(Wstring Ptr, pImageCodecInfo[x].MimeType))
   #Define FnSuffix   (Right(Filename, 4))   
   
   For i As Ulong = 0 To count - 1
      If _MimeType(i) = "image/bmp" And FnSuffix = ".bmp" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/jpeg" And (FnSuffix = ".jpg" Or FnSuffix = ".jpe" Or Right(Filename, 5) = ".jpeg" Or Right(Filename, 5) = ".jfif") Then
         JPGQual = Iif(JPGQual < 0, 0, Iif(JPGQual > 100, 100, JPGQual))
         Dim tParams As EncoderParameters
         Dim EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
         tParams.Count = 1
         CLSIDFromString(Wstr(EncoderQuality), @tParams.Parameter(0).GUID)
         With tParams.Parameter(0)
            .NumberOfValues = 1
            .Type = EncoderParameterValueTypeLong
            .Value = Varptr(JPGQual)
         End With
         If GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, @tParams) <> 0 Then iErr += 1          
      Elseif _MimeType(i) = "image/gif" And FnSuffix = ".gif" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/tiff" And (FnSuffix = ".tif" Or Right(Filename, 5) = ".tiff") Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/png" And FnSuffix = ".png" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1     
      Else
         iErr += 1
      End If
   Next

   Deallocate(pImageCodecInfo)

   If iErr > 0 Then Return False

   Return True
End Function

Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
   Dim As HGLOBAL hGlobal
   Dim As LPSTREAM hStream
   Dim As Any Ptr hImage_Stream
   Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
   Dim As Any Ptr lpMemory = GlobalLock(hMemory)
   RtlCopyMemory(lpMemory, @aBinImage[0], iLen)
   GlobalUnlock(hMemory)
   CreateStreamOnHGlobal(hMemory, 0, @hStream)
   GdipCreateBitmapFromStream(hStream, @hImage_Stream)
   IUnknown_Release(hStream)

   If bBitmap_GDI = TRUE Then
      Dim hImage_GDI As Any Ptr
      GdipCreateHBITMAPFromBitmap(hImage_Stream, @hImage_GDI, &hFF000000)
      GdipDisposeImage(hImage_Stream)
      Return hImage_GDI
   Endif

   Return hImage_Stream
End Function

Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr
   Dim As HINTERNET hOpen = InternetOpen("IE", INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0), _
					hFile = InternetOpenUrl(hOpen, sURL, NULL, 0, INTERNET_FLAG_RELOAD, 0)
                
   Dim As Ulong iBuffLen = 32, iBytes = 1
   Dim As String sBuff = Space(32)
   HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, StrPtr(sBuff), @iBuffLen, NULL)
   iBuffLen = Valint(Trim(sBuff))
   Dim As Byte Ptr imgBuffer
   If iBuffLen > 0 Then
      imgBuffer = Allocate(iBuffLen)
      Do Until iBytes = 0
         InternetReadFile(hFile, imgBuffer, iBuffLen, @iBytes)
      Loop
   Endif
   InternetCloseHandle(hFile)
   InternetCloseHandle(hOpen)
   iSize = iBuffLen
   Return imgBuffer
End Function
Press lmb and move mouse around.


4) GDI+ Image Painting4.bas (van Gogh style)

Code: Select all

'Coded by UEZ build 2019-02-10
'Windows only!
'Original idea (Noise flow field painter) by Jose  

#Include "fbgfx.bi" 
#Include "windows.bi"
#Include "vbcompat.bi"
#include "win\wininet.bi"

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include "win/gdiplus-c.bi"
#Else
    #Include "win/gdiplus.bi"
    Using gdiplus
#Endif

Using FB 

Declare Function RandomRange(fStart as Single, fEnd as Single) as Single
Declare Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
Declare Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
Declare Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr


If Messagebox(0, "Do you agree to download an image from internet?", "Information", MB_ICONQUESTION or MB_YESNO) = 7 Then
	Messagebox(0, "This demo requires an image. Please enable code line to load from local disk and disable code for download! Do not forget to adjust the path to the image!", "Information", MB_ICONWARNING)
	End
End If

'--------------------------------------------------------------------------------------------------
Type float As Single 'Double 
 
Dim Shared As Integer perm(512) = { _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180, _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180} 

Function SimplexNoise2D(xin As float, yin As float, scale As float = 1.0) As float 'by D.J.Peters aka Joshy
  Const As float F2 = 0.5*(Sqr(3.0)-1.0) 
  Const As float G2 = (3.0-Sqr(3.0))/6.0 
  Const As float G22 = G2 + G2
  Static As Integer grad2(11,1) = {{ 1, 1},{-1, 1},{1,-1},{-1,-1}, _
                                   { 1, 0},{-1, 0},{1, 0},{-1, 0}, _
                                   { 0, 1},{ 0,-1},{0, 1},{ 0,-1}} 
  Dim As float s = (xin+yin)*F2
  Dim As Integer i = Int(xin+s)
  Dim As Integer j = Int(yin+s)
  Dim As float t = (i+j)*G2 
  Dim As float x  = i-t  , y = j-t 
  Dim As float x0 = xin-x, y0 = yin-y 
  Dim As Integer i1=Any, j1=Any
  i And=255
  j And=255
  
  If (x0>y0) Then
    i1=1: j1=0
  Else
    i1=0: j1=1
  End If         

  Dim As float x1 = x0 - i1 + G2 
  Dim As float y1 = y0 - j1 + G2 
  Dim As float x2 = x0 - 1.0 + G22 
  Dim As float y2 = y0 - 1.0 + G22 
  Dim As Integer ii = i 'And 255 
  Dim As Integer jj = j 'And 255 
  Dim As Integer ind = Any
  Dim As float n=Any
  t = 0.5 - x0*x0-y0*y0 
  If (t<0) Then
    n=0
  Else 
    ind = perm(i+perm(j)) Mod 12 
    n = t*t*t*t  * (grad2(ind,0)*x0 + grad2(ind,1)*y0)
  End If 
  t = 0.5 - x1*x1-y1*y1 
  If (t<0) Then
  Else 
    ind = perm(i+i1+perm(j+j1)) Mod 12 
    n+= t*t*t*t  * (grad2(ind,0)*x1 + grad2(ind,1)*y1)
  End If 
  t = 0.5 - x2*x2-y2*y2 
  If(t<0) Then 
  Else
    i+=1:j+=1  
    ind= perm(i+perm(j)) Mod 12 
    n+= t*t*t*t* (grad2(ind,0)*x2 + grad2(ind,1)*y2)
  End If 
  ' scaled in the interval [-1,1]. 
  Return scale * n
End Function 
'--------------------------------------------------------------------------------------------------


Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End

Dim As Single iW, iH, iPixel, iRowOffset
Dim As Any Ptr hImage


'load image from internet
Dim As Integer iSize
'Dim As Byte Ptr binImg = LoadDataFromINet("https://pics.freiepresse.de/DYNIMG/74/95/6397495_W740.jpg", iSize)
'Dim As Byte Ptr binImg = LoadDataFromINet("https://www.tpi.it/app/uploads/2019/01/van-gogh.jpg", iSize)
Dim As Byte Ptr binImg = LoadDataFromINet("https://leaders.economicblogs.org/wp-content/uploads/2018/12/AEG.jpg", iSize)
'Dim As Byte Ptr binImg = LoadDataFromINet("https://d2jv9003bew7ag.cloudfront.net/uploads/Pablo-Picasso-old.jpg", iSize)
hImage = _GDIPlus_BitmapCreateFromMemory3(binImg, iSize)
Deallocate binImg

'for local files
'GdipLoadImageFromFile("Test.png", @hImage)

GdipGetImageDimension(hImage, @iW, @iH)

If iW = 0 Then 
   GdiplusShutdown(gdipToken)
   Messagebox(0, "Something went wrong to download the image!", "ERROR", 16)
   End
End If


'read all colors to an array for faster access
Dim As ULong aColors(0 To iH - 1, 0 To iW - 1), iX, iY, iARGB
For iY = 0 To iH - 1
   For iX = 0 To iW - 1 
      GdipBitmapGetPixel(hImage, iX, iY, @iARGB)
      aColors(iY, iX) = iARGB
   Next
Next
   

Dim As String sTitle = "GDIPlus Image Painting 4 Demo / FPS: "
Dim As UShort iFPS = 0

Dim As Double fTimer 
Dim evt As Event 

Screencontrol SET_DRIVER_NAME, "GDI"
Screenres iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH 
Windowtitle sTitle 

Dim As Integer iDW, iDH
Screencontrol GET_DESKTOP_SIZE, iDW, iDH
Dim tWorkingArea As RECT
SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
Screencontrol SET_WINDOW_POS, (iDW - iW) \ 2, ((tWorkingArea.Bottom - iH) - (iDH - tWorkingArea.Bottom)) \ 2


Dim As HWND hHWND
Screencontrol(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As Any Ptr	hDC = GetDC(hHWND), _
				hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
				hDC_backbuffer = CreateCompatibleDC(hDC), _
				hDC_obj = SelectObject(hDC_backbuffer, hHBitmap), _
				hCanvas, hPen, hBrush, hBitmap

GdipCreateFromHDC(hDC_backbuffer, @hCanvas)
GdipSetSmoothingMode(hCanvas, SmoothingModeAntiAlias)
GdipSetPixelOffsetMode(hCanvas, PixelOffsetModeHalf)
GdipGraphicsClear(hCanvas, &hFFFFFFFF)
GdipCreatePen1(&hFF000000, 1, 2, @hPen)
GdipSetPenStartCap(hPen, 2)
GdipSetPenEndCap(hPen, 2)

Randomize(, 2)

#Define Map(n, s, e, ns, ne) (ns - (ns - ne) * (n / (e - s)))
#Define Red(iCol) ((iCol And &hFF0000) Shr 16)
#Define Green(iCol) ((iCol And &hFF00) Shr 8)
#Define Blue(iCol) (iCol And &hFF)

Const fPI = Acos(-1), rad = Acos(-1) * 180
Dim As Single x, y, xx, yy, frame, count, sw, angle, lengthVariation, _fMax = Max(iW, iH), _fMin = Min(iW, iH), _
	   noiseScale = 0.005, drawLength = _fMax / 2.5, fMSL = _fMin / 80, strokeLength = fMSL
Dim As Ulong col
Dim As Integer mx, my, mb
fTimer = Timer 

Do 
	If frame <= drawLength Then
		count = map(frame, 0, drawLength, 20, 80)
		For i As uShort = 0 To count
			strokeLength += RandomRange(-fMSL / 2, fMSL / 4)
			x = Rnd() * iW - strokeLength / 2 : xx = x
			y = Rnd() * iH - strokeLength / 2 : yy = y		
			col = aColors(Iif(y < 0, 0, Iif(y > iH - 1, iH - 1, y)), Iif(x < 0, 0, Iif(x > iW - 1, iW - 1, x)))
			GdipCreateHatchBrush(9, &h70FFFFFF And col, col, @hBrush)
			GdipSetPenBrushFill(hPen, hBrush)
			
			'GdipSetPenColor(hPen, &h70FFFFFF And col)
			sw = map(frame, 0, drawLength, 32, 1)
			GdipSetPenWidth(hPen, sw)
			angle = SimplexNoise2D(x * noiseScale, y * noiseScale, 0.2) * 3.3333
			lengthVariation = RandomRange(0.75, 1.25)
			xx += Cos((angle - fPi) * rad) * strokeLength
			yy += Sin((angle - fPi) * rad) * strokeLength
			x += Cos(angle * rad) * strokeLength
			y += Sin(angle * rad) * strokeLength
			GdipDrawLine(hCanvas, hPen, x, y, xx + strokeLength * lengthVariation, yy)
			col = RandomRange(&h18, &h40) Shl 24 Or Min(Red(col) * 3, 255) Shl 16 Or Min(Green(col * 3), 255) Shl 8 Or Min(Blue(col * 3), 255)
			GdipSetPenColor(hPen, col)
			GdipSetPenWidth(hPen, sw * 0.85)
			GdipDrawLine(hCanvas, hPen, x, y - sw * 0.15, xx + strokeLength * lengthVariation, yy - sw * 0.15)
			strokeLength = fMSL
			GdipDeleteBrush(hBrush)	
		Next
		frame += 0.25
	End If


	BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)

	If(Timer - fTimer > 0.99) Then 
		Windowtitle (sTitle & iFPS & " / Rendered: " & Format(frame / drawLength, "###%"))
		iFPS = 0 
		fTimer = Timer 
	Else 
		iFPS += 1 
	Endif 
   
	If (Screenevent(@evt)) Then 
		Select Case evt.Type 
			Case SC_ESCAPE, EVENT_WINDOW_CLOSE
				'GDI
				SelectObject(hDC_backbuffer, hDC_obj)
				DeleteDC(hDC_backbuffer)
				DeleteObject(hHBitmap)
				ReleaseDC(hHWND, hDC)

				'GDIPlus
				GdipDeletePen(hPen)      
				GdipDeleteGraphics(hCanvas)
				GdiplusShutdown(gdipToken)
				End 
			Case EVENT_MOUSE_BUTTON_RELEASE
				If evt.button = BUTTON_RIGHT Then
					GdipCreateBitmapFromHBITMAP(hHBitmap, 0, @hBitmap)
					_GDIPlus_ImageSaveToFile(hBitmap, Curdir & "\Painting4_" & Format(Now(), "yyyymmdd_hhmmss") & ".jpg")
					GdipDisposeImage(hBitmap)
				Elseif evt.button = BUTTON_MIDDLE Then
					GdipGraphicsClear(hCanvas, &hFFFFFFFF)
					frame = 0
				End If
		End Select 
	Endif 
	Sleep(10, 1) 
Loop

Function RandomRange(fStart as Single, fEnd as Single) as Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Function _GDIPlus_ImageSaveToFile(hImage As Any Ptr, Filename As Wstring, JPGQual As Ulong = 85) As Boolean
   'check If hImage Is a GDI+ image
   Dim As Single iW, iH
   If  GdipGetImageDimension(hImage, @iW, @iH) <> 0 Then Return 0
   
   Dim As Byte iErr = 0

   Dim As Ulong count, size
   GdipGetImageEncodersSize(@count, @size)
   
   Dim As CLSID clsid
   Dim As ImageCodecInfo Ptr pImageCodecInfo
   pImageCodecInfo = Allocate(size)
   GdipGetImageEncoders(count, size, pImageCodecInfo)

   #Define _MimeType(x)   (*Cast(Wstring Ptr, pImageCodecInfo[x].MimeType))
   #Define FnSuffix   (Right(Filename, 4))   
   
   For i As Ulong = 0 To count - 1
      If _MimeType(i) = "image/bmp" And FnSuffix = ".bmp" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/jpeg" And (FnSuffix = ".jpg" Or FnSuffix = ".jpe" Or Right(Filename, 5) = ".jpeg" Or Right(Filename, 5) = ".jfif") Then
         JPGQual = Iif(JPGQual < 0, 0, Iif(JPGQual > 100, 100, JPGQual))
         Dim tParams As EncoderParameters
         Dim EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
         tParams.Count = 1
         CLSIDFromString(Wstr(EncoderQuality), @tParams.Parameter(0).GUID)
         With tParams.Parameter(0)
            .NumberOfValues = 1
            .Type = EncoderParameterValueTypeLong
            .Value = Varptr(JPGQual)
         End With
         If GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, @tParams) <> 0 Then iErr += 1          
      Elseif _MimeType(i) = "image/gif" And FnSuffix = ".gif" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/tiff" And (FnSuffix = ".tif" Or Right(Filename, 5) = ".tiff") Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/png" And FnSuffix = ".png" Then
         If (GdipSaveImageToFile(hImage, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1     
      Else
         iErr += 1
      End If
   Next

   Deallocate(pImageCodecInfo)

   If iErr > 0 Then Return False

   Return True
End Function

Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False) As Any Ptr
   Dim As HGLOBAL hGlobal
   Dim As LPSTREAM hStream
   Dim As Any Ptr hImage_Stream
   Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
   Dim As Any Ptr lpMemory = GlobalLock(hMemory)
   RtlCopyMemory(lpMemory, @aBinImage[0], iLen)
   GlobalUnlock(hMemory)
   CreateStreamOnHGlobal(hMemory, 0, @hStream)
   GdipCreateBitmapFromStream(hStream, @hImage_Stream)
   IUnknown_Release(hStream)

   If bBitmap_GDI = TRUE Then
      Dim hImage_GDI As Any Ptr
      GdipCreateHBITMAPFromBitmap(hImage_Stream, @hImage_GDI, &hFF000000)
      GdipDisposeImage(hImage_Stream)
      Return hImage_GDI
   Endif

   Return hImage_Stream
End Function

Function LoadDataFromINet(sUrl As String, Byref iSize As Integer) As Byte Ptr
   Dim As HINTERNET hOpen = InternetOpen("IE", INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0), _
					hFile = InternetOpenUrl(hOpen, sURL, NULL, 0, INTERNET_FLAG_RELOAD, 0)
                
   Dim As Ulong iBuffLen = 32, iBytes = 1
   Dim As String sBuff = Space(32)
   HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, StrPtr(sBuff), @iBuffLen, NULL)
   iBuffLen = Valint(Trim(sBuff))
   Dim As Byte Ptr imgBuffer
   If iBuffLen > 0 Then
      imgBuffer = Allocate(iBuffLen)
      Do Until iBytes = 0
         InternetReadFile(hFile, imgBuffer, iBuffLen, @iBytes)
      Loop
   Endif
   InternetCloseHandle(hFile)
   InternetCloseHandle(hOpen)
   iSize = iBuffLen
   Return imgBuffer
End Function

More examples will follow from time to time.
Last edited by UEZ on Feb 15, 2019 10:21, edited 11 times in total.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Image Painting Demos [Windows only]

Post by MrSwiss »

<edit/>
Last edited by MrSwiss on Feb 11, 2019 21:01, edited 1 time in total.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Image Painting Demos [Windows only]

Post by UEZ »

MrSwiss wrote:Why don't you do it like a man, just for a change, which means to say:

Without external libraries, which always introduce dependencies ...
(keeping it nice, and multi OS)

Just pure and simple FB code, using internals only!
Why? I don't care if doesn't run on other os! If you don't agree ignore it.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Image Painting Demos [Windows only]

Post by MrSwiss »

UEZ wrote:Why?
You may want to become a "Programmer" and, not just stay put as "Library Linker".
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Image Painting Demos [Windows only]

Post by UEZ »

MrSwiss wrote:
UEZ wrote:Why?
You may want to become a "Programmer" and, not just stay put as "Library Linker".
According to your definition I shouldn't use any include file because binding any include file is lame (include binder) or even OpenGL which is also an external lib. I should reinvent the wheel again and again to become a mf programmer.

Please do not reply such comments in my topic anymore. If you don't like it ignore it and let me be a mf library linker.
Last edited by UEZ on Feb 07, 2019 15:03, edited 1 time in total.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Image Painting Demos [Windows only]

Post by MrSwiss »

UEZ wrote:Please do not reply such comments in my topic anymore.
No problem, provided that you in future, keep your "Libraries code" out of all threads,
that are not your own ... because that's become very, very annoying!
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Image Painting Demos [Windows only]

Post by BasicCoder2 »

Interesting examples as I am interested in graphic programs.
I like that you can load an image from the net,
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Image Painting Demos [Windows only]

Post by dafhi »

thank you UEZ. you are a talented programmer.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Image Painting Demos [Windows only]

Post by grindstone »

@MrSwiss: You can't help doing it...

@UEZ: Just consider it as a nonbinding expression of opinion and follow your way.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Image Painting Demos [Windows only]

Post by dodicat »

Thanks UEZ.
We need more like you and your second picture on this forum.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Image Painting Demos [Windows only]

Post by UEZ »

BasicCoder2 wrote:Interesting examples as I am interested in graphic programs.
I like that you can load an image from the net,
dafhi wrote:thank you UEZ. you are a talented programmer.
grindstone wrote:@MrSwiss: You can't help doing it...

@UEZ: Just consider it as a nonbinding expression of opinion and follow your way.
dodicat wrote:Thanks UEZ.
We need more like you and your second picture on this forum.
Thank you all for your feedback. Glad to hear that you are interested in this kind of stuff. ^^ Definitely I give a $%#@ about MrSwiss opinion and his will to adjust everything to his visions in this forum.

Btw, I've added a 3rd example.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Image Painting Demos [Windows only]

Post by Tourist Trap »

UEZ wrote:Here some codes to paint an image in different ways.
Seems interesting really, but I get an error, the program won't download stuff from the internet. And thinking about it, I maybe prefer that this effectively won't do such a thing without my consent. So I have 2 questions:
- how can I make it download the pic from the internet?
- would'nt it be better to prompt the user for this action before launching it?

Just my 2 cents, thanks for sharing anyway!
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Image Painting Demos [Windows only]

Post by UEZ »

Tourist Trap wrote:
UEZ wrote:Here some codes to paint an image in different ways.
Seems interesting really, but I get an error, the program won't download stuff from the internet. And thinking about it, I maybe prefer that this effectively won't do such a thing without my consent. So I have 2 questions:
- how can I make it download the pic from the internet?
- would'nt it be better to prompt the user for this action before launching it?

Just my 2 cents, thanks for sharing anyway!
Maybe you have installed a firewall 3rd party tool which blocks the connection to the inet? Maybe a proxy? It is very hard for me to see what's wrong on your system why it fails to download.
I didn't think about prompting the user if he agrees to download an image from the inet for such a simple demo but it can be added easily.

Edit: added prompt to the 3 examples
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Image Painting Demos [Windows only]

Post by dodicat »

Try this TT (another download method)
(Longer time than UEZ's download)
Let it run it's course.

Code: Select all

 

Sub savefile(filename As String,p As String)
    Dim As Integer n
    n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename
    End If
End Sub

savefile("image.jpg","") 'create an empty file

dim as string site=" https://www.noz.de/article/teaser/1395114/full "

shell "bitsadmin  /transfer new  /download  /priority normal " + _
        site + curdir + "\image.jpg "
     
 shell curdir +  "\image.jpg"
 sleep
   
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Image Painting Demos [Windows only]

Post by Tourist Trap »

dodicat wrote:Try this TT (another download method)
(Longer time than UEZ's download)
Let it run it's course.
Hi dodi, I guess I have some blocker. Maybe the big kaspersky :)
For what it's worth in french, I get this answer from your test code in any case:
BITSADMIN version 3.0
BITS administration utility.
(C) Copyright Microsoft Corp.

Unable to add file - 0x80070005
Accès refusé.

'C:\Program' n’est pas reconnu en tant que commande interne
ou externe, un programme exécutable ou un fichier de commandes.
UEZ wrote: Edit: added prompt to the 3 examples
Thanks UEZ! it's really appreciated :)
Post Reply