Image Painting Demos [Windows only]

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

Image Painting Demos [Windows only]

Postby UEZ » Feb 07, 2019 12:55

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: 3083
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Image Painting Demos [Windows only]

Postby MrSwiss » Feb 07, 2019 13:04

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

Re: Image Painting Demos [Windows only]

Postby UEZ » Feb 07, 2019 13:10

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: 3083
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Image Painting Demos [Windows only]

Postby MrSwiss » Feb 07, 2019 13:27

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

Re: Image Painting Demos [Windows only]

Postby UEZ » Feb 07, 2019 13:47

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: 3083
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Image Painting Demos [Windows only]

Postby MrSwiss » Feb 07, 2019 14:10

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: 3349
Joined: Jan 01, 2009 7:03

Re: Image Painting Demos [Windows only]

Postby BasicCoder2 » Feb 07, 2019 22:11

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

Re: Image Painting Demos [Windows only]

Postby dafhi » Feb 08, 2019 1:18

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

Re: Image Painting Demos [Windows only]

Postby grindstone » Feb 08, 2019 9:13

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

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

Re: Image Painting Demos [Windows only]

Postby dodicat » Feb 08, 2019 11:34

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

Re: Image Painting Demos [Windows only]

Postby UEZ » Feb 08, 2019 13:04

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: 2756
Joined: Jun 02, 2015 16:24

Re: Image Painting Demos [Windows only]

Postby Tourist Trap » Feb 08, 2019 14:07

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: 317
Joined: May 05, 2017 19:59
Location: Germany

Re: Image Painting Demos [Windows only]

Postby UEZ » Feb 08, 2019 14:30

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: 5771
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Image Painting Demos [Windows only]

Postby dodicat » Feb 08, 2019 14:47

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: 2756
Joined: Jun 02, 2015 16:24

Re: Image Painting Demos [Windows only]

Postby Tourist Trap » Feb 08, 2019 15:04

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 :)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests