Beiträge von UEZ

**UEZ** · Infinite Image Zoom Flight build 2018-01-10 **UEZ** 5. Januar 2018 um 21:28

Zitat von Andy

Das Stretchblt() ist, GDI+-typisch SCH***-langsam

Stretchblt() ist GDI und nicht GDI+ (Klugshitting )

Na dann schaue dir mal die GDI+ Variante an.

Btw, ich habe die Source Codes ein bissl optimiert.

**UEZ** · Infinite Image Zoom Flight build 2018-01-10 **UEZ** 5. Januar 2018 um 16:16

Danke Oscar!

Ich habe noch ein zweites Beispiel hinzugefügt. Beide Scripte laufen jetzt im Vollbildmodus ab.

**UEZ** · Infinite Image Zoom Flight build 2018-01-10 **UEZ** 5. Januar 2018 um 14:26

Hier zwei kleine Skripte zum Jahreswechsel!

Zoomquilt:

AutoIt

;coded by UEZ build 2018-01-10, idea and images taken from http://zoomquilt.org/
;thanks to spudw2k for the MouseZoom function

#pragma compile(Icon, "c:\Program Files (x86)\AutoIt3\Icons\au3.ico")
#AutoIt3Wrapper_Run_Au3Stripper=y
#Au3Stripper_Parameters=/so /pe /rm
#AutoIt3Wrapper_Run_After=del /f /q "%scriptdir%\%scriptfile%_stripped.au3"

#include <GDIPlus.au3>
#include <GuiConstantsEx.au3>
#include <WindowsConstants.au3>

_GDIPlus_Startup()
Global $hGUI, $iFPS = 0, $iShowFPS = 0, $bExit, $iW, $iH
Global Const $sTitle = "GDI Image Zoom v2.1.2 coded by UEZ"
AutoItSetOption("GUIOnEventMode", 1)

Downloader()
GDIPlus_ZoomImage()

AutoItSetOption("GUIOnEventMode", 0)
_GDIPlus_Shutdown()


Func GDIPlus_ZoomImage($bMultimonitor = False)
    $bExit = False

    Local $i, $aImages[46], $hImage, $hObj
    ConsoleWrite("Loading images from local disk..." & @CRLF)
    Local $fTimer = TimerInit()

    For $i = 0 To UBound($aImages) - 1
        $hImage = _GDIPlus_ImageLoadFromFile(@ScriptDir & "\Images\TheZoomquilt" & StringFormat("%02i.jpg", $i))
        $aImages[$i] = _GDIPlus_BitmapCreateHBITMAPFromBitmap($hImage)
        _GDIPlus_ImageDispose($hImage)
    Next
    ConsoleWrite(UBound($aImages) & " images loaded in " & TimerDiff($fTimer) & " ms" & @CRLF)

    Local $tDim = DllStructCreate($tagBITMAP)
    DllCall("GDI32.dll", 'int', 'GetObject', 'int', $aImages[0], 'int', DllStructGetSize($tDim), 'ptr', DllStructGetPtr($tDim))
    $iW = $tDim.bmWidth
    $iH = $tDim.bmHeight

    Local $hFullScreen = WinGetHandle("[TITLE:Program Manager;CLASS:Progman]"), $aFullScreen[4], $iW_Dt, $iH_Dt
    $aFullScreen = WinGetPos($hFullScreen)

    If $bMultimonitor Then
        $iW_Dt = $aFullScreen[2]
        $iH_Dt = $aFullScreen[3]
    Else
        $iW_Dt = @DesktopWidth
        $iH_Dt = @DesktopHeight
        $aFullScreen[0] = ""
        $aFullScreen[1] = ""
    EndIf

    $hGUI = GUICreate($sTitle, $iW_Dt, $iH_Dt, $aFullScreen[0], $aFullScreen[1], $WS_POPUP, $WS_EX_TOPMOST)
    GUISetState(@SW_SHOW, $hGUI)
    GUISetCursor(16, 1)

    ;create canvas elements
    Local Const $hDC = _WinAPI_GetDC($hGUI)
    Local Const $hHBitmap = _WinAPI_CreateCompatibleBitmap($hDC, $iW_Dt, $iH_Dt)
    Local Const $hDC_backbuffer = _WinAPI_CreateCompatibleDC($hDC)
    Local Const $DC_obj = _WinAPI_SelectObject($hDC_backbuffer, $hHBitmap)
    Local Const $hMemDC = _WinAPI_CreateCompatibleDC($hDC)

    _WinAPI_SetStretchBltMode($hDC_backbuffer, $STRETCH_DELETESCANS)

    Local Const $hCanvas = _GDIPlus_GraphicsCreateFromHDC($hDC_backbuffer)
    _GDIPlus_GraphicsSetSmoothingMode($hCanvas, $GDIP_SMOOTHINGMODE_HIGHQUALITY)
    _GDIPlus_GraphicsSetPixelOffsetMode($hCanvas, $GDIP_PIXELOFFSETMODE_HIGHQUALITY)

    Local Const $hBrush_Clr = _GDIPlus_BrushCreateSolid(0xFF000000), _
                $hBrush_FPS = _GDIPlus_BrushCreateSolid(0xFFFFFFFF), _
                $hFormat_FPS = _GDIPlus_StringFormatCreate(), _
                $hFamily_FPS = _GDIPlus_FontFamilyCreate("Arial"), _
                $hFont_FPS = _GDIPlus_FontCreate($hFamily_FPS, 8), _
                $tLayout_FPS = _GDIPlus_RectFCreate(0, 0, 130, 16)


    $iFPS = 0
    GUISetOnEvent($GUI_EVENT_CLOSE, "_Exit_About")
    AdlibRegister("CalcFPS", 1000)

    Local $a[3], $b = 1, $c, $x, $e, $y, $w, $h, $w2 = $iW_Dt / 2, $h2 = $iH_Dt / 2, $q, $r
    If $iW_Dt > 1.5 * $iH_Dt Then
        $q = $iW_Dt
        $r = 0.75 * $iW_Dt
    Else
        $q = 1.5 * $iH_Dt
        $r = 0.75 * $iH_Dt
    EndIf

    Do
        For $e = 0 To 2
            $a[$e] = $aImages[Mod(Floor($b) + $e, UBound($aImages))]
        Next
        $c = 2^(Mod($b, 1))

        For $e = 0 To 2
            $x = $w2 - $q / 2 * $c
            $y = $h2 - $r / 2 * $c
            $w = $q * $c
            $h = $r * $c
            $hObj = _WinAPI_SelectObject($hMemDC, $a[$e])
            _WinAPI_StretchBlt($hDC_backbuffer, $x, $y, $w, $h, $hMemDC, 0, 0, $iW, $iH, $SRCCOPY)
            $c *= 0.5
        Next
         $b += MouseZoom()
        IF $b < 0 Then $b = UBound($aImages) - $b

        _GDIPlus_GraphicsDrawStringEx($hCanvas, "FPS: " & $iShowFPS  & " @ " & $iW_Dt & "x" & $iH_Dt & " px", $hFont_FPS, $tLayout_FPS, $hFormat_FPS, $hBrush_FPS)
        _WinAPI_BitBlt($hDC, 0, 0, $iW_Dt, $iH_Dt, $hDC_backbuffer, 0, 0, $SRCCOPY)

        $iFPS += 1
        If $bExit Then ExitLoop
    Until Not Sleep(0)

    AdlibUnRegister("CalcFPS")

    ;release resources
    _GDIPlus_FontDispose($hFont_FPS)
    _GDIPlus_FontFamilyDispose($hFamily_FPS)
    _GDIPlus_StringFormatDispose($hFormat_FPS)
    _GDIPlus_BrushDispose($hBrush_Clr)
    _GDIPlus_BrushDispose($hBrush_FPS)
    _GDIPlus_GraphicsDispose($hCanvas)
    _WinAPI_SelectObject($hMemDC, $hObj)
    _WinAPI_DeleteDC($hMemDC)
    _WinAPI_SelectObject($hDC_backbuffer, $DC_obj)
    _WinAPI_DeleteDC($hDC_backbuffer)
    _WinAPI_DeleteObject($hHBitmap)
    _WinAPI_ReleaseDC($hGUI, $hDC)
    For $i = 0 To UBound($aImages) - 1
        _WinAPI_DeleteObject($aImages[$i])
    Next
    GUIDelete($hGUI)
EndFunc   ;==>GDIPlus_ZoomImage


Func MouseZoom()
    ;https://www.arduino.cc/reference/en/language/functions/math/map/
    Local $iInput = MouseGetPos(1), $iInMin = 0, $iInMax = @DesktopHeight, $iOutMin = 1, $iOutMax = -1, $iStep = 0.025
    Return (($iInput - $iInMin) * ($iOutMax - $iOutMin) / ($iInMax - $iInMin) + $iOutMin) * $iStep
EndFunc   ;MouseZoom()

Func _Exit_About()
    $bExit = True
EndFunc   ;==>_Exit_About

Func CalcFPS() ;display FPS
    $iShowFPS = $iFPS
    $iFPS = 0
EndFunc   ;==>CalcFPS

Func Downloader()
    Local $i, $A = StringSplit("FUjD9hf gbHhxTR 8YyzJdR xP3aNkR 2Qi4fQr E6pW5Ky zmtWIBF Af7LtYp TuXy30d 3nKGLr2 hNoWscB mSBvv3K f4wJ70e mIt9XmM M4TkAyh P4L4qhd hNM6bTv VoT8JXM jqcGH0B DYVoN8n bOPQkOI NeaTfJ1 18ppMNr FZ3d8Jv HsoX2RP mjv4kzI 6rpJbef pySKauq WjNQYRV Ffooo8y Xei5XfD T5A415r LiV0VNB nGcwiO4 b1Gdjjy GE828iy eSQ7SLe 1mPyGgL GNtwJIr KxBlU7E aKXhms5 9Quu2wu Y07quDf r0yC5Qa 273fCkD 2wMyCUw FUjD9hf", " ", 2)
    Local $sURL
    For $i = 0 To UBound($A) - 1
        If Not FileExists(@ScriptDir & "\Images\TheZoomquilt" & StringFormat("%02i.jpg", $i)) Then
            If Not FileExists(@ScriptDir & "\Images") Then DirCreate(@ScriptDir & "\Images")
            $sURL = "http://imgur.com/" & $A[Mod(20 + $i, 46)] & ".jpg"
            ConsoleWrite("Downloading " & $sURL & ": " & InetGet($sURL, @ScriptDir & "\Images\TheZoomquilt" & StringFormat("%02i.jpg", $i), 8) & " bytes" & @CRLF)
            ToolTip("Downloading images...Please wait! -> " & $i + 1 & " / " & UBound($A), MouseGetPos(0), MouseGetPos(1))
        EndIf
    Next
    ToolTip("")
EndFunc   ;==>Downloader

Alles anzeigen

Arkadia:

AutoIt

;coded by UEZ build 2018-01-10, idea and images taken from http://arkadia.xyz
;thanks to spudw2k for the MouseZoom function

#pragma compile(Icon, "c:\Program Files (x86)\AutoIt3\Icons\au3.ico")
#AutoIt3Wrapper_Run_Au3Stripper=y
#Au3Stripper_Parameters=/so /pe /rm
#AutoIt3Wrapper_Run_After=del /f /q "%scriptdir%\%scriptfile%_stripped.au3"

#include <GDIPlus.au3>
#include <GuiConstantsEx.au3>
#include <WindowsConstants.au3>

_GDIPlus_Startup()
Global $hGUI, $iFPS = 0, $iShowFPS = 0, $bExit, $iW, $iH
Global Const $sTitle = "GDI Image Zoom v2.2.1 coded by UEZ"
AutoItSetOption("GUIOnEventMode", 1)

Downloader()
GDIPlus_ZoomImage()

AutoItSetOption("GUIOnEventMode", 0)
_GDIPlus_Shutdown()


Func GDIPlus_ZoomImage($bMultimonitor = False)
    $bExit = False

    Local $i, $aImages[49], $hImage, $hObj
    ConsoleWrite("Loading images from local disk..." & @CRLF)
    Local $fTimer = TimerInit()

    For $i = 0 To UBound($aImages) - 1
        $hImage = _GDIPlus_ImageLoadFromFile(@ScriptDir & "\Images\Arkadia" & $i & ".jpg")
        $aImages[$i] = _GDIPlus_BitmapCreateHBITMAPFromBitmap($hImage)
        _GDIPlus_ImageDispose($hImage)
    Next
    ConsoleWrite(UBound($aImages) & " images loaded in " & TimerDiff($fTimer) & " ms" & @CRLF)

    Local $tDim = DllStructCreate($tagBITMAP)
    DllCall("GDI32.dll", "int", "GetObject", "int", $aImages[0], "int", DllStructGetSize($tDim), "ptr", DllStructGetPtr($tDim))
    $iW = $tDim.bmWidth
    $iH = $tDim.bmHeight

    Local $hFullScreen = WinGetHandle("[TITLE:Program Manager;CLASS:Progman]"), $aFullScreen[4], $iW_Dt, $iH_Dt
    $aFullScreen = WinGetPos($hFullScreen)

    If $bMultimonitor Then
        $iW_Dt = $aFullScreen[2]
        $iH_Dt = $aFullScreen[3]
    Else
        $iW_Dt = @DesktopWidth
        $iH_Dt = @DesktopHeight
        $aFullScreen[0] = ""
        $aFullScreen[1] = ""
    EndIf

    $hGUI = GUICreate($sTitle, $iW_Dt, $iH_Dt, $aFullScreen[0], $aFullScreen[1], $WS_POPUP, $WS_EX_TOPMOST)
    GUISetState(@SW_SHOW, $hGUI)
    GUISetCursor(16, 1)

    ;create canvas elements
    Local Const $hDC = _WinAPI_GetDC($hGUI)
    Local Const $hHBitmap = _WinAPI_CreateCompatibleBitmap($hDC, $iW_Dt, $iH_Dt)
    Local Const $hDC_backbuffer = _WinAPI_CreateCompatibleDC($hDC)
    Local Const $DC_obj = _WinAPI_SelectObject($hDC_backbuffer, $hHBitmap)
    Local Const $hMemDC = _WinAPI_CreateCompatibleDC($hDC)
    _WinAPI_SetStretchBltMode($hDC_backbuffer, $STRETCH_DELETESCANS)
    Local Const $hCanvas = _GDIPlus_GraphicsCreateFromHDC($hDC_backbuffer)
    _GDIPlus_GraphicsSetSmoothingMode($hCanvas, $GDIP_SMOOTHINGMODE_HIGHQUALITY)
    _GDIPlus_GraphicsSetPixelOffsetMode($hCanvas, $GDIP_PIXELOFFSETMODE_HIGHQUALITY)

    Local Const $hBrush_Clr = _GDIPlus_BrushCreateSolid(0xFF000000), _
                $hBrush_FPS = _GDIPlus_BrushCreateSolid(0xFFFFFFFF), _
                $hFormat_FPS = _GDIPlus_StringFormatCreate(), _
                $hFamily_FPS = _GDIPlus_FontFamilyCreate("Arial"), _
                $hFont_FPS = _GDIPlus_FontCreate($hFamily_FPS, 8), _
                $tLayout_FPS = _GDIPlus_RectFCreate(0, 0, 130, 16)


    $iFPS = 0
    GUISetOnEvent($GUI_EVENT_CLOSE, "_Exit_About")
    AdlibRegister("CalcFPS", 1000)

    Local $a[3], $b = 1, $c, $x, $e, $y, $w, $h, $w2 = $iW_Dt / 2, $h2 = $iH_Dt / 2, $q, $r
    If $iW_Dt > 1.5 * $iH_Dt Then
        $q = $iW_Dt
        $r = 0.75 * $iW_Dt
    Else
        $q = 1.5 * $iH_Dt
        $r = 0.75 * $iH_Dt
    EndIf

    Do
        For $e = 0 To 2
            $a[$e] = $aImages[Mod(Floor($b) + $e, UBound($aImages))]
        Next
        $c = 2^(Mod($b, 1))

        For $e = 0 To 2
            $x = $w2 - $q / 2 * $c
            $y = $h2 - $r / 2 * $c
            $w = $q * $c
            $h = $r * $c
            $hObj = _WinAPI_SelectObject($hMemDC, $a[$e])
            _WinAPI_StretchBlt($hDC_backbuffer, $x, $y, $w, $h, $hMemDC, 0, 0, $iW, $iH, $SRCCOPY)
            $c *= 0.5
        Next
         $b += MouseZoom()
        IF $b < 0 Then $b = UBound($aImages) - $b

        _GDIPlus_GraphicsDrawStringEx($hCanvas, "FPS: " & $iShowFPS  & " @ " & $iW_Dt & "x" & $iH_Dt & " px", $hFont_FPS, $tLayout_FPS, $hFormat_FPS, $hBrush_FPS)
        _WinAPI_BitBlt($hDC, 0, 0, $iW_Dt, $iH_Dt, $hDC_backbuffer, 0, 0, $SRCCOPY)

        $iFPS += 1
        If $bExit Then ExitLoop
    Until Not Sleep(0)

    AdlibUnRegister("CalcFPS")

    ;release resources
    _GDIPlus_FontDispose($hFont_FPS)
    _GDIPlus_FontFamilyDispose($hFamily_FPS)
    _GDIPlus_StringFormatDispose($hFormat_FPS)
    _GDIPlus_BrushDispose($hBrush_Clr)
    _GDIPlus_BrushDispose($hBrush_FPS)
    _GDIPlus_GraphicsDispose($hCanvas)
    _WinAPI_SelectObject($hMemDC, $hObj)
    _WinAPI_DeleteDC($hMemDC)
    _WinAPI_SelectObject($hDC_backbuffer, $DC_obj)
    _WinAPI_DeleteDC($hDC_backbuffer)
    _WinAPI_DeleteObject($hHBitmap)
    _WinAPI_ReleaseDC($hGUI, $hDC)
    For $i = 0 To UBound($aImages) - 1
        _WinAPI_DeleteObject($aImages[$i])
    Next
    GUIDelete($hGUI)
EndFunc   ;==>GDIPlus_ZoomImage

Func MouseZoom()
    ;https://www.arduino.cc/reference/en/language/functions/math/map/
    Local $iInput = MouseGetPos(1), $iInMin = 0, $iInMax = @DesktopHeight, $iOutMin = 1, $iOutMax = -1, $iStep = 0.025
    Return (($iInput - $iInMin) * ($iOutMax - $iOutMin) / ($iInMax - $iInMin) + $iOutMin) * $iStep
EndFunc   ;MouseZoom()

Func _Exit_About()
    $bExit = True
EndFunc   ;==>_Exit_About

Func CalcFPS() ;display FPS
    $iShowFPS = $iFPS
    $iFPS = 0
EndFunc   ;==>CalcFPS

Func Downloader()
    Local $sURL, $i
    For $i = 0 To 48
        If Not FileExists(@ScriptDir & "\Images\Arkadia" & $i & ".jpg") Then
            If Not FileExists(@ScriptDir & "\Images") Then DirCreate(@ScriptDir & "\Images")
            $sURL = "http://arkadia.xyz/images/arkadia" & $i & ".jpg"
            ConsoleWrite("Downloading " & $sURL & ": " & InetGet($sURL, @ScriptDir & "\Images\Arkadia" & $i & ".jpg", 8) & " bytes" & @CRLF)
            ToolTip("Downloading images...Please wait! -> " & $i + 1 & " / " & $i, MouseGetPos(0), MouseGetPos(1))
        EndIf
    Next
    ToolTip("")
EndFunc   ;==>Downloader

Alles anzeigen

Quelle der Inspirationen / Bilder: http://zoomquilt.org/, http://arkadia.xyz

Ist schon ziemlich krass, wie flüssig der Zoom im Browser läuft...

PS: Zu Risiken und Nebenwirkungen lesen Sie die Packungsbeilage und fragen Sie Ihren Arzt oder Apotheker!

**UEZ**

Zitat von chesstiger

Andy Die MT-Variante mit bits steht ja irgendwo. Ist aber leider auch langsamer.

Davon ab... Ich habe jetzt auch etwas rumprobiert. Eigentlich sollte RadixSort hier das mit Abstand schnellste sein. Im Durchschnittsfall (ist hier gegeben) hat QuickSort die Komplexitätsklasse O(n*log(n)), wie alle besseren vergleichenden Sortieralgorithmen. RadixSort liegt aber in O(n), ist also linear. Der Zeitbedarf steigt also linear mit jedem neuen zu sortierenden Objekt.

Wobei RadixSort nur effizient ist, wenn die maximale Schlüssellänge eher klein ist. Wenn man das klassischs RadixSort nimmt, wird nach Dezimalstellen sortiert, bei einem Int sind das dann maximal 10 Stellen. Das Problem ist wie gemacht für diesen Sortieralgorithmus. Spätestens bei großen Datenmengen sollte er gewinnen. Tut er aber nicht... Ich hab nur noch nicht raus, warum.

Bei mir kackt Radix Sort bei großen Bildern unter FreeBasic ab, da anscheinend FB den benutzten Speicher nicht richtig verwalten kann (Speicherschutzverletzung)!

Ein 2D Array mit aBucket[w*h][10] und rekursivem Aufruf macht Probleme, aber bei kleinen Bildern ist Quick Sort immer noch schneller.

Wer den FB Code testen möchte:

VB.Net

'coded by UEZ build 2017-12-15
#define WIN_INCLUDEALL
#include Once "windows.bi"
#Include Once "win/gdiplus.bi"
#include Once "string.bi"

Using GDIPLUS

Declare Function FileOpenDialog (Byref sTitle As String, Byref sDir As String = CurDir, sFilter As String = !"All Files (*.*)" + Chr(0) + "*.*" + Chr(0, 0)) As String
Declare Function _GDIPlus_ImageCountColors32(himage as any Ptr) as uInteger
Declare Function _GDIPlus_ImageCountColors24(himage as any Ptr) as UInteger
Declare function _GDIPlus_ImageCountColorsAccurat(himage as any Ptr) as uInteger
Declare function _GDIPlus_ImageCountColors24ASM(himage as any Ptr) as uInteger
Declare Function _GDIPlus_ImageGetPixelFormat(hImage as any ptr) as UInteger
Declare Sub Quicksort(Array() As uinteger, iStart As uinteger, iEnd As uinteger)
Declare Sub RadixSortUInt32(a() as UInteger, pa as UByte = 1)

Function _GDIPlus_ImageCountColors32(himage as any Ptr) as uInteger 'slower variant but full 32-bit support
   Dim As Single iW, iH, iPixel, iRowOffset
    GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uinteger aColors(0 to iW * iH), c = 0, iX, iY
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 32-bit colors"
   _GDIPlus_ImageGetPixelFormat(hImage)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1 
           aColors(c) = Cast(uInteger Ptr, tBitmapData.Scan0)[iRowOffset + iX]
           c += 1
      Next
   Next
   
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   
   ? "Sorting color array"
   RadixSortUInt32(aColors()) 
   ? "Counting unique colors"
   c = 0
   For iY = 0 to Ubound(aColors) - 2
      If aColors(iY) < aColors(iY + 1) Then c += 1
   Next

   Return c
End Function

Function _GDIPlus_ImageCountColors24(himage as any Ptr) as uInteger
   Dim As Single iW, iH, iPixel, iRowOffset
    GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uInteger c = 0, iX, iY
   Dim as UlongInt iColor
   Dim as Ubyte aColors()
   Redim aColors(0 to 256^3 + 1) 
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 24-bit colors"
   
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppRGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1 
            iColor = Cast(uInteger Ptr, tBitmapData.Scan0)[iRowOffset + iX] and &h00FFFFFF 'read and make color value 24-bit
            If aColors(iColor) = 0 Then
               c += 1
               aColors(iColor) = 1
            Endif
      Next
   Next
   
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   
   Return c
End Function

function _GDIPlus_ImageCountColorsAccurat(himage as any Ptr) as uInteger 'very very slow!
   Dim As Single iW, iH, iPixel, iRowOffset
    GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uinteger aColors(0 to iW * iH), iColor, c = 0, p = 0, iX, iY, iYY
   Dim as Boolean bFound
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 32-bit colors"
   _GDIPlus_ImageGetPixelFormat(hImage)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1 
            iColor = Cast(uInteger Ptr, tBitmapData.Scan0)[iRowOffset + iX]
            bFound = False
            For iYY = 0 to p
               If iColor = aColors(iYY) Then
                  bFound = true
                  Exit For
               End If
            Next
            If Not bFound then
               aColors(p) = iColor
               p += 1
               c += 1
            End if
      Next
   Next

   GdipBitmapUnlockBits(hImage, @tBitmapData)
   
   Return c   
End Function

Function _GDIPlus_ImageCountColors24ASM(himage as any Ptr) as uInteger
   Dim As Single iW, iH, iPixel
    GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uInteger c = 0, iX, iY, iPixels = iW * iH
   Dim as Byte aColors()
   Redim aColors(0 to 256^3 + 1) 
   
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 24-bit colors"
   
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   Dim As Dword Ptr pBmp = Cast(Any Ptr, tBitmapData.scan0)
   Dim As Byte Ptr pColors = @aColors(0)

   Asm
      mov esi, [pBmp]
      mov ecx, [iPixels]
      mov edi, [pColors]
      Xor eax, eax
      _Pixel_Count:
         mov ebx, [esi]
         and ebx, &hFFFFFF
         cmp Byte Ptr [edi + ebx], 1
         je _Next
         add eax, 1
         mov Byte Ptr [edi + ebx], 1
      _Next:
         add esi, 4
         sub ecx, 1
         jnz _Pixel_Count
      mov [c], eax  
   End Asm

   GdipBitmapUnlockBits(hImage, @tBitmapData)
   Return c
End Function

Function _GDIPlus_ImageGetPixelFormat(hImage as any ptr) as UInteger
   Dim as UInteger iFormat
   GdipGetImagePixelFormat(hImage, @iFormat)
   Return iFormat
End Function

'https://en.wikibooks.org/wiki/Algorithm_Implementation/Sorting/Quicksort
Sub Quicksort(Array() As uinteger, iStart As uinteger, iEnd As uinteger)
   Dim As uInteger i = iStart, j = iEnd, iPivot = Array((i + j) Shr 1)
   While i <= j
      While Array(i) > iPivot
         i += 1
      Wend
      While Array(j) < iPivot 
         j -= 1
      Wend
      If i <= j Then 
         Swap Array(i), Array(j)
         i += 1 
         j -= 1
      End if
   Wend
   If j > iStart Then Quicksort(Array(), iStart, j)
   If i < iEnd Then Quicksort(Array(), i, iEnd)
End Sub

Sub RadixSortUInt32(a() as UInteger, pa as UByte = 1)
   Dim as UInteger aBucket(0 to Ubound(a), 0 to 10), i, x, y
   Dim as UInteger aBucketPos(0 to 10)
   DIm as UInteger p

   For x = 0 to Ubound(a) - 1
      p = CUbyte((a(x) \ 10 ^ (pa - 1)) Mod 10)
      aBucket(aBucketPos(p), p) = a(x) 'hier stürzt es bei großen Bildern ab
      aBucketPos(p) += 1
   Next

   i = 0
   For x = 0 to Ubound(aBucketPos)
      If aBucketPos(x) > 0 Then
         For y = 0 to aBucketPos(x) - 1
            a(i) = aBucket(y, x)
            i += 1
         Next
      End If
   Next
  
   If pa < 10 Then
      ReDim aBucket(1, 1)
      RadixSortUInt32(a(), pa + 1)
   End If
End Sub

'code by KristopherWindsor -> https://www.freebasic.net/forum/viewtopic.php?f=7&t=10981&hilit=FileOpenDialog
Function FileOpenDialog (Byref sTitle As String, Byref sDir As String = CurDir, sFilter As String = !"All Files (*.*)" + Chr(0) + "*.*" + Chr(0, 0)) As String
  Dim oFilename As OPENFILENAME
  Dim sFilename As Zstring * (MAX_PATH + 1)
  Dim Title As Zstring * 32 => sTitle
  Dim sInitialDir As Zstring * 256 => sDir
  
  With oFilename
    .lStructSize       = SizeOf(OPENFILENAME)
    .hwndOwner         = NULL
    .hInstance         = GetModuleHandle(NULL)
                        '"All Files, (*.*)"
                        '"*.*"
                        '"Bas Files, (*.BAS)"
                        '"*.bas"
    '.lpstrFilter       = Strptr(!"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0")
    .lpstrFilter       = Strptr(sFilter)
    .lpstrCustomFilter = NULL
    .nMaxCustFilter    = 0
    .nFilterIndex      = 1
    .lpstrFile         = @sFilename
    .nMaxFile          = SizeOf(sFilename)
    .lpstrFileTitle    = NULL
    .nMaxFileTitle     = 0
    .lpstrInitialDir   = @sInitialDir
    .lpstrTitle        = @Title
    .Flags             = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
    .nFileOffset       = 0
    .nFileExtension    = 0
    .lpstrDefExt       = NULL
    .lCustData         = 0
    .lpfnHook          = NULL
    .lpTemplateName    = NULL
  End With

  If (GetOpenFileName(@oFilename) = FALSE) Then Return ""
  Return sFilename
End Function

Dim GDIPlusStartupInput As GDIPLUSSTARTUPINPUT 
Dim As ULONG_PTR GDIPlusToken 

GDIPlusStartupInput.GdiplusVersion = 1 
If (GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) <> 0) Then 
   End 'FAILED TO INIT GDI+!
EndIf
   
Dim as String sImgFile

sImgFile = FileOpenDialog("Select an image file to load...", "", "Image Files (*.bmp;*.jpg;*.png;*.gif)" + Chr(0) + "*.bmp;*.jpg;*.png;*.gif" + Chr(0))
? "Loading image"
Dim As Integer iStatus
Dim as any Ptr hImage
iStatus = GdipLoadImageFromFile(sImgFile, @hImage)
If iStatus <> 0 Then 
   GdiplusShutdown(GDIPlusToken)
   End
End if

Dim as Double fTimer 
fTimer = Timer
If (_GDIPlus_ImageGetPixelFormat(hImage) and PixelFormatAlpha) Then 'check if image has alpha channel
      ? "Unique color count: " & _GDIPlus_ImageCountColors32(hImage)
   Else
      ? "Unique color count: " & _GDIPlus_ImageCountColors24ASM(hImage)
End If
? "Time: " & (Timer - fTimer) * 1000 & " ms"

GdipDisposeImage(hImage)
GdiplusShutdown(GDIPlusToken)
Sleep

Alles anzeigen

Insertion Sort kann ich auch mal testen...

Edit: Insertion Sort ist absolut langsam! Da ist Radix Sort um ein vielfaches schneller!

**UEZ**

Hier meine Resultate von AspirinJunkie 's Version (#86)

Code

Multi-Thread-RadixSort-Version:
          Zeitbedarf:  1165.73 ms
       Anzahl Farben:  33177600

Multi-Thread-RadixSort-Version 2:
          Zeitbedarf:   725.96 ms
       Anzahl Farben:  33177600

Single-Thread-Quicksort-Version:
          Zeitbedarf:   663.56 ms
       Anzahl Farben:  33177600

Multi-Thread-Quicksort-Version:
          Zeitbedarf:   406.47 ms
       Anzahl Farben:  33177600

Single-Thread-Array-Version:
          Zeitbedarf:   148.16 ms
       Anzahl Farben:  16777216

Multi-Thread-Array-Version:
          Zeitbedarf:   540.68 ms
       Anzahl Farben:  16777216

Single-Thread-Set-Version:
          Zeitbedarf:  21179.23 ms
       Anzahl Farben:  33177600

Multi-Thread-Set-Version:
          Zeitbedarf:  37024.35 ms
       Anzahl Farben:  33177600

Alles anzeigen

Als Testbild habe ich Oscar 's generiertes riesen Bild genommen.

Die letzten zwei Funktionen sind extrem langsam...

**UEZ**

Oscar Top!

**UEZ**

Zitat von Oscar

UEZ: Deine FB-Exe stürzt nach kurzer Laufzeit ab (nachdem das 8k-Testbild geladen wurde).

Also bei mir läuft die Exe:

Code

Loading image
Image dimension: 7680x4320
Counting all 32-bit colors
Sorting color array
Counting unique colors
Unique color count: 33177599
Time: 8275.271474720455 ms

Wenn ich nur die 24-Bit betrachte (Inline ASM):

Code

Loading image
Image dimension: 7680x4320
Counting all 24-bit colors
Unique color count: 16777216
Time: 701.3580921111782 ms

Probiere bitte mal diese Exe.

**UEZ**

Hmm, kannst du bitte mal die FB Version checken? Die FB Version ist auf meiner Kiste ungefähr gleich schnell wie deine MT Version!

Download: https://www.mediafire.com/file/8qansw4x5…CountColors.zip

Ich habe auch das 36 MPixel Bild hinzugefügt!

Danke.

FB:

Code

Loading image
Image dimension: 7360x4912
Counting all 24-bit colors
Unique color count: 402990
321.7085356591269 ms

Chesstiger's MT:

Code

Zeit: 318.318642564774 ms
Anzahl der Farben: 402990

**UEZ**

1334608958_palette.png

Wie viele Farben hat dieses 32-bit PNG Bild wirklich?

IrfanView: 18276

GIMP: 17894

XnView: 17894

Oscar's Variante: 18161

Meine FB Variante: 19520

GIMP und XnView scheint nur 24- bit zu zählen.

**UEZ**

Zitat von AspirinJunkie

Warum nicht?

Nun ja, bei einem 35 mp Bild kann ich mir zwar vorstellen, dass ich vielleicht 50% herausholen kann, aber das ist in dieser Zeit Region nicht so relevant. zumal 35 mp Bilder eher die Ausnahmen sind. Kleinere Bilder z.B. in HD Auflösung dauern ca. 150ms und da lohnt sich vermutlich kein MT.

**UEZ**

AspirinJunkie : diesmal funktionieren die DLLs:

x64:

Code

Dimension: 7360x4912
Single-Thread-Version:
          Zeitbedarf:  5196.39 ms
       Anzahl Farben:   402990

Multi-Thread-Version:
          Zeitbedarf:   865.69 ms
       Anzahl Farben:   402990

Hier meine x86 FreeBasic ST Version:

Code

Loading image
Image dimensions: 7360x4912
Counting all 24-bit colors
Unique color count: 402990
1318.890535639614 ms

Ich glaube nicht, dass MT hier noch was bringt bzw. MT sich richtig lohnt.

FB Version siehe unten.

**UEZ**

Ist bereits installiert.

**UEZ**

AspirinJunkie Bei mir funzt dein Skript nicht.

Code

CountColors.au3" (28) : ==> Subscript used on non-accessible variable.:
Return $a_Ret[0]
Return $a_Ret^ ERROR

**UEZ**

Oscar : stimmt, wo du es jetzt sagst, hatte ich auch schon recherchiert und festgestellt, dass es am JPEG Decoder hing. Hab's wieder vergessen (Altersamnesie).

**UEZ**

Das Array unter 32-bit funzt nicht, aber als 64-bit. Da werden schlappe 4 GB einfach belegt. Nicht gut, aber wie soll's auch anders sein!

Die langsamere Variante unterstützt auch 32-bit Bilder und verbraucht nur einen Bruchteil an Speicher.

**UEZ**

Leider kann FB nicht 256^4 als Array adressieren oder ich weiß nicht, wie das gehen soll. Jedenfalls mit 256^3, sprich 24-Bit Support, liege ich jetzt bei ca. 150 ms für das HD Amsel Bild.

**UEZ**

Ich hatte auch vor einiger Zeit diese Funktion in AutoIt und FreeBasic geschrieben und dabei bemerkt, dass die Anzahl der Farben sich von Programm zu Programm unterscheidet.

Dein Amsel Bild:

Unsere GDI+ Versionen: 160514

IfranView: 148516

XnView: 160537

Keine Ahnung, wie man nun weiß, welcher Wert der richtige ist.

Ach ja, meine FB Version benötigt für das HD Amsel Bild ca. 400ms, wobei ich den Weg über Arrays genommen hatte (hinzufügen, sortieren und zählen).

**UEZ**

Deine 4 Punkte bleiben außerhalb des roten Rechteckes, somit kann deine Figur durchlaufen. Du musst zwei weitere Punkte prüfen, ob sie das rote Rechteck berühren.

Beispiel Code im engl. Forum.

Abgesehen davon würde ich nicht _GDIPlus_PathIsVisiblePoint für solche simple Objekte (Rechtecke) benutzen. Da ist eher der Check, wie es Mars gepostet hat, schneller. Aber hier musst du noch zwei weitere Punkte hinzufügen, da ansonsten die Eckpunkte außerhalb liegen.

**UEZ**

Nee, diese zwei Funktionen sind nicht in der WinAPI Lib enthalten. Keine Ahnung, ob die neuen Modifikationen, Bugfixes, neue Funktionen jemals veröffentlicht werden, da Jon scheinbar kein Interesse mehr an AutoIt hat.

**UEZ**

Zitat von Tweaky

Wie sieht es hiermit aus?

- Gibt es auch Ersatzfunktionen für "_WinAPI_LZNTDecompress" bzw. "_Base64Decode"?

Warum?

Beiträge von UEZ

Infinite Image Zoom Flight build 2018-01-10

Infinite Image Zoom Flight build 2018-01-10

Infinite Image Zoom Flight build 2018-01-10

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GetUniqueColors

GDI+ Problem mit Kollision für bestimmten Bereich (Collision)

File to Base64 String Code Generator v1.20 Build 2020-06-05

File to Base64 String Code Generator v1.20 Build 2020-06-05